@@ -6,16 +6,15 @@ import Control.Lens
66import Data.Bifunctor
77import Data.ByteString as BS
88import Data.Coerce
9−import Data.Foldable as F
109import Data.List.NonEmpty as NE
1110import Data.Maybe
12−import Data.Semigroup (sconcat)
11+import Data.Semigroup
1312import Data.Text as T
1413import Data.Yaml
1514import Network.URI
1615import Stack.Config.Yaml as Yaml
1716import Stack.Types
18−import System.FilePath
17+import System.FilePath as FilePath
1918
2019
2120newtype StackResolver = StackResolver { fromStackResolver :: Text }
@@ -30,15 +29,29 @@ newtype Vcs = Vcs { fromVcs :: Text }
3029 deriving (Eq, Ord, Show)
3130
3231data Repo = Repo
33− { _rVcs :: !Vcs
34− , _rUri :: !Text
35− , _rCommit :: !Text
32+ { _rVcs :: Vcs
33+ , _rUri :: Text
34+ , _rCommit :: Text
3635 } deriving (Eq, Ord, Show)
3736
3837makeLenses ''Repo
3938
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+
4053data PackageLocation
41− = HackagePackage Text
54+ = StackIndex PackageIndex
4255 | StackFilePath FilePath
4356 | StackUri URI
4457 | StackRepo Repo
@@ -47,17 +60,17 @@ data PackageLocation
4760makePrisms ''PackageLocation
4861
4962data StackPackage = StackPackage
50− { _spLocation :: !PackageLocation
51− , _spExtraDep :: !Bool
63+ { _spLocation :: PackageLocation
64+ , _spExtraDep :: Bool
5265 -- | Subdirectory containing the cabal file if any specified.
53− , _spDir :: !(Maybe FilePath)
66+ , _spDir :: Maybe FilePath
5467 } deriving (Eq, Ord, Show)
5568
5669makeLenses ''StackPackage
5770
5871data StackConfig = StackConfig
59− { _scResolver :: !StackResolver
60− , _scPackages :: !(NonEmpty StackPackage)
72+ { _scResolver :: StackResolver
73+ , _scPackages :: NonEmpty StackPackage
6174 } deriving (Eq, Ord, Show)
6275
6376makeLenses ''StackConfig
@@ -66,52 +79,92 @@ fromYamlConfig :: Yaml.Config -> StackConfig
6679fromYamlConfig c = StackConfig{..}
6780 where
6881 _scResolver = coerce $ c ^. cResolver
69− _scPackages = F.foldr (NE.<|) neYamlPackages yamlExtraDeps
70− neYamlPackages = fromMaybe (pure defaultPackage)
71− . fmap sconcat $ NE.nonEmpty yamlPackages
72− yamlPackages = fromYamlPackage <$> (fromMaybe mempty (c ^. cPackages))
73− yamlExtraDeps = fromYamlExtraDep <$> fromMaybe mempty (c ^. cExtraDeps)
82+ _scPackages = NE.nub
83+ $ fromMaybe (pure defaultPackage)
84+ $ fmap sconcat
85+ $ NE.nonEmpty (yamlPackages <> yamlExtraDeps)
86+ yamlPackages = fromYamlPackage packagesSimplePath False
87+ <$> fromMaybe mempty (c ^. cPackages)
88+ yamlExtraDeps = fromYamlPackage extraDepsSimplePath True
89+ <$> fromMaybe mempty (c ^. cExtraDeps)
7490 defaultPackage = StackPackage (StackFilePath ".") False Nothing
7591
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
7699
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.
77118fromYamlPackage
78− :: Yaml.Package
79− -- ^ A single 'Yaml.Package' can result in multiple actual
80− -- packages if it has multiple subdirs specified.
119+ :: (Text -> StackPackage)
120+ -> Bool
121+ -> Yaml.Package
81122 -> NonEmpty StackPackage
82−fromYamlPackage = \case
123+fromYamlPackage fromSimple isExtraDep = \case
83124 Yaml.Simple p ->
84− unroll Nothing $ StackPackage (parseSimplePath p) False
125+ pure (fromSimple p)
85126 Yaml.LocationSimple (Location p extraDep ms) ->
86127 unroll ms $ StackPackage (parseSimplePath p) (fromMaybe False extraDep)
87− Yaml.LocationGit (Location git extraDep ms) ->
88− unroll ms $ StackPackage (StackRepo $ fromYamlGit git) (fromMaybe False extraDep)
89− Yaml.LocationHg (Location hg extraDep ms) ->
90− unroll ms $ StackPackage (StackRepo $ fromYamlHg hg) (fromMaybe False extraDep)
128+ Yaml.LocationGit loc ->
129+ mkStackPackageRepo fromYamlGit loc
130+ Yaml.LocationHg loc ->
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
91136 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)
93139 -- Each package gets a single directory with cabal file in it. If
94140 -- it's not specified, path is empty.
95141 unroll subs p = case subs of
96142 Just (x : xs) -> NE.map (p . Just) (x :| xs)
97143 _ -> p Nothing :| []
98144
99−fromYamlExtraDep :: Text -> StackPackage
100−fromYamlExtraDep t = StackPackage (HackagePackage t) True Nothing
101−
102145fromYamlGit :: Yaml.Git -> Repo
103−fromYamlGit yg = Repo{..}
104− where
105− _rVcs = Vcs "git"
106− _rUri = yg ^. gGit
107− _rCommit = yg ^. gCommit
146+fromYamlGit yg = Repo
147+ { _rVcs = Vcs "git"
148+ , _rUri = yg ^. gGit
149+ , _rCommit = yg ^. gCommit }
108150
109151fromYamlHg :: Yaml.Hg -> Repo
110−fromYamlHg yh = Repo{..}
111− where
112− _rVcs = Vcs "hg"
113− _rUri = yh ^. hHg
114− _rCommit = yh ^. hCommit
152+fromYamlHg yh = Repo
153+ { _rVcs = Vcs "hg"
154+ , _rUri = yh ^. hHg
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 }
115168
116169readStackConfig :: StackYaml -> IO (Either String StackConfig)
117170readStackConfig stackYaml = do