{-# 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 (Int -> CompilerVersion -> ShowS
[CompilerVersion] -> ShowS
CompilerVersion -> String
(Int -> CompilerVersion -> ShowS)
-> (CompilerVersion -> String)
-> ([CompilerVersion] -> ShowS)
-> Show CompilerVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilerVersion] -> ShowS
$cshowList :: [CompilerVersion] -> ShowS
show :: CompilerVersion -> String
$cshow :: CompilerVersion -> String
showsPrec :: Int -> CompilerVersion -> ShowS
$cshowsPrec :: Int -> CompilerVersion -> ShowS
Show,CompilerVersion -> CompilerVersion -> Bool
(CompilerVersion -> CompilerVersion -> Bool)
-> (CompilerVersion -> CompilerVersion -> Bool)
-> Eq CompilerVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompilerVersion -> CompilerVersion -> Bool
$c/= :: CompilerVersion -> CompilerVersion -> Bool
== :: CompilerVersion -> CompilerVersion -> Bool
$c== :: CompilerVersion -> CompilerVersion -> Bool
Eq,Eq CompilerVersion
Eq CompilerVersion
-> (CompilerVersion -> CompilerVersion -> Ordering)
-> (CompilerVersion -> CompilerVersion -> Bool)
-> (CompilerVersion -> CompilerVersion -> Bool)
-> (CompilerVersion -> CompilerVersion -> Bool)
-> (CompilerVersion -> CompilerVersion -> Bool)
-> (CompilerVersion -> CompilerVersion -> CompilerVersion)
-> (CompilerVersion -> CompilerVersion -> CompilerVersion)
-> Ord CompilerVersion
CompilerVersion -> CompilerVersion -> Bool
CompilerVersion -> CompilerVersion -> Ordering
CompilerVersion -> CompilerVersion -> CompilerVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompilerVersion -> CompilerVersion -> CompilerVersion
$cmin :: CompilerVersion -> CompilerVersion -> CompilerVersion
max :: CompilerVersion -> CompilerVersion -> CompilerVersion
$cmax :: CompilerVersion -> CompilerVersion -> CompilerVersion
>= :: CompilerVersion -> CompilerVersion -> Bool
$c>= :: CompilerVersion -> CompilerVersion -> Bool
> :: CompilerVersion -> CompilerVersion -> Bool
$c> :: CompilerVersion -> CompilerVersion -> Bool
<= :: CompilerVersion -> CompilerVersion -> Bool
$c<= :: CompilerVersion -> CompilerVersion -> Bool
< :: CompilerVersion -> CompilerVersion -> Bool
$c< :: CompilerVersion -> CompilerVersion -> Bool
compare :: CompilerVersion -> CompilerVersion -> Ordering
$ccompare :: CompilerVersion -> CompilerVersion -> Ordering
$cp1Ord :: Eq CompilerVersion
Ord,(forall x. CompilerVersion -> Rep CompilerVersion x)
-> (forall x. Rep CompilerVersion x -> CompilerVersion)
-> Generic CompilerVersion
forall x. Rep CompilerVersion x -> CompilerVersion
forall x. CompilerVersion -> Rep CompilerVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompilerVersion x -> CompilerVersion
$cfrom :: forall x. CompilerVersion -> Rep CompilerVersion x
Generic)
mkCompilerVersion :: [Int] -> CompilerVersion
mkCompilerVersion :: [Int] -> CompilerVersion
mkCompilerVersion = Version -> CompilerVersion
CVNumbered (Version -> CompilerVersion)
-> ([Int] -> Version) -> [Int] -> CompilerVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Version
mkVersion
instance Hashable CompilerVersion where
hashWithSalt :: Int -> CompilerVersion -> Int
hashWithSalt Int
s CompilerVersion
CVHead = Int -> () -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s ()
hashWithSalt Int
s (CVNumbered Version
v) = Int -> [Int] -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionNumbers Version
v
data Compiler =
Compiler
{ Compiler -> CompilerName
compilerName :: CompilerName,
Compiler -> CompilerVersion
compilerVersion :: CompilerVersion
}
deriving (Int -> Compiler -> ShowS
[Compiler] -> ShowS
Compiler -> String
(Int -> Compiler -> ShowS)
-> (Compiler -> String) -> ([Compiler] -> ShowS) -> Show Compiler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compiler] -> ShowS
$cshowList :: [Compiler] -> ShowS
show :: Compiler -> String
$cshow :: Compiler -> String
showsPrec :: Int -> Compiler -> ShowS
$cshowsPrec :: Int -> Compiler -> ShowS
Show,Compiler -> Compiler -> Bool
(Compiler -> Compiler -> Bool)
-> (Compiler -> Compiler -> Bool) -> Eq Compiler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compiler -> Compiler -> Bool
$c/= :: Compiler -> Compiler -> Bool
== :: Compiler -> Compiler -> Bool
$c== :: Compiler -> Compiler -> Bool
Eq,Eq Compiler
Eq Compiler
-> (Compiler -> Compiler -> Ordering)
-> (Compiler -> Compiler -> Bool)
-> (Compiler -> Compiler -> Bool)
-> (Compiler -> Compiler -> Bool)
-> (Compiler -> Compiler -> Bool)
-> (Compiler -> Compiler -> Compiler)
-> (Compiler -> Compiler -> Compiler)
-> Ord Compiler
Compiler -> Compiler -> Bool
Compiler -> Compiler -> Ordering
Compiler -> Compiler -> Compiler
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Compiler -> Compiler -> Compiler
$cmin :: Compiler -> Compiler -> Compiler
max :: Compiler -> Compiler -> Compiler
$cmax :: Compiler -> Compiler -> Compiler
>= :: Compiler -> Compiler -> Bool
$c>= :: Compiler -> Compiler -> Bool
> :: Compiler -> Compiler -> Bool
$c> :: Compiler -> Compiler -> Bool
<= :: Compiler -> Compiler -> Bool
$c<= :: Compiler -> Compiler -> Bool
< :: Compiler -> Compiler -> Bool
$c< :: Compiler -> Compiler -> Bool
compare :: Compiler -> Compiler -> Ordering
$ccompare :: Compiler -> Compiler -> Ordering
$cp1Ord :: Eq Compiler
Ord,(forall x. Compiler -> Rep Compiler x)
-> (forall x. Rep Compiler x -> Compiler) -> Generic Compiler
forall x. Rep Compiler x -> Compiler
forall x. Compiler -> Rep Compiler x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Compiler x -> Compiler
$cfrom :: forall x. Compiler -> Rep Compiler x
Generic)
instance Hashable Compiler
data CoreBuildPlanMap =
CoreBuildPlanMap
{ CoreBuildPlanMap -> Compiler
coreCompiler :: Compiler,
CoreBuildPlanMap -> BuildPlanMap
coreMap :: BuildPlanMap
}
deriving (Int -> CoreBuildPlanMap -> ShowS
[CoreBuildPlanMap] -> ShowS
CoreBuildPlanMap -> String
(Int -> CoreBuildPlanMap -> ShowS)
-> (CoreBuildPlanMap -> String)
-> ([CoreBuildPlanMap] -> ShowS)
-> Show CoreBuildPlanMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoreBuildPlanMap] -> ShowS
$cshowList :: [CoreBuildPlanMap] -> ShowS
show :: CoreBuildPlanMap -> String
$cshow :: CoreBuildPlanMap -> String
showsPrec :: Int -> CoreBuildPlanMap -> ShowS
$cshowsPrec :: Int -> CoreBuildPlanMap -> ShowS
Show,CoreBuildPlanMap -> CoreBuildPlanMap -> Bool
(CoreBuildPlanMap -> CoreBuildPlanMap -> Bool)
-> (CoreBuildPlanMap -> CoreBuildPlanMap -> Bool)
-> Eq CoreBuildPlanMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoreBuildPlanMap -> CoreBuildPlanMap -> Bool
$c/= :: CoreBuildPlanMap -> CoreBuildPlanMap -> Bool
== :: CoreBuildPlanMap -> CoreBuildPlanMap -> Bool
$c== :: CoreBuildPlanMap -> CoreBuildPlanMap -> Bool
Eq)
instance HasVersions CoreBuildPlanMap where
packageVersion :: CoreBuildPlanMap -> CompilerName -> Maybe Version
packageVersion CoreBuildPlanMap
cbp = BuildPlanMap -> CompilerName -> Maybe Version
forall t. HasVersions t => t -> CompilerName -> Maybe Version
packageVersion (BuildPlanMap -> CompilerName -> Maybe Version)
-> BuildPlanMap -> CompilerName -> Maybe Version
forall a b. (a -> b) -> a -> b
$ CoreBuildPlanMap -> BuildPlanMap
coreMap CoreBuildPlanMap
cbp
ghcName :: CompilerName
ghcName :: CompilerName
ghcName = CompilerName
"ghc"
type CompilerCores = HM.HashMap Compiler CoreBuildPlanMap
addVersions :: Compiler -> [(PackageName, Version)] -> CompilerCores -> CompilerCores
addVersions :: Compiler
-> [(CompilerName, Version)] -> CompilerCores -> CompilerCores
addVersions Compiler
c [(CompilerName, Version)]
pkgs = (CoreBuildPlanMap -> CoreBuildPlanMap -> CoreBuildPlanMap)
-> Compiler -> CoreBuildPlanMap -> CompilerCores -> CompilerCores
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith CoreBuildPlanMap -> CoreBuildPlanMap -> CoreBuildPlanMap
merge Compiler
c CoreBuildPlanMap
inserted_cbp
where
inserted_cbp :: CoreBuildPlanMap
inserted_cbp = Compiler -> BuildPlanMap -> CoreBuildPlanMap
CoreBuildPlanMap Compiler
c (BuildPlanMap -> CoreBuildPlanMap)
-> BuildPlanMap -> CoreBuildPlanMap
forall a b. (a -> b) -> a -> b
$ [(CompilerName, Version)] -> BuildPlanMap
BuildPlanMap.fromList [(CompilerName, Version)]
pkgs
merge :: CoreBuildPlanMap -> CoreBuildPlanMap -> CoreBuildPlanMap
merge CoreBuildPlanMap
new CoreBuildPlanMap
old = CoreBuildPlanMap
new { coreMap :: BuildPlanMap
coreMap = CoreBuildPlanMap -> BuildPlanMap
coreMap CoreBuildPlanMap
new BuildPlanMap -> BuildPlanMap -> BuildPlanMap
forall a. Semigroup a => a -> a -> a
<> CoreBuildPlanMap -> BuildPlanMap
coreMap CoreBuildPlanMap
old }
parsePkgVersionsLine :: Text -> Either String (Compiler, [(PackageName, Version)])
parsePkgVersionsLine :: CompilerName -> Either String (Compiler, [(CompilerName, Version)])
parsePkgVersionsLine CompilerName
input = Either
(ParseErrorBundle CompilerName (ErrorFancy Void))
(Compiler, [(CompilerName, Version)])
-> Either String (Compiler, [(CompilerName, Version)])
forall a b. Show a => Either a b -> Either String b
mapError (Either
(ParseErrorBundle CompilerName (ErrorFancy Void))
(Compiler, [(CompilerName, Version)])
-> Either String (Compiler, [(CompilerName, Version)]))
-> Either
(ParseErrorBundle CompilerName (ErrorFancy Void))
(Compiler, [(CompilerName, Version)])
-> Either String (Compiler, [(CompilerName, Version)])
forall a b. (a -> b) -> a -> b
$ Parsec
(ErrorFancy Void)
CompilerName
(Compiler, [(CompilerName, Version)])
-> String
-> CompilerName
-> Either
(ParseErrorBundle CompilerName (ErrorFancy Void))
(Compiler, [(CompilerName, Version)])
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser Parsec
(ErrorFancy Void)
CompilerName
(Compiler, [(CompilerName, Version)])
parser String
"" CompilerName
input
where
mapError :: Either a b -> Either String b
mapError (Left a
e) = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
e
mapError (Right b
a) = b -> Either String b
forall a b. b -> Either a b
Right b
a
parser :: Parsec
(ErrorFancy Void)
CompilerName
(Compiler, [(CompilerName, Version)])
parser = do
ParsecT (ErrorFancy Void) CompilerName Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
CompilerVersion
cv <- ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
parserCompilerVersion
ParsecT (ErrorFancy Void) CompilerName Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space1
[(CompilerName, Version)]
vers <- ParsecT
(ErrorFancy Void) CompilerName Identity (CompilerName, Version)
-> ParsecT (ErrorFancy Void) CompilerName Identity ()
-> ParsecT
(ErrorFancy Void) CompilerName Identity [(CompilerName, Version)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy ParsecT
(ErrorFancy Void) CompilerName Identity (CompilerName, Version)
parserPVer ParsecT (ErrorFancy Void) CompilerName Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space1
(Compiler, [(CompilerName, Version)])
-> Parsec
(ErrorFancy Void)
CompilerName
(Compiler, [(CompilerName, Version)])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerName -> CompilerVersion -> Compiler
Compiler CompilerName
ghcName CompilerVersion
cv, [(CompilerName, Version)]
vers)
parserCompilerVersion :: ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
parserCompilerVersion = ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
headVersion ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
-> ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
-> ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Version -> CompilerVersion
CVNumbered (Version -> CompilerVersion)
-> ParsecT (ErrorFancy Void) CompilerName Identity Version
-> ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (ErrorFancy Void) CompilerName Identity Version
parserVersion)
headVersion :: ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
headVersion = do
ParsecT (ErrorFancy Void) CompilerName Identity String
-> ParsecT (ErrorFancy Void) CompilerName Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT (ErrorFancy Void) CompilerName Identity String
-> ParsecT (ErrorFancy Void) CompilerName Identity ())
-> ParsecT (ErrorFancy Void) CompilerName Identity String
-> ParsecT (ErrorFancy Void) CompilerName Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT (ErrorFancy Void) CompilerName Identity String
P.string String
"HEAD"
CompilerVersion
-> ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerVersion
CVHead
parserPVer :: ParsecT
(ErrorFancy Void) CompilerName Identity (CompilerName, Version)
parserPVer = do
CompilerName
name <- (Char -> Bool) -> Parser CompilerName
P.textSatisfying (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/')
ParsecT (ErrorFancy Void) CompilerName Identity Char
-> ParsecT (ErrorFancy Void) CompilerName Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT (ErrorFancy Void) CompilerName Identity Char
-> ParsecT (ErrorFancy Void) CompilerName Identity ())
-> ParsecT (ErrorFancy Void) CompilerName Identity Char
-> ParsecT (ErrorFancy Void) CompilerName Identity ()
forall a b. (a -> b) -> a -> b
$ Token CompilerName
-> ParsecT
(ErrorFancy Void) CompilerName Identity (Token CompilerName)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token CompilerName
'/'
Version
ver <- ParsecT (ErrorFancy Void) CompilerName Identity Version
parserVersion
(CompilerName, Version)
-> ParsecT
(ErrorFancy Void) CompilerName Identity (CompilerName, Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerName
name, Version
ver)
parseGHCPkgVersions :: BSL.ByteString -> Either String (HM.HashMap Compiler CoreBuildPlanMap)
parseGHCPkgVersions :: ByteString -> Either String CompilerCores
parseGHCPkgVersions ByteString
content =
(CompilerCores -> CompilerName -> Either String CompilerCores)
-> CompilerCores -> [CompilerName] -> Either String CompilerCores
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM CompilerCores -> CompilerName -> Either String CompilerCores
f CompilerCores
forall k v. HashMap k v
HM.empty ([CompilerName] -> Either String CompilerCores)
-> [CompilerName] -> Either String CompilerCores
forall a b. (a -> b) -> a -> b
$ (CompilerName -> Bool) -> [CompilerName] -> [CompilerName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (CompilerName -> Bool) -> CompilerName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerName -> Bool
isWhiteLine) ([CompilerName] -> [CompilerName])
-> [CompilerName] -> [CompilerName]
forall a b. (a -> b) -> a -> b
$ (CompilerName -> CompilerName) -> [CompilerName] -> [CompilerName]
forall a b. (a -> b) -> [a] -> [b]
map CompilerName -> CompilerName
removeComment ([CompilerName] -> [CompilerName])
-> [CompilerName] -> [CompilerName]
forall a b. (a -> b) -> a -> b
$ ByteString -> [CompilerName]
toLines ByteString
content
where
toLines :: BSL.ByteString -> [Text]
toLines :: ByteString -> [CompilerName]
toLines = (Text -> CompilerName) -> [Text] -> [CompilerName]
forall a b. (a -> b) -> [a] -> [b]
map Text -> CompilerName
TL.toStrict ([Text] -> [CompilerName])
-> (ByteString -> [Text]) -> ByteString -> [CompilerName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
TL.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8
removeComment :: CompilerName -> CompilerName
removeComment = (Char -> Bool) -> CompilerName -> CompilerName
T.takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#')
isWhiteLine :: CompilerName -> Bool
isWhiteLine = (Char -> Bool) -> CompilerName -> Bool
T.all Char -> Bool
isSpace
f :: CompilerCores -> CompilerName -> Either String CompilerCores
f CompilerCores
acc CompilerName
line = do
(Compiler
c, [(CompilerName, Version)]
vers) <- CompilerName -> Either String (Compiler, [(CompilerName, Version)])
parsePkgVersionsLine CompilerName
line
CompilerCores -> Either String CompilerCores
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerCores -> Either String CompilerCores)
-> CompilerCores -> Either String CompilerCores
forall a b. (a -> b) -> a -> b
$ Compiler
-> [(CompilerName, Version)] -> CompilerCores -> CompilerCores
addVersions Compiler
c [(CompilerName, Version)]
vers CompilerCores
acc
fetchGHCPkgVersions :: Manager -> IO BSL.ByteString
fetchGHCPkgVersions :: Manager -> IO ByteString
fetchGHCPkgVersions Manager
man = Manager -> String -> IO ByteString
fetchURL Manager
man String
"https://gitlab.haskell.org/bgamari/ghc-utils/-/raw/master/library-versions/pkg_versions.txt"