module Language.ATS.Package.PackageSet ( ATSPackageSet (..)
, setBuildPlan
, mkBuildPlan
) where
import qualified Data.ByteString.Lazy as BSL
import Data.Dependency
import qualified Data.Map as M
import qualified Data.Set as S
import Language.ATS.Package.Error
import Language.ATS.Package.Type
import Quaalude
newtype ATSPackageSet = ATSPackageSet [ ATSDependency ]
deriving (Interpret, Show)
setBuildPlan :: FilePath
-> String
-> [String]
-> IO [[ATSDependency]]
setBuildPlan p url deps = do
b <- doesFileExist depCache
bool setBuildPlan' (decode <$> BSL.readFile depCache) b
where depCache = ".atspkg/buildplan-" ++ p
setBuildPlan' = do
pkgSet <- input auto (pack url)
case mkBuildPlan pkgSet deps of
Right x -> createDirectoryIfMissing True ".atspkg" >> BSL.writeFile depCache (encode x) >> pure x
Left x -> resolutionFailed x
mkBuildPlan :: ATSPackageSet -> [String] -> DepM [[ATSDependency]]
mkBuildPlan aps@(ATSPackageSet ps) = finalize . resolve . fmap asDep <=< stringBuildPlan
where finalize = fmap (fmap (fmap (lookupVersions aps)))
resolve = resolveDependencies (atsPkgsToPkgs aps)
stringBuildPlan names = sequence [ lookup' x libs | x <- names ]
where libs = (unpack . libName &&& id) <$> ps
lookup' k vs = case lookup k vs of
Just x -> Right x
Nothing -> Left (NotPresent k)
canonicalize :: ATSConstraint -> Constraint Version
canonicalize (ATSConstraint (Just l) Nothing) = GreaterThanEq l
canonicalize (ATSConstraint Nothing (Just u)) = LessThanEq u
canonicalize (ATSConstraint Nothing Nothing) = None
canonicalize (ATSConstraint (Just l) (Just u)) = Bounded (GreaterThanEq l) (LessThanEq u)
asDep :: ATSDependency -> Dependency
asDep ATSDependency{..} = Dependency (unpack libName) (g <$> libDeps) libVersion
where g = unpack *** canonicalize
atsPkgsToPkgs :: ATSPackageSet -> PackageSet Dependency
atsPkgsToPkgs (ATSPackageSet deps) = PackageSet $ foldr (.) id inserts mempty
where inserts = insert <$> deps
insert dep = M.insertWith
(\_ -> S.insert (asDep dep))
(unpack $ libName dep)
(S.singleton (asDep dep))
lookupVersions :: ATSPackageSet -> Dependency -> ATSDependency
lookupVersions (ATSPackageSet deps) (Dependency name _ v) = head (filter f deps)
where f = (&&) <$> matchName <*> matchVersion
libName' = unpack . libName
matchName = (== name) . libName'
matchVersion = (== v) . libVersion