View on GitHub
File Changes
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
                      =<< resolveSnapshot value

                      
stack2nix :: Args -> Stack -> IO NExpr
-
stack2nix args [email protected](Stack resolver compiler _ _) =
-
  do let extraDeps    = extraDeps2nix stack
-
         flags        = flags2nix stack
+
stack2nix args [email protected](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) ]
                   ++ [ "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]
       ]
--
--   { 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 ]
        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 =

                      

                      
-- 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) ->
-- a file, resolve that file and merge the snapshot into the
-- @[email protected] record.
resolveSnapshot :: Stack -> IO Stack
-
resolveSnapshot [email protected](Stack resolver compiler pkgs flags)
+
resolveSnapshot [email protected](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
  , URL
  , Rev
  , Stack(..)
-
  , Compiler(..)
  , Dependency(..)
  , Location(..)
  , StackSnapshot(..)
+
  , PackageFlags
+
  , GhcOptions
  ) where

                      
import Data.Char (isDigit)
-- 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
    PackageFlags              -- flags
    -- [PackageName]          -- drop-packages
    -- [PackageName -> Bool]  -- hidden
-
    -- [package -> [Opt]]     -- ghc-options
+
    GhcOptions                -- ghc-options
    deriving (Show)

                      
data Location
    <*> ((<>) <$> s .:? "packages"   .!= [LocalPath "."]
              <*> s .:? "extra-deps" .!= [])
    <*> s .:? "flags" .!= mempty
+
    <*> s .:? "ghc-options" .!= mempty

                      
instance FromJSON StackSnapshot where
  parseJSON = withObject "Snapshot" $ \s -> Snapshot
    <*> 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.