Skip to content
Permalink
Browse files

Treat ghc-options in stack.yaml like flags

Include modules that add `ghcOptions` attribute to the package
  • Loading branch information...
hamishmack committed Oct 9, 2019
1 parent 47ab471 commit 0cd30f3ad027628123df69e2821353156037e58c
Showing with 34 additions and 21 deletions.
  1. +23 −16 stack2nix/Stack2nix.hs
  2. +3 −2 stack2nix/Stack2nix/External/Resolve.hs
  3. +8 −3 stack2nix/Stack2nix/Stack.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) ->
@@ -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
@@ -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.

0 comments on commit 0cd30f3

Please sign in to comment.
You can’t perform that action at this time.