first complete version

Author: brunjlar

src/Main.hs

@@ -3,11 +3,4 @@ module Main where
 import Stack2Cabal
 
 main :: IO ()
-main = do
-  config <- parseConfig
-  print config
-  {-
-  [dir] <- getArgs
-  withLog ("processing folder '" ++ dir ++ "'") $
-    writeCabalProject dir
-    -}
+main = parseConfig >>= configCabal

src/Stack2Cabal.hs

@@ -1,13 +1,12 @@
+{-# LANGUAGE RecordWildCards #-}
+
 module Stack2Cabal
-    ( module Stack2Cabal.Compiler
-    , module Stack2Cabal.Config
-    , module Stack2Cabal.Constraints
-    , module Stack2Cabal.Git
-    , module Stack2Cabal.Packages
-    , module Stack2Cabal.Util
-    , writeCabalProject
+    ( parseConfig
+    , configCabal
     ) where
 
+import Control.Monad           (when, forM_)
+import Data.Maybe              (mapMaybe)
 import System.Directory        (doesPathExist)
 import System.FilePath         ((</>), (<.>))
 import System.IO               (withFile, IOMode (WriteMode), hPutStrLn)
@@ -19,14 +18,43 @@ import Stack2Cabal.Git
 import Stack2Cabal.Packages
 import Stack2Cabal.Util
 
-writeCabalProject :: FilePath -> IO ()
-writeCabalProject dir = do
-    let file = dir </> "cabal" <.> "project"
+configCabal :: Config -> IO ()
+configCabal cnf@Config{..} =
+    withLog ("creating cabal config for project folder '" ++ cnfProjectDir ++ "'") $ do
+    packages <- parseStackYaml cnfProjectDir
+    writeCabalProject cnf packages
+    handleGitDependencies cnf packages
+
+writeCabalProject :: Config -> [Package] -> IO ()
+writeCabalProject Config{..} packages = do
+    let file = cnfProjectDir </> "cabal" <.> "project"
     b <- doesPathExist file
-    if b then putLogLn "cabal project file already exists"
-         else withLog "writing cabal project file" $ 
-                withFile file WriteMode $ \h -> do
-                    ps <- writePackagesBlock "git-packages" <$> parseStackYaml dir
-                    cs <- writeCompilerBlock <$> getCompiler dir
-                    ds <- writeConstraintsBlock <$> getConstraints dir
-                    mapM_ (hPutStrLn h) $ ps ++ cs ++ ds
+    case (b, cnfCabalProject) of
+        (True,  Force) -> wcp file
+        (True,  Yes)   -> putLogLn "cabal.project already exists"
+        (False, Force) -> wcp file
+        (False, Yes)   -> wcp file
+        (_,     No)    -> return ()
+  where
+    wcp :: FilePath -> IO ()
+    wcp file = withLog "writing cabal.project" $
+        withFile file WriteMode $ \h -> do
+            let ps = writePackagesBlock gitFolder packages -- <$> parseStackYaml cnfProjectDir
+            cs <- writeCompilerBlock <$> getCompiler cnfProjectDir
+            ds <- writeConstraintsBlock <$> getConstraints cnfProjectDir
+            mapM_ (hPutStrLn h) $ ps ++ cs ++ ds
+
+handleGitDependencies :: Config -> [Package] -> IO ()
+handleGitDependencies Config{..} packages = 
+    when cnfGitDependencies $ do
+        let dir = cnfProjectDir </> gitFolder
+            gs  = mapMaybe filterGit packages 
+        forM_ gs $ \git ->
+            cloneAndCheckoutGit dir git
+  where
+    filterGit :: Package -> Maybe Git
+    filterGit (GitPackage git) = Just git
+    filterGit (LocalPackage _) = Nothing
+
+gitFolder :: FilePath
+gitFolder = ".stack2cabal"

src/Stack2Cabal/Git.hs

@@ -14,7 +14,9 @@ import qualified Data.Attoparsec.Text as A
 import           Data.Text            (Text, pack, unpack)
 import           GHC.IO.Exception     (userError)
 import           System.FilePath      ((</>))
-import           System.Directory     (withCurrentDirectory, doesDirectoryExist)
+import           System.Directory     (withCurrentDirectory, 
+                                       doesDirectoryExist, 
+                                       createDirectoryIfMissing)
 import           System.Process       (callProcess)
 
 import           Stack2Cabal.Util     (withLog, putLogLn)
@@ -44,6 +46,7 @@ gitNameIO git = case gitName git of
 cloneAndCheckoutGit :: FilePath -> Git -> IO ()
 cloneAndCheckoutGit dir git@Git{..} =
     withLog ("handling git " ++ show git) $ do
+        createDirectoryIfMissing False dir
         name <- unpack <$> gitNameIO git
         let url = unpack gitUrl
             dir'   = dir </> name