@@ -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
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)
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)
38makeLenses ''Repo
37makeLenses ''Repo
42+ deriving (Eq, Ord, Show)
44+makePrisms ''PackageRevision
46+data PackageIndex = PackageIndex
47+ { _piNameVersion :: Text
48+ , _piRevision :: Maybe PackageRevision
49+ } deriving (Eq, Ord, Show)
51+makeLenses ''PackageIndex
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
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)
56makeLenses ''StackPackage
69makeLenses ''StackPackage
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)
63makeLenses ''StackConfig
76makeLenses ''StackConfig
@@ -66,52 +79,92 @@ fromYamlConfig :: Yaml.Config -> StackConfig
66fromYamlConfig c = StackConfig{..}
79fromYamlConfig c = StackConfig{..}
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)
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
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
96+-- | Parse location as URI or a FilePath
97+parseSimplePath :: Text -> PackageLocation
98+parseSimplePath (T.unpack -> p) = maybe (StackFilePath p) StackUri $ parseURI p
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
104+ loc = maybe (parsePackageIndex t) StackUri $ parseURI (T.unpack t)
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
112+-- Determine wether package is file path
113+isFilePath :: Text -> Bool
114+isFilePath = T.any (== FilePath.pathSeparator)
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)
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
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 :| []
99−fromYamlExtraDep :: Text -> StackPackage
100−fromYamlExtraDep t = StackPackage (HackagePackage t) True Nothing
102fromYamlGit :: Yaml.Git -> Repo
145fromYamlGit :: Yaml.Git -> Repo
103−fromYamlGit yg = Repo{..}
146+fromYamlGit yg = Repo
105− _rVcs = Vcs "git"
147+ { _rVcs = Vcs "git"
106− _rUri = yg ^. gGit
148+ , _rUri = yg ^. gGit
107− _rCommit = yg ^. gCommit
149+ , _rCommit = yg ^. gCommit }
109fromYamlHg :: Yaml.Hg -> Repo
151fromYamlHg :: Yaml.Hg -> Repo
110−fromYamlHg yh = Repo{..}
152+fromYamlHg yh = Repo
112− _rVcs = Vcs "hg"
153+ { _rVcs = Vcs "hg"
113− _rUri = yh ^. hHg
154+ , _rUri = yh ^. hHg
114− _rCommit = yh ^. hCommit
155+ , _rCommit = yh ^. hCommit }
157+fromYamlNewGit :: NewGit -> Repo
158+fromYamlNewGit ng = Repo
160+ , _rUri = ng ^. ngGit
161+ , _rCommit = ng ^. ngCommit }
163+fromYamlNewHg :: NewHg -> Repo
164+fromYamlNewHg nh = Repo
166+ , _rUri = nh ^. nhHg
167+ , _rCommit = nh ^. nhCommit }
116readStackConfig :: StackYaml -> IO (Either String StackConfig)
169readStackConfig :: StackYaml -> IO (Either String StackConfig)
117readStackConfig stackYaml = do
170readStackConfig stackYaml = do