git.iko.soy/typeable/stackage2nix
on master help sign in
Add support for new syntax in extra-deps
334955fDmitry Bushev
src/Distribution/Nixpkgs/Haskell/Stack.hs+2−2
@@ -42,8 +42,8 @@ stackLocationToSource
42 -> Maybe FilePath
42 -> Maybe FilePath
43 -> Source
43 -> Source
44stackLocationToSource pl mCabalDir = case pl of
44stackLocationToSource pl mCabalDir = case pl of
45− HackagePackage p -> Source
45+ StackIndex p -> Source
46− { sourceUrl = "cabal://" ++ T.unpack p
46+ { sourceUrl = "cabal://" ++ T.unpack (p ^. piNameVersion)
47 , sourceRevision = mempty
47 , sourceRevision = mempty
48 , sourceHash = UnknownHash
48 , sourceHash = UnknownHash
49 , sourceCabalDir = cabalDir }
49 , sourceCabalDir = cabalDir }
src/LtsHaskell.hs+1−1
@@ -52,7 +52,7 @@ getPackageFromRepo allCabalHashesPath mSha1Hash pkgId = do
52getPackageFromDb :: DB.HackageDB -> PackageIdentifier -> IO Package
52getPackageFromDb :: DB.HackageDB -> PackageIdentifier -> IO Package
53getPackageFromDb hackageDb pkgId =
53getPackageFromDb hackageDb pkgId =
54 getStackPackageFromDb hackageDb
54 getStackPackageFromDb hackageDb
55− $ StackPackage (HackagePackage (T.pack $ Text.display pkgId)) True Nothing
55+ $ StackPackage (StackIndex $ PackageIndex (T.pack $ Text.display pkgId) Nothing) True Nothing
56
56
57loadPackage :: DB.HackageDB -> FilePath -> Maybe SHA1Hash -> PackageIdentifier -> IO Package
57loadPackage :: DB.HackageDB -> FilePath -> Maybe SHA1Hash -> PackageIdentifier -> IO Package
58loadPackage hackageDb allCabalHashesPath mSha1Hash pkgId =
58loadPackage hackageDb allCabalHashesPath mSha1Hash pkgId =
src/Stack/Config.hs+93−40
@@ -6,16 +6,15 @@ import Control.Lens
6import Data.Bifunctor
6import Data.Bifunctor
7import Data.ByteString as BS
7import Data.ByteString as BS
8import Data.Coerce
8import Data.Coerce
9−import Data.Foldable as F
10import Data.List.NonEmpty as NE
9import Data.List.NonEmpty as NE
11import Data.Maybe
10import Data.Maybe
12−import Data.Semigroup (sconcat)
11+import Data.Semigroup
13import Data.Text as T
12import Data.Text as T
14import Data.Yaml
13import Data.Yaml
15import Network.URI
14import Network.URI
16import Stack.Config.Yaml as Yaml
15import Stack.Config.Yaml as Yaml
17import Stack.Types
16import Stack.Types
18−import System.FilePath
17+import System.FilePath as FilePath
19
18
20
19
21newtype StackResolver = StackResolver { fromStackResolver :: Text }
20newtype StackResolver = StackResolver { fromStackResolver :: Text }
@@ -30,15 +29,29 @@ newtype Vcs = Vcs { fromVcs :: Text }
30 deriving (Eq, Ord, Show)
29 deriving (Eq, Ord, Show)
31
30
32data Repo = Repo
31data Repo = Repo
33− { _rVcs :: !Vcs
32+ { _rVcs :: Vcs
34− , _rUri :: !Text
33+ , _rUri :: Text
35− , _rCommit :: !Text
34+ , _rCommit :: Text
36 } deriving (Eq, Ord, Show)
35 } deriving (Eq, Ord, Show)
37
36
38makeLenses ''Repo
37makeLenses ''Repo
39
38
39+data PackageRevision
40+ = PrSha256 Text
41+ | PrRev Text
42+ deriving (Eq, Ord, Show)
43+
44+makePrisms ''PackageRevision
45+
46+data PackageIndex = PackageIndex
47+ { _piNameVersion :: Text
48+ , _piRevision :: Maybe PackageRevision
49+ } deriving (Eq, Ord, Show)
50+
51+makeLenses ''PackageIndex
52+
40data PackageLocation
53data PackageLocation
41− = HackagePackage Text
54+ = StackIndex PackageIndex
42 | StackFilePath FilePath
55 | StackFilePath FilePath
43 | StackUri URI
56 | StackUri URI
44 | StackRepo Repo
57 | StackRepo Repo
@@ -47,17 +60,17 @@ data PackageLocation
47makePrisms ''PackageLocation
60makePrisms ''PackageLocation
48
61
49data StackPackage = StackPackage
62data StackPackage = StackPackage
50− { _spLocation :: !PackageLocation
63+ { _spLocation :: PackageLocation
51− , _spExtraDep :: !Bool
64+ , _spExtraDep :: Bool
52 -- | Subdirectory containing the cabal file if any specified.
65 -- | Subdirectory containing the cabal file if any specified.
53− , _spDir :: !(Maybe FilePath)
66+ , _spDir :: Maybe FilePath
54 } deriving (Eq, Ord, Show)
67 } deriving (Eq, Ord, Show)
55
68
56makeLenses ''StackPackage
69makeLenses ''StackPackage
57
70
58data StackConfig = StackConfig
71data StackConfig = StackConfig
59− { _scResolver :: !StackResolver
72+ { _scResolver :: StackResolver
60− , _scPackages :: !(NonEmpty StackPackage)
73+ , _scPackages :: NonEmpty StackPackage
61 } deriving (Eq, Ord, Show)
74 } deriving (Eq, Ord, Show)
62
75
63makeLenses ''StackConfig
76makeLenses ''StackConfig
@@ -66,52 +79,92 @@ fromYamlConfig :: Yaml.Config -> StackConfig
66fromYamlConfig c = StackConfig{..}
79fromYamlConfig c = StackConfig{..}
67 where
80 where
68 _scResolver = coerce $ c ^. cResolver
81 _scResolver = coerce $ c ^. cResolver
69− _scPackages = F.foldr (NE.<|) neYamlPackages yamlExtraDeps
82+ _scPackages = NE.nub
70− neYamlPackages = fromMaybe (pure defaultPackage)
83+ $ fromMaybe (pure defaultPackage)
84+ $ fmap sconcat
71− . fmap sconcat $ NE.nonEmpty yamlPackages
85+ $ NE.nonEmpty (yamlPackages <> yamlExtraDeps)
86+ yamlPackages = fromYamlPackage packagesSimplePath False
72− yamlPackages = fromYamlPackage <$> (fromMaybe mempty (c ^. cPackages))
87+ <$> fromMaybe mempty (c ^. cPackages)
88+ yamlExtraDeps = fromYamlPackage extraDepsSimplePath True
73− yamlExtraDeps = fromYamlExtraDep <$> fromMaybe mempty (c ^. cExtraDeps)
89+ <$> fromMaybe mempty (c ^. cExtraDeps)
74 defaultPackage = StackPackage (StackFilePath ".") False Nothing
90 defaultPackage = StackPackage (StackFilePath ".") False Nothing
75
91
92+-- | Simple string in a packages section can be an URI or FilePath location
93+packagesSimplePath :: Text -> StackPackage
94+packagesSimplePath t = StackPackage (parseSimplePath t) False Nothing
95+
96+-- | Parse location as URI or a FilePath
97+parseSimplePath :: Text -> PackageLocation
98+parseSimplePath (T.unpack -> p) = maybe (StackFilePath p) StackUri $ parseURI p
76
99
100+-- | Simple string in an extra-deps section can be an URI or FilePath or PackageIndex name-version
101+extraDepsSimplePath :: Text -> StackPackage
102+extraDepsSimplePath t = StackPackage loc True Nothing
103+ where
104+ loc = maybe (parsePackageIndex t) StackUri $ parseURI (T.unpack t)
105+
106+-- TODO: support new package index format with hash and revision
107+parsePackageIndex :: Text -> PackageLocation
108+parsePackageIndex t = if isFilePath t
109+ then StackFilePath (T.unpack t)
110+ else StackIndex $ PackageIndex t Nothing
111+
112+-- Determine wether package is file path
113+isFilePath :: Text -> Bool
114+isFilePath = T.any (== FilePath.pathSeparator)
115+
116+-- | A single 'Yaml.Package' can result in multiple actual
117+-- packages if it has multiple subdirs specified.
77fromYamlPackage
118fromYamlPackage
78− :: Yaml.Package
119+ :: (Text -> StackPackage)
120+ -> Bool
79− -- ^ A single 'Yaml.Package' can result in multiple actual
121+ -> Yaml.Package
80− -- packages if it has multiple subdirs specified.
81 -> NonEmpty StackPackage
122 -> NonEmpty StackPackage
82−fromYamlPackage = \case
123+fromYamlPackage fromSimple isExtraDep = \case
83 Yaml.Simple p ->
124 Yaml.Simple p ->
84− unroll Nothing $ StackPackage (parseSimplePath p) False
125+ pure (fromSimple p)
85 Yaml.LocationSimple (Location p extraDep ms) ->
126 Yaml.LocationSimple (Location p extraDep ms) ->
86 unroll ms $ StackPackage (parseSimplePath p) (fromMaybe False extraDep)
127 unroll ms $ StackPackage (parseSimplePath p) (fromMaybe False extraDep)
87− Yaml.LocationGit (Location git extraDep ms) ->
128+ Yaml.LocationGit loc ->
88− unroll ms $ StackPackage (StackRepo $ fromYamlGit git) (fromMaybe False extraDep)
129+ mkStackPackageRepo fromYamlGit loc
89− Yaml.LocationHg (Location hg extraDep ms) ->
130+ Yaml.LocationHg loc ->
90− unroll ms $ StackPackage (StackRepo $ fromYamlHg hg) (fromMaybe False extraDep)
131+ mkStackPackageRepo fromYamlHg loc
132+ Yaml.PNewGit ng -> unroll (ng ^. ngSubdirs)
133+ $ StackPackage (StackRepo $ fromYamlNewGit ng) isExtraDep
134+ Yaml.PNewHg nh -> unroll (nh ^. nhSubdirs)
135+ $ StackPackage (StackRepo $ fromYamlNewHg nh) isExtraDep
91 where
136 where
92− parseSimplePath (T.unpack -> p) = maybe (StackFilePath p) StackUri $ parseURI p
137+ mkStackPackageRepo f loc = unroll (loc ^. lSubdirs)
138+ $ StackPackage (StackRepo (loc ^. lLocation . to f)) (fromMaybe isExtraDep $ loc ^. lExtraDep)
93 -- Each package gets a single directory with cabal file in it. If
139 -- Each package gets a single directory with cabal file in it. If
94 -- it's not specified, path is empty.
140 -- it's not specified, path is empty.
95 unroll subs p = case subs of
141 unroll subs p = case subs of
96 Just (x : xs) -> NE.map (p . Just) (x :| xs)
142 Just (x : xs) -> NE.map (p . Just) (x :| xs)
97 _ -> p Nothing :| []
143 _ -> p Nothing :| []
98
144
99−fromYamlExtraDep :: Text -> StackPackage
100−fromYamlExtraDep t = StackPackage (HackagePackage t) True Nothing
101−
102fromYamlGit :: Yaml.Git -> Repo
145fromYamlGit :: Yaml.Git -> Repo
103−fromYamlGit yg = Repo{..}
146+fromYamlGit yg = Repo
104− where
105− _rVcs = Vcs "git"
147+ { _rVcs = Vcs "git"
106− _rUri = yg ^. gGit
148+ , _rUri = yg ^. gGit
107− _rCommit = yg ^. gCommit
149+ , _rCommit = yg ^. gCommit }
108
150
109fromYamlHg :: Yaml.Hg -> Repo
151fromYamlHg :: Yaml.Hg -> Repo
110−fromYamlHg yh = Repo{..}
152+fromYamlHg yh = Repo
111− where
112− _rVcs = Vcs "hg"
153+ { _rVcs = Vcs "hg"
113− _rUri = yh ^. hHg
154+ , _rUri = yh ^. hHg
114− _rCommit = yh ^. hCommit
155+ , _rCommit = yh ^. hCommit }
156+
157+fromYamlNewGit :: NewGit -> Repo
158+fromYamlNewGit ng = Repo
159+ { _rVcs = Vcs "git"
160+ , _rUri = ng ^. ngGit
161+ , _rCommit = ng ^. ngCommit }
162+
163+fromYamlNewHg :: NewHg -> Repo
164+fromYamlNewHg nh = Repo
165+ { _rVcs = Vcs "hg"
166+ , _rUri = nh ^. nhHg
167+ , _rCommit = nh ^. nhCommit }
115
168
116readStackConfig :: StackYaml -> IO (Either String StackConfig)
169readStackConfig :: StackYaml -> IO (Either String StackConfig)
117readStackConfig stackYaml = do
170readStackConfig stackYaml = do
src/Stack/Config/Yaml.hs+39−14
@@ -8,38 +8,57 @@ import Data.Text as T
8import Stack.Config.TH
8import Stack.Config.TH
9
9
10data Location a = Location
10data Location a = Location
11− { _lLocation :: !a
11+ { _lLocation :: a
12− , _lExtraDep :: !(Maybe Bool)
12+ , _lExtraDep :: Maybe Bool
13− , _lSubdirs :: !(Maybe [FilePath])
13+ , _lSubdirs :: Maybe [FilePath]
14 } deriving (Eq, Show)
14 } deriving (Eq, Show)
15
15
16makeLenses ''Location
16makeLenses ''Location
17−
18deriveJSON jsonOpts ''Location
17deriveJSON jsonOpts ''Location
19
18
20data Git = Git
19data Git = Git
21− { _gGit :: !Text
20+ { _gGit :: Text
22− , _gCommit :: !Text
21+ , _gCommit :: Text
23 } deriving (Eq, Show)
22 } deriving (Eq, Show)
24
23
25makeLenses ''Git
24makeLenses ''Git
26−
27deriveJSON jsonOpts ''Git
25deriveJSON jsonOpts ''Git
28
26
29data Hg = Hg
27data Hg = Hg
30− { _hHg :: !Text
28+ { _hHg :: Text
31− , _hCommit :: !Text
29+ , _hCommit :: Text
32 } deriving (Eq, Show)
30 } deriving (Eq, Show)
33
31
34makeLenses ''Hg
32makeLenses ''Hg
35−
36deriveJSON jsonOpts ''Hg
33deriveJSON jsonOpts ''Hg
37
34
35+-- New syntax
36+
37+data NewGit = NewGit
38+ { _ngGit :: Text
39+ , _ngCommit :: Text
40+ , _ngSubdirs :: Maybe [FilePath]
41+ } deriving (Eq, Show)
42+
43+makeLenses ''NewGit
44+deriveJSON jsonOpts ''NewGit
45+
46+data NewHg = NewHg
47+ { _nhHg :: Text
48+ , _nhCommit :: Text
49+ , _nhSubdirs :: Maybe [FilePath]
50+ } deriving (Eq, Show)
51+
52+makeLenses ''NewHg
53+deriveJSON jsonOpts ''NewHg
54+
38data Package
55data Package
39 = Simple Text
56 = Simple Text
40 | LocationSimple (Location Text)
57 | LocationSimple (Location Text)
41 | LocationGit (Location Git)
58 | LocationGit (Location Git)
42 | LocationHg (Location Hg)
59 | LocationHg (Location Hg)
60+ | PNewGit NewGit
61+ | PNewHg NewHg
43 deriving (Eq, Show)
62 deriving (Eq, Show)
44
63
45makePrisms ''Package
64makePrisms ''Package
@@ -49,7 +68,9 @@ instance FromJSON Package where
49 (Simple <$> parseJSON v) <|>
68 (Simple <$> parseJSON v) <|>
50 (LocationSimple <$> parseJSON v) <|>
69 (LocationSimple <$> parseJSON v) <|>
51 (LocationGit <$> parseJSON v) <|>
70 (LocationGit <$> parseJSON v) <|>
52− (LocationHg <$> parseJSON v)
71+ (LocationHg <$> parseJSON v) <|>
72+ (PNewGit <$> parseJSON v) <|>
73+ (PNewHg <$> parseJSON v)
53
74
54instance ToJSON Package where
75instance ToJSON Package where
55 toJSON = \case
76 toJSON = \case
@@ -57,11 +78,15 @@ instance ToJSON Package where
57 LocationSimple t -> toJSON t
78 LocationSimple t -> toJSON t
58 LocationGit t -> toJSON t
79 LocationGit t -> toJSON t
59 LocationHg t -> toJSON t
80 LocationHg t -> toJSON t
81+ PNewGit t -> toJSON t
82+ PNewHg t -> toJSON t
60
83
84+-- To support support both old and new syntax, we allow all varieties of package
85+-- definitions in both "packages" and "extra-deps" sections
61data Config = Config
86data Config = Config
62− { _cResolver :: !Text
87+ { _cResolver :: Text
63− , _cPackages :: !(Maybe [Package])
88+ , _cPackages :: Maybe [Package]
64− , _cExtraDeps :: !(Maybe [Text])
89+ , _cExtraDeps :: Maybe [Package]
65 } deriving (Eq, Show)
90 } deriving (Eq, Show)
66
91
67makeLenses ''Config
92makeLenses ''Config
test/Stack/Config/YamlSpec.hs+69−1
@@ -39,6 +39,39 @@ extra-deps:
39- acme-missiles-0.3
39- acme-missiles-0.3
40|]
40|]
41
41
42+-- | New yaml config support all package definitions in "extra-deps" section
43+configNewYaml :: ByteString
44+configNewYaml = T.encodeUtf8 [st|
45+resolver: lts-3.7
46+packages:
47+ - .
48+ - location: dir1/dir2
49+ - location: https://example.com/foo/bar/baz-0.0.2.tar.gz
50+ extra-dep: true
51+ - location:
52+ git: git@github.com:commercialhaskell/stack.git
53+ commit: 6a86ee32e5b869a877151f74064572225e1a0398
54+ - location:
55+ git: git@github.com:example/mega-repo
56+ commit: 6a86ee32e5b869a877151f74064572225e1a0000
57+ subdirs:
58+ - subdir1
59+ - subdir2
60+# Comment
61+extra-deps:
62+ - acme-missiles-0.3
63+ - acme-missiles-hash-0.4@@sha256:2ba66a092a32593880a87fb00f3213762d7bca65a687d45965778deb8694c5d1
64+ - acme-missiles-rev-0.5@@rev:0
65+ - git: git@github.com:commercialhaskell/stack.git
66+ commit: 6a86ee32e5b869a877151f74064572225e1a0398
67+ - git: git@github.com:example/mega-repo
68+ commit: 6a86ee32e5b869a877151f74064572225e1a0000
69+ subdirs:
70+ - subdir1
71+ - subdir2
72+|]
73+
74+
42configMinimal :: Config
75configMinimal :: Config
43configMinimal = Config
76configMinimal = Config
44 { _cResolver = "lts-8.15"
77 { _cResolver = "lts-8.15"
@@ -65,7 +98,40 @@ config = Config
65 Nothing (Just ["subdir1", "subdir2"]))
98 Nothing (Just ["subdir1", "subdir2"]))
66 ]
99 ]
67 , _cExtraDeps = Just
100 , _cExtraDeps = Just
68− ["acme-missiles-0.3"]
101+ [Simple "acme-missiles-0.3"]
102+ }
103+
104+configNew :: Config
105+configNew = Config
106+ { _cResolver = "lts-3.7"
107+ , _cPackages = Just
108+ [ Simple "."
109+ , LocationSimple (Location "dir1/dir2" Nothing Nothing)
110+ , LocationSimple (Location "https://example.com/foo/bar/baz-0.0.2.tar.gz" (Just True) Nothing)
111+ , LocationGit $ Location
112+ (Git
113+ "git@github.com:commercialhaskell/stack.git"
114+ "6a86ee32e5b869a877151f74064572225e1a0398")
115+ Nothing Nothing
116+ , LocationGit (Location
117+ (Git
118+ "git@github.com:example/mega-repo"
119+ "6a86ee32e5b869a877151f74064572225e1a0000")
120+ Nothing (Just ["subdir1", "subdir2"]))
121+ ]
122+ , _cExtraDeps = Just
123+ [ Simple "acme-missiles-0.3"
124+ , Simple "acme-missiles-hash-0.4@@sha256:2ba66a092a32593880a87fb00f3213762d7bca65a687d45965778deb8694c5d1"
125+ , Simple "acme-missiles-rev-0.5@@rev:0"
126+ , PNewGit $ NewGit
127+ "git@github.com:commercialhaskell/stack.git"
128+ "6a86ee32e5b869a877151f74064572225e1a0398"
129+ Nothing
130+ , PNewGit $ NewGit
131+ "git@github.com:example/mega-repo"
132+ "6a86ee32e5b869a877151f74064572225e1a0000"
133+ (Just ["subdir1", "subdir2"])
134+ ]
69 }
135 }
70
136
71spec :: Spec
137spec :: Spec
@@ -74,3 +140,5 @@ spec = describe "Parse" $ do
74 (Y.decode configYamlMinimal :: Maybe Config) `shouldBe` Just configMinimal
140 (Y.decode configYamlMinimal :: Maybe Config) `shouldBe` Just configMinimal
75 specify "config-full" $
141 specify "config-full" $
76 (Y.decode configYaml :: Maybe Config) `shouldBe` Just config
142 (Y.decode configYaml :: Maybe Config) `shouldBe` Just config
143+ specify "config-new" $
144+ (Y.decode configNewYaml :: Maybe Config) `shouldBe` Just configNew