{-# LANGUAGE DeriveGeneric #-}
module Staversion.Internal.BuildPlan.Core
(
CompilerCores,
CoreBuildPlanMap(..),
Compiler(..),
CompilerVersion(..),
CompilerName,
mkCompilerVersion,
ghcName,
parseGHCPkgVersions,
fetchGHCPkgVersions
) where
import Control.Applicative ((<|>), (<$>), some)
import Control.Monad (void)
import qualified Data.ByteString.Lazy as BSL
import Data.Char (isSpace)
import Data.Foldable (foldlM)
import Data.Hashable (Hashable(..))
import qualified Data.HashMap.Strict as HM
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import GHC.Generics (Generic)
import Staversion.Internal.HTTP (Manager, fetchURL)
import Staversion.Internal.Query (PackageName)
import Staversion.Internal.Version (Version, versionNumbers, mkVersion)
import Staversion.Internal.BuildPlan.BuildPlanMap (BuildPlanMap, HasVersions(..))
import Staversion.Internal.BuildPlan.Parser (parserVersion)
import qualified Staversion.Internal.BuildPlan.BuildPlanMap as BuildPlanMap
import qualified Staversion.Internal.Megaparsec as P
type CompilerName = Text
data CompilerVersion =
CVHead
| CVNumbered Version
deriving (Show,Eq,Ord,Generic)
mkCompilerVersion :: [Int] -> CompilerVersion
mkCompilerVersion = CVNumbered . mkVersion
instance Hashable CompilerVersion where
hashWithSalt s CVHead = hashWithSalt s ()
hashWithSalt s (CVNumbered v) = hashWithSalt s $ versionNumbers v
data Compiler =
Compiler
{ compilerName :: CompilerName,
compilerVersion :: CompilerVersion
}
deriving (Show,Eq,Ord,Generic)
instance Hashable Compiler
data CoreBuildPlanMap =
CoreBuildPlanMap
{ coreCompiler :: Compiler,
coreMap :: BuildPlanMap
}
deriving (Show,Eq)
instance HasVersions CoreBuildPlanMap where
packageVersion cbp = packageVersion $ coreMap cbp
ghcName :: CompilerName
ghcName = "ghc"
type CompilerCores = HM.HashMap Compiler CoreBuildPlanMap
addVersions :: Compiler -> [(PackageName, Version)] -> CompilerCores -> CompilerCores
addVersions c pkgs = HM.insertWith merge c inserted_cbp
where
inserted_cbp = CoreBuildPlanMap c $ BuildPlanMap.fromList pkgs
merge new old = new { coreMap = coreMap new <> coreMap old }
parsePkgVersionsLine :: Text -> Either String (Compiler, [(PackageName, Version)])
parsePkgVersionsLine input = mapError $ P.runParser parser "" input
where
mapError (Left e) = Left $ show e
mapError (Right a) = Right a
parser = do
P.space
cv <- parserCompilerVersion
P.space1
vers <- P.sepBy parserPVer P.space1
return (Compiler ghcName cv, vers)
parserCompilerVersion = headVersion <|> (CVNumbered <$> parserVersion)
headVersion = do
void $ P.string "HEAD"
return CVHead
parserPVer = do
name <- P.textSatisfying (\c -> c /= '/')
void $ P.char '/'
ver <- parserVersion
return (name, ver)
parseGHCPkgVersions :: BSL.ByteString -> Either String (HM.HashMap Compiler CoreBuildPlanMap)
parseGHCPkgVersions content =
foldlM f HM.empty $ filter (not . isWhiteLine) $ map removeComment $ toLines content
where
toLines :: BSL.ByteString -> [Text]
toLines = map TL.toStrict . TL.lines . TL.decodeUtf8
removeComment = T.takeWhile (\c -> c /= '#')
isWhiteLine = T.all isSpace
f acc line = do
(c, vers) <- parsePkgVersionsLine line
return $ addVersions c vers acc
fetchGHCPkgVersions :: Manager -> IO BSL.ByteString
fetchGHCPkgVersions man = fetchURL man "https://gitlab.haskell.org/bgamari/ghc-utils/-/raw/master/library-versions/pkg_versions.txt"