module Staversion.Internal.BuildPlan.Pantry
( PantryBuildPlanMap,
PantryName,
pantryCompiler,
pantryName,
toBuildPlanMap,
coresToBuildPlanMap,
parseBuildPlanMapYAML,
fetchBuildPlanMapYAML
) where
import Control.Applicative ((<$>), (<*>), empty, (<|>))
import Control.Monad (void)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Aeson (FromJSON(..), Value(..), (.:), (.:!))
import qualified Data.Aeson.Types as Aeson
import qualified Data.HashMap.Strict as HM
import Data.Monoid ((<>))
import Data.Text (pack, Text)
import qualified Data.Yaml as Yaml
import Staversion.Internal.BuildPlan.BuildPlanMap
( BuildPlanMap,
HasVersions(..),
)
import qualified Staversion.Internal.BuildPlan.BuildPlanMap as BuildPlanMap
import Staversion.Internal.BuildPlan.Core
( Compiler(..),
CoreBuildPlanMap(..),
CompilerVersion(..),
CompilerCores
)
import Staversion.Internal.BuildPlan.Parser (parserVersion, manyTillWithEnd)
import Staversion.Internal.BuildPlan.Stackage (ExactResolver(..))
import qualified Staversion.Internal.Megaparsec as P
import Staversion.Internal.HTTP (Manager, fetchURL)
import Staversion.Internal.Query (ErrorMsg, PackageName)
import Staversion.Internal.Version (Version)
type PantryName = Text
data PantryBuildPlanMap =
PantryBuildPlanMap
{ PantryBuildPlanMap -> Maybe Text
pantryName :: Maybe PantryName,
PantryBuildPlanMap -> Compiler
pantryCompiler :: Compiler,
PantryBuildPlanMap -> BuildPlanMap
pantryMap :: BuildPlanMap
}
instance HasVersions PantryBuildPlanMap where
packageVersion :: PantryBuildPlanMap -> Text -> Maybe Version
packageVersion PantryBuildPlanMap
pbp = forall t. HasVersions t => t -> Text -> Maybe Version
packageVersion (PantryBuildPlanMap -> BuildPlanMap
pantryMap PantryBuildPlanMap
pbp)
instance FromJSON PantryBuildPlanMap where
parseJSON :: Value -> Parser PantryBuildPlanMap
parseJSON (Object Object
o) =
Maybe Text -> Compiler -> BuildPlanMap -> PantryBuildPlanMap
PantryBuildPlanMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:! Key
"name")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PantryCompiler -> Compiler
unPantryCompiler Parser PantryCompiler
parserCompiler
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PantryPackage] -> BuildPlanMap
fromPantryPackageList (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"packages")
where
parserCompiler :: Parser PantryCompiler
parserCompiler = (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"compiler") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser PantryCompiler
parserResolverCompiler
parserResolverCompiler :: Parser PantryCompiler
parserResolverCompiler = do
Object
res <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"resolver"
Object
res forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"compiler"
parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty
newtype PantryPackage = PantryPackage { PantryPackage -> (Text, Version)
unPantryPackage :: (PackageName, Version) }
deriving (Int -> PantryPackage -> ShowS
[PantryPackage] -> ShowS
PantryPackage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PantryPackage] -> ShowS
$cshowList :: [PantryPackage] -> ShowS
show :: PantryPackage -> String
$cshow :: PantryPackage -> String
showsPrec :: Int -> PantryPackage -> ShowS
$cshowsPrec :: Int -> PantryPackage -> ShowS
Show,PantryPackage -> PantryPackage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PantryPackage -> PantryPackage -> Bool
$c/= :: PantryPackage -> PantryPackage -> Bool
== :: PantryPackage -> PantryPackage -> Bool
$c== :: PantryPackage -> PantryPackage -> Bool
Eq,Eq PantryPackage
PantryPackage -> PantryPackage -> Bool
PantryPackage -> PantryPackage -> Ordering
PantryPackage -> PantryPackage -> PantryPackage
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 :: PantryPackage -> PantryPackage -> PantryPackage
$cmin :: PantryPackage -> PantryPackage -> PantryPackage
max :: PantryPackage -> PantryPackage -> PantryPackage
$cmax :: PantryPackage -> PantryPackage -> PantryPackage
>= :: PantryPackage -> PantryPackage -> Bool
$c>= :: PantryPackage -> PantryPackage -> Bool
> :: PantryPackage -> PantryPackage -> Bool
$c> :: PantryPackage -> PantryPackage -> Bool
<= :: PantryPackage -> PantryPackage -> Bool
$c<= :: PantryPackage -> PantryPackage -> Bool
< :: PantryPackage -> PantryPackage -> Bool
$c< :: PantryPackage -> PantryPackage -> Bool
compare :: PantryPackage -> PantryPackage -> Ordering
$ccompare :: PantryPackage -> PantryPackage -> Ordering
Ord)
fromPantryPackageList :: [PantryPackage] -> BuildPlanMap
fromPantryPackageList :: [PantryPackage] -> BuildPlanMap
fromPantryPackageList = [(Text, Version)] -> BuildPlanMap
BuildPlanMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map PantryPackage -> (Text, Version)
unPantryPackage
instance FromJSON PantryPackage where
parseJSON :: Value -> Parser PantryPackage
parseJSON (Object Object
o) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Version) -> PantryPackage
PantryPackage forall a b. (a -> b) -> a -> b
$ Text -> Parser (Text, Version)
parsePText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hackage")
where
parsePText :: Text -> Aeson.Parser (PackageName, Version)
parsePText :: Text -> Parser (Text, Version)
parsePText Text
t = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser Parser (Text, Version)
the_parser String
"" Text
t
the_parser :: Parser (Text, Version)
the_parser = Parser () -> Parser (Text, Version)
parserPackage (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
'@')
parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty
newtype PantryCompiler = PantryCompiler { PantryCompiler -> Compiler
unPantryCompiler :: Compiler }
deriving (Int -> PantryCompiler -> ShowS
[PantryCompiler] -> ShowS
PantryCompiler -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PantryCompiler] -> ShowS
$cshowList :: [PantryCompiler] -> ShowS
show :: PantryCompiler -> String
$cshow :: PantryCompiler -> String
showsPrec :: Int -> PantryCompiler -> ShowS
$cshowsPrec :: Int -> PantryCompiler -> ShowS
Show,PantryCompiler -> PantryCompiler -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PantryCompiler -> PantryCompiler -> Bool
$c/= :: PantryCompiler -> PantryCompiler -> Bool
== :: PantryCompiler -> PantryCompiler -> Bool
$c== :: PantryCompiler -> PantryCompiler -> Bool
Eq,Eq PantryCompiler
PantryCompiler -> PantryCompiler -> Bool
PantryCompiler -> PantryCompiler -> Ordering
PantryCompiler -> PantryCompiler -> PantryCompiler
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 :: PantryCompiler -> PantryCompiler -> PantryCompiler
$cmin :: PantryCompiler -> PantryCompiler -> PantryCompiler
max :: PantryCompiler -> PantryCompiler -> PantryCompiler
$cmax :: PantryCompiler -> PantryCompiler -> PantryCompiler
>= :: PantryCompiler -> PantryCompiler -> Bool
$c>= :: PantryCompiler -> PantryCompiler -> Bool
> :: PantryCompiler -> PantryCompiler -> Bool
$c> :: PantryCompiler -> PantryCompiler -> Bool
<= :: PantryCompiler -> PantryCompiler -> Bool
$c<= :: PantryCompiler -> PantryCompiler -> Bool
< :: PantryCompiler -> PantryCompiler -> Bool
$c< :: PantryCompiler -> PantryCompiler -> Bool
compare :: PantryCompiler -> PantryCompiler -> Ordering
$ccompare :: PantryCompiler -> PantryCompiler -> Ordering
Ord)
instance FromJSON PantryCompiler where
parseJSON :: Value -> Parser PantryCompiler
parseJSON (String Text
s) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Version) -> PantryCompiler
toCompiler forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser Parser (Text, Version)
the_parser String
"" Text
s
where
the_parser :: Parser (Text, Version)
the_parser = Parser () -> Parser (Text, Version)
parserPackage (forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof)
toCompiler :: (Text, Version) -> PantryCompiler
toCompiler (Text
name, Version
ver) = Compiler -> PantryCompiler
PantryCompiler forall a b. (a -> b) -> a -> b
$ Text -> CompilerVersion -> Compiler
Compiler Text
name forall a b. (a -> b) -> a -> b
$ Version -> CompilerVersion
CVNumbered Version
ver
parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty
toBuildPlanMap :: CoreBuildPlanMap -> PantryBuildPlanMap -> Either String BuildPlanMap
toBuildPlanMap :: CoreBuildPlanMap
-> PantryBuildPlanMap -> Either String BuildPlanMap
toBuildPlanMap CoreBuildPlanMap
cbp PantryBuildPlanMap
pbp =
if Compiler
ccv forall a. Eq a => a -> a -> Bool
== Compiler
pcv
then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ PantryBuildPlanMap -> BuildPlanMap
pantryMap PantryBuildPlanMap
pbp forall a. Semigroup a => a -> a -> a
<> CoreBuildPlanMap -> BuildPlanMap
coreMap CoreBuildPlanMap
cbp
else forall a b. a -> Either a b
Left (String
"Unmatched compiler versions: Core: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Compiler
ccv forall a. Semigroup a => a -> a -> a
<> String
", Pantry: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Compiler
pcv)
where
ccv :: Compiler
ccv = CoreBuildPlanMap -> Compiler
coreCompiler CoreBuildPlanMap
cbp
pcv :: Compiler
pcv = PantryBuildPlanMap -> Compiler
pantryCompiler PantryBuildPlanMap
pbp
coresToBuildPlanMap :: CompilerCores -> PantryBuildPlanMap -> Either String BuildPlanMap
coresToBuildPlanMap :: CompilerCores -> PantryBuildPlanMap -> Either String BuildPlanMap
coresToBuildPlanMap CompilerCores
cmap PantryBuildPlanMap
pbp = do
CoreBuildPlanMap
cbp <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left (String
"No CoreBuildPlanMap for compiler " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Compiler
compiler)) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Compiler
compiler CompilerCores
cmap
CoreBuildPlanMap
-> PantryBuildPlanMap -> Either String BuildPlanMap
toBuildPlanMap CoreBuildPlanMap
cbp PantryBuildPlanMap
pbp
where
compiler :: Compiler
compiler = PantryBuildPlanMap -> Compiler
pantryCompiler PantryBuildPlanMap
pbp
parseBuildPlanMapYAML :: BS.ByteString -> Either ErrorMsg PantryBuildPlanMap
parseBuildPlanMapYAML :: ByteString -> Either String PantryBuildPlanMap
parseBuildPlanMapYAML = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
toErrorMsg) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither'
where
toErrorMsg :: a -> String
toErrorMsg a
e = String
"Error while parsing PantryBuildPlanMap: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
e
fetchBuildPlanMapYAML :: Manager -> ExactResolver -> IO BSL.ByteString
fetchBuildPlanMapYAML :: Manager -> ExactResolver -> IO ByteString
fetchBuildPlanMapYAML Manager
man ExactResolver
er = Manager -> String -> IO ByteString
fetchURL Manager
man String
url
where
url :: String
url = String
"https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/" forall a. Semigroup a => a -> a -> a
<> String
resolver_part
resolver_part :: String
resolver_part =
case ExactResolver
er of
ExactLTS Word
major Word
minor -> String
"lts/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word
major forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word
minor forall a. [a] -> [a] -> [a]
++ String
".yaml"
ExactNightly Word
year Word
month Word
day -> String
"nightly/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word
year forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word
month forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word
day forall a. [a] -> [a] -> [a]
++ String
".yaml"
parserPackage :: P.Parser ()
-> P.Parser (PackageName, Version)
parserPackage :: Parser () -> Parser (Text, Version)
parserPackage Parser ()
end = do
(String
pstr, Version
ver) <- forall a end. Parser a -> Parser end -> Parser ([a], end)
manyTillWithEnd Parser Char
P.anyChar ParsecT (ErrorFancy Void) Text Identity Version
versionAndEnd
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
pack String
pstr, Version
ver)
where
versionAndEnd :: ParsecT (ErrorFancy Void) Text Identity Version
versionAndEnd = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
'-'
Version
v <- ParsecT (ErrorFancy Void) Text Identity Version
parserVersion
Parser ()
end
forall (m :: * -> *) a. Monad m => a -> m a
return Version
v