reading git packages from stack.yaml

Author: brunjlar

.gitignore

@@ -1 +1,2 @@
 .stack-work/
+*.swp

src/Main.hs

@@ -1,5 +1,14 @@
 module Main where
 
+import Control.Monad      (forM_)
+import System.Environment (getArgs)
+
+import Stack2Yaml
+
 main :: IO ()
 main = do
-  putStrLn "hello world"
+  [dir] <- getArgs
+  putStrLn $ "processing folder '" ++ dir ++ "'"
+  yaml <- parseStackYaml dir
+  let gs = gitPackages yaml
+  forM_ gs print

src/Stack2Yaml.hs

@@ -0,0 +1,5 @@
+module Stack2Yaml
+    ( module Stack2Yaml.StackYaml
+    ) where
+
+import Stack2Yaml.StackYaml

src/Stack2Yaml/StackYaml.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack2Yaml.StackYaml
+    ( parseStackYaml
+    , Git (..)
+    , gitPackages
+    ) where
+
+import Data.Maybe         (mapMaybe)
+import Data.Text          (Text)
+import Data.Text.Encoding (decodeUtf8)
+import Data.Yaml.Parser   (YamlValue (..), readYamlFile)
+import System.FilePath    ((</>), (<.>))
+
+parseStackYaml :: FilePath -> IO YamlValue
+parseStackYaml dir = readYamlFile $ dir </> "stack" <.> "yaml"
+
+data Git = Git 
+    { gitUrl    :: !Text
+    , gitCommit :: !Text
+    } deriving (Eq, Ord, Show)
+
+gitPackages :: YamlValue -> [Git]
+gitPackages (Mapping m _) = case lookup "packages" m of
+    Just (Sequence ps _) -> mapMaybe f [p | Mapping (("location",  Mapping p _) : _) _ <- ps]
+    _                    -> []
+  where
+    --f :: YamlValue -> 
+    f m' = case (lookup "git" m', lookup "commit" m') of
+        (Just (Scalar g _ _ _), Just (Scalar c _ _ _)) -> Just $ Git { gitUrl = decodeUtf8 g, gitCommit = decodeUtf8 c }
+        _                                              -> Nothing
+gitPackages _           = []

stack2cabal.cabal

@@ -16,5 +16,11 @@ extra-source-files:  README.md
 executable stack2cabal
   hs-source-dirs:      src
   main-is:             Main.hs
+  other-modules:       Stack2Yaml   
+                     , Stack2Yaml.StackYaml
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
+                     , filepath
+                     , text
+                     , yaml
+  ghc-options:         -Wall -O2