Treat ghc-options in stack.yaml like flags (input-output-hk#65)

Include modules that add `ghcOptions` attribute to the package

Author: hamishmack

stack2nix/Stack2nix.hs

@@ -36,7 +36,7 @@ import Cabal2Nix.Util
 import Stack2nix.Cache (appendCache, cacheHits)
 import Stack2nix.CLI (Args(..))
 import Stack2nix.Project
-import Stack2nix.Stack (Stack(..), Dependency(..), Location(..))
+import Stack2nix.Stack (Stack(..), Dependency(..), Location(..), PackageFlags, GhcOptions)
 import Stack2nix.External.Resolve
 
 import qualified Data.HashMap.Strict as HM
@@ -60,16 +60,17 @@ stackexpr args =
                       =<< resolveSnapshot value
 
 stack2nix :: Args -> Stack -> IO NExpr
-stack2nix args stack@(Stack resolver compiler _ _) =
-  do let extraDeps    = extraDeps2nix stack
-         flags        = flags2nix stack
+stack2nix args stack@(Stack resolver compiler pkgs pkgFlags ghcOpts) =
+  do let extraDeps    = extraDeps2nix pkgs
+         flags        = flags2nix pkgFlags
+         ghcOptions   = ghcOptions2nix ghcOpts
      let _f_          = mkSym "f"
          _import_     = mkSym "import"
          _mkForce_    = mkSym "mkForce"
          _isFunction_ = mkSym "isFunction"
          _mapAttrs_   = mkSym "mapAttrs"
          _config_     = mkSym "config"
-     packages <- packages2nix args stack
+     packages <- packages2nix args pkgs
      return . mkNonRecSet $
        [ "extras" $= ("hackage" ==> mkNonRecSet
                      ([ "packages" $= mkNonRecSet (extraDeps <> packages) ]
@@ -78,7 +79,9 @@ stack2nix args stack@(Stack resolver compiler _ _) =
                    ++ [ "compiler.nix-name" $= fromString (quoted name)
                       | (Just c) <- [compiler], let name = filter (`elem` ((['a'..'z']++['0'..'9']) :: [Char])) c]))
        , "resolver"  $= fromString (quoted resolver)
-       , "modules" $= mkList [ mkNonRecSet [ "packages" $= mkNonRecSet flags ] ]
+       , "modules" $= mkList [
+           mkNonRecSet [ "packages" $= mkNonRecSet flags ]
+         , mkNonRecSet [ "packages" $= mkNonRecSet ghcOptions ] ]
        ] ++ [
          "compiler" $= fromString (quoted c) | (Just c) <- [compiler]
        ]
@@ -91,8 +94,8 @@ stack2nix args stack@(Stack resolver compiler _ _) =
 --
 --   { name.revision = hackage.name.version.revisions.default; }
 --
-extraDeps2nix :: Stack -> [Binding NExpr]
-extraDeps2nix (Stack _ _ pkgs _) =
+extraDeps2nix :: [Dependency] -> [Binding NExpr]
+extraDeps2nix pkgs =
   let extraDeps = [(pkgId, info) | PkgIndex pkgId info <- pkgs]
   in [ (quoted (toText pkg)) $= (mkSym "hackage" @. toText pkg @. quoted (toText ver) @. "revisions" @. "default")
      | (PackageIdentifier pkg ver, Nothing) <- extraDeps ]
@@ -105,20 +108,24 @@ extraDeps2nix (Stack _ _ pkgs _) =
         toText :: Text a => a -> T.Text
         toText = fromString . show . disp
 
--- | Converts 'PackageFlags' into @{ packageName = { flagA = BOOL; flagB = BOOL; }; }@
-flags2nix :: Stack -> [Binding NExpr]
-flags2nix (Stack _ _ _ pkgFlags) =
+-- | Converts 'PackageFlags' into @{ packageName = { flags = { flagA = BOOL; flagB = BOOL; }; }; }@
+flags2nix :: PackageFlags -> [Binding NExpr]
+flags2nix pkgFlags =
   [ quoted pkgName $= mkNonRecSet
     [ "flags" $= 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
 
+-- | Converts 'GhcOptions' into @{ packageName = { ghcOptions = "..."; }; }@
+ghcOptions2nix :: GhcOptions -> [Binding NExpr]
+ghcOptions2nix ghcOptions =
+  [ quoted pkgName $= mkNonRecSet
+    [ "package" $= mkNonRecSet [ "ghcOptions" $= mkStr opts ] ]
+  | (pkgName, opts) <- HM.toList ghcOptions
+  ]
 
 writeDoc :: FilePath -> Doc ann -> IO ()
 writeDoc file doc =
@@ -128,8 +135,8 @@ writeDoc file doc =
 
 
 -- makeRelativeToCurrentDirectory
-packages2nix :: Args -> Stack-> IO [Binding NExpr]
-packages2nix args (Stack _ _ pkgs _) =
+packages2nix :: Args -> [Dependency] -> IO [Binding NExpr]
+packages2nix args pkgs =
   do cwd <- getCurrentDirectory
      fmap concat . forM pkgs $ \case
        (LocalPath folder) ->

stack2nix/Stack2nix/External/Resolve.hs

@@ -35,13 +35,14 @@ 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 flags)
+resolveSnapshot stack@(Stack resolver compiler pkgs flags ghcOptions)
   = 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' flags') ->
+              Right (Snapshot resolver' compiler' _name pkgs' flags' ghcOptions') ->
                 pure $ Stack resolver' (compiler' <|> compiler)  (pkgs <> pkgs') (flags <> flags')
+                    (ghcOptions <> ghcOptions')
     else pure stack

stack2nix/Stack2nix/Stack.hs

@@ -10,10 +10,11 @@ module Stack2nix.Stack
   , URL
   , Rev
   , Stack(..)
-  , Compiler(..)
   , Dependency(..)
   , Location(..)
   , StackSnapshot(..)
+  , PackageFlags
+  , GhcOptions
   ) where
 
 import Data.Char (isDigit)
@@ -119,8 +120,10 @@ data Dependency
 -- flags are { pkg -> { flag -> bool } }
 type PackageFlags = HM.HashMap T.Text (HM.HashMap T.Text Bool)
 
+type GhcOptions = HM.HashMap T.Text T.Text
+
 data Stack
-  = Stack Resolver (Maybe Compiler) [Dependency] PackageFlags
+  = Stack Resolver (Maybe Compiler) [Dependency] PackageFlags GhcOptions
   deriving (Show)
 
 -- stack supports custom snapshots
@@ -134,7 +137,7 @@ data StackSnapshot
     PackageFlags              -- flags
     -- [PackageName]          -- drop-packages
     -- [PackageName -> Bool]  -- hidden
-    -- [package -> [Opt]]     -- ghc-options
+    GhcOptions                -- ghc-options
     deriving (Show)
 
 data Location
@@ -182,6 +185,7 @@ instance FromJSON Stack where
     <*> ((<>) <$> s .:? "packages"   .!= [LocalPath "."]
               <*> s .:? "extra-deps" .!= [])
     <*> s .:? "flags" .!= mempty
+    <*> s .:? "ghc-options" .!= mempty
 
 instance FromJSON StackSnapshot where
   parseJSON = withObject "Snapshot" $ \s -> Snapshot
@@ -190,6 +194,7 @@ instance FromJSON StackSnapshot where
     <*> s .: "name"
     <*> s .:? "packages" .!= []
     <*> s .:? "flags" .!= mempty
+    <*> s .:? "ghc-options" .!= mempty
 
 instance FromJSON Dependency where
   -- Note: we will parse foo-X.Y.Z as a package.