Add support for stack.yaml flags. (input-output-hk#56)

* Add support for stack.yaml flags.

Fixes input-output-hk#54

* Update stack2nix/Stack2nix.hs

Co-Authored-By: Rodney Lorrimar <dev@rodney.id.au>

Author: angerman

nix-tools/nix-tools.cabal

@@ -166,6 +166,7 @@ executable stack-to-nix
                      , http-client-tls
                      , http-client
                      , http-types
+                     , unordered-containers
   hs-source-dirs:      stack2nix
   default-language:    Haskell2010
 

nix-tools/stack2nix/Stack2nix.hs

@@ -39,6 +39,9 @@ import Stack2nix.Project
 import Stack2nix.Stack (Stack(..), Dependency(..), Location(..))
 import Stack2nix.External.Resolve
 
+import qualified Data.HashMap.Strict as HM
+
+
 doStack2nix :: Args -> IO ()
 doStack2nix args = do
   let pkgsNix = argOutputDir args </> "pkgs.nix"
@@ -57,8 +60,9 @@ stackexpr args =
                       =<< resolveSnapshot value
 
 stack2nix :: Args -> Stack -> IO NExpr
-stack2nix args stack@(Stack resolver compiler _) =
+stack2nix args stack@(Stack resolver compiler _ _) =
   do let extraDeps = extraDeps2nix stack
+         flags     = flags2nix stack
      let _f_          = mkSym "f"
          _import_     = mkSym "import"
          _mkForce_    = mkSym "mkForce"
@@ -68,7 +72,7 @@ stack2nix args stack@(Stack resolver compiler _) =
      packages <- packages2nix args stack
      return . mkNonRecSet $
        [ "extras" $= ("hackage" ==> mkNonRecSet
-                     ([ "packages" $= (extraDeps $// packages) ]
+                     ([ "packages" $= (extraDeps $// packages $// flags) ]
                    ++ [ "compiler.version" $= fromString (quoted ver)
                       | (Just c) <- [compiler], let ver = filter (`elem` (".0123456789" :: [Char])) c]
                    ++ [ "compiler.nix-name" $= fromString (quoted name)
@@ -87,7 +91,7 @@ stack2nix args stack@(Stack resolver compiler _) =
 --   { name.revision = hackage.name.version.revisions.default; }
 --
 extraDeps2nix :: Stack -> NExpr
-extraDeps2nix (Stack _ _ pkgs) =
+extraDeps2nix (Stack _ _ pkgs _) =
   let extraDeps = [(pkgId, info) | PkgIndex pkgId info <- pkgs]
   in mkNonRecSet $ [ (quoted (toText pkg)) $= (mkSym "hackage" @. toText pkg @. quoted (toText ver) @. "revisions" @. "default")
                    | (PackageIdentifier pkg ver, Nothing) <- extraDeps ]
@@ -100,6 +104,18 @@ extraDeps2nix (Stack _ _ pkgs) =
         toText :: Text a => a -> T.Text
         toText = fromString . show . disp
 
+-- | Converts 'PackageFlags' into @{ packageName = { flagA = BOOL; flagB = BOOL; }; }@
+flags2nix :: Stack -> NExpr
+flags2nix (Stack _ _ _ pkgFlags) =
+  mkNonRecSet [ quoted pkgName $= mkNonRecSet [ quoted flag $= mkBool val
+                                              | (flag, val) <- HM.toList flags
+                                              ]
+              | (pkgName, flags) <- HM.toList pkgFlags
+              ]
+  where
+    toText :: Text a => a -> T.Text
+    toText = fromString . show . disp
+
 
 writeDoc :: FilePath -> Doc ann -> IO ()
 writeDoc file doc =
@@ -110,7 +126,7 @@ writeDoc file doc =
 
 -- makeRelativeToCurrentDirectory
 packages2nix :: Args -> Stack-> IO NExpr
-packages2nix args (Stack _ _ pkgs) =
+packages2nix args (Stack _ _ pkgs _) =
   do cwd <- getCurrentDirectory
      fmap (mkNonRecSet . concat) . forM pkgs $ \case
        (LocalPath folder) ->

nix-tools/stack2nix/Stack2nix/External/Resolve.hs

@@ -35,13 +35,13 @@ decodeURLEither url
 -- a file, resolve that file and merge the snapshot into the
 -- @Stack@ record.
 resolveSnapshot :: Stack -> IO Stack
-resolveSnapshot stack@(Stack resolver compiler pkgs)
+resolveSnapshot stack@(Stack resolver compiler pkgs flags)
   = if ".yaml" `isSuffixOf` resolver
     then do evalue <- if ("http://" `isPrefixOf` resolver) || ("https://" `isPrefixOf` resolver)
                       then decodeURLEither resolver
                       else decodeFileEither resolver
             case evalue of
               Left e -> error (show e)
-              Right (Snapshot resolver' compiler' _name pkgs') ->
-                pure $ Stack resolver' (compiler' <|> compiler)  (pkgs <> pkgs')
+              Right (Snapshot resolver' compiler' _name pkgs' flags') ->
+                pure $ Stack resolver' (compiler' <|> compiler)  (pkgs <> pkgs') (flags <> flags')
     else pure stack

nix-tools/stack2nix/Stack2nix/Stack.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module Stack2nix.Stack
   ( Resolver
@@ -20,13 +21,15 @@ import Data.List (isSuffixOf)
 import qualified Data.Text as T
 import Data.Aeson
 import Control.Applicative ((<|>))
+import Data.Monoid (mempty)
 
 import Distribution.Types.PackageName
 import Distribution.Types.PackageId
 import Distribution.Compat.ReadP hiding (Parser)
 import Distribution.Text
 import Distribution.Types.Version (nullVersion)
 
+import qualified Data.HashMap.Strict as HM
 
 --------------------------------------------------------------------------------
 -- The stack.yaml file
@@ -113,8 +116,11 @@ data Dependency
   -- | Archive ...
   deriving (Show)
 
+-- flags are { pkg -> { flag -> bool } }
+type PackageFlags = HM.HashMap T.Text (HM.HashMap T.Text Bool)
+
 data Stack
-  = Stack Resolver (Maybe Compiler) [Dependency]
+  = Stack Resolver (Maybe Compiler) [Dependency] PackageFlags
   deriving (Show)
 
 -- stack supports custom snapshots
@@ -125,7 +131,7 @@ data StackSnapshot
     (Maybe Compiler)          -- possible compiler override for the snapshot
     Name                      -- name
     [Dependency]              -- packages
-    -- [Package -> [Flag]]    -- flags
+    PackageFlags              -- flags
     -- [PackageName]          -- drop-packages
     -- [PackageName -> Bool]  -- hidden
     -- [package -> [Opt]]     -- ghc-options
@@ -167,13 +173,15 @@ instance FromJSON Stack where
     <*> s .:? "compiler" .!= Nothing
     <*> ((<>) <$> s .:? "packages"   .!= [LocalPath "."]
               <*> s .:? "extra-deps" .!= [])
+    <*> s .:? "flags" .!= mempty
 
 instance FromJSON StackSnapshot where
   parseJSON = withObject "Snapshot" $ \s -> Snapshot
     <$> s .: "resolver"
     <*> s .:? "compiler" .!= Nothing
     <*> s .: "name"
     <*> s .:? "packages" .!= []
+    <*> s .:? "flags" .!= mempty
 
 instance FromJSON Dependency where
   -- Note: we will parse foo-X.Y.Z as a package.