{-# LANGUAGE CPP #-}
module Staversion.Internal.BuildPlan.V1
( fetchBuildPlanYAML,
parseBuildPlanMapYAML,
loadBuildPlanMapYAML
) where
import Control.Applicative (empty)
import Data.Aeson (FromJSON(..), (.:), Value(..), Object)
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (toHashMapText)
#endif
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.HashMap.Strict as HM
import Data.Monoid ((<>))
import qualified Data.Yaml as Yaml
import Staversion.Internal.HTTP (Manager, fetchURL, OurHttpException)
import Staversion.Internal.Query (PackageName, ErrorMsg)
import Staversion.Internal.BuildPlan.BuildPlanMap (BuildPlanMap)
import qualified Staversion.Internal.BuildPlan.BuildPlanMap as BPMap
import Staversion.Internal.BuildPlan.Stackage (ExactResolver(..), PartialResolver(..), formatResolverString)
import Staversion.Internal.BuildPlan.Version (unVersionJSON)
import Staversion.Internal.Version (Version)
fetchBuildPlanYAML :: Manager -> ExactResolver -> IO BSL.ByteString
fetchBuildPlanYAML :: Manager -> ExactResolver -> IO ByteString
fetchBuildPlanYAML Manager
man ExactResolver
resolver = Manager -> String -> IO ByteString
fetchURL Manager
man String
url where
resolver_str :: String
resolver_str = PartialResolver -> String
formatResolverString forall a b. (a -> b) -> a -> b
$ ExactResolver -> PartialResolver
PartialExact forall a b. (a -> b) -> a -> b
$ ExactResolver
resolver
url :: String
url = case ExactResolver
resolver of
ExactLTS Word
_ Word
_ -> String
"https://raw.githubusercontent.com/fpco/lts-haskell/master/" forall a. [a] -> [a] -> [a]
++ String
resolver_str forall a. [a] -> [a] -> [a]
++ String
".yaml"
ExactNightly Word
_ Word
_ Word
_ -> String
"https://raw.githubusercontent.com/fpco/stackage-nightly/master/" forall a. [a] -> [a] -> [a]
++ String
resolver_str forall a. [a] -> [a] -> [a]
++ String
".yaml"
newtype V1BuildPlanMap = V1BuildPlanMap (HM.HashMap PackageName Version) deriving (Int -> V1BuildPlanMap -> ShowS
[V1BuildPlanMap] -> ShowS
V1BuildPlanMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1BuildPlanMap] -> ShowS
$cshowList :: [V1BuildPlanMap] -> ShowS
show :: V1BuildPlanMap -> String
$cshow :: V1BuildPlanMap -> String
showsPrec :: Int -> V1BuildPlanMap -> ShowS
$cshowsPrec :: Int -> V1BuildPlanMap -> ShowS
Show,V1BuildPlanMap -> V1BuildPlanMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1BuildPlanMap -> V1BuildPlanMap -> Bool
$c/= :: V1BuildPlanMap -> V1BuildPlanMap -> Bool
== :: V1BuildPlanMap -> V1BuildPlanMap -> Bool
$c== :: V1BuildPlanMap -> V1BuildPlanMap -> Bool
Eq)
instance FromJSON V1BuildPlanMap where
parseJSON :: Value -> Parser V1BuildPlanMap
parseJSON (Object Object
object) =
(\KeyMap Version
p1 KeyMap Version
p2 -> HashMap PackageName Version -> V1BuildPlanMap
V1BuildPlanMap forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> HashMap PackageName v
toHashMapText KeyMap Version
p1 forall a. Semigroup a => a -> a -> a
<> forall v. KeyMap v -> HashMap PackageName v
toHashMapText KeyMap Version
p2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (KeyMap Version)
core_packages forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (KeyMap Version)
other_packages
where
core_packages :: Parser (KeyMap Version)
core_packages = Value -> Parser (KeyMap Version)
parseSysInfo forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
object forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"system-info")
parseSysInfo :: Value -> Parser (KeyMap Version)
parseSysInfo (Object Object
o) = Value -> Parser (KeyMap Version)
parseCorePackages forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"core-packages")
parseSysInfo Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty
parseCorePackages :: Value -> Parser (KeyMap Version)
parseCorePackages (Object Object
o) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Value
v -> VersionJSON -> Version
unVersionJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v) Object
o
parseCorePackages Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty
other_packages :: Parser (KeyMap Version)
other_packages = Value -> Parser (KeyMap Version)
parsePackages forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
object forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"packages")
parsePackages :: Value -> Parser (KeyMap Version)
parsePackages (Object Object
o) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser Version
parsePackageObject Object
o
parsePackages Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty
parsePackageObject :: Value -> Parser Version
parsePackageObject (Object Object
o) = VersionJSON -> Version
unVersionJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version")
parsePackageObject Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty
#if !MIN_VERSION_aeson(2,0,0)
toHashMapText = id
#endif
parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty
toBuildPlanMap :: V1BuildPlanMap -> BuildPlanMap
toBuildPlanMap :: V1BuildPlanMap -> BuildPlanMap
toBuildPlanMap (V1BuildPlanMap HashMap PackageName Version
m) = HashMap PackageName Version -> BuildPlanMap
BPMap.fromMap HashMap PackageName Version
m
parseBuildPlanMapYAML :: BS.ByteString -> Either ErrorMsg BuildPlanMap
parseBuildPlanMapYAML :: ByteString -> Either String BuildPlanMap
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
. V1BuildPlanMap -> BuildPlanMap
toBuildPlanMap) 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
parse_exception = String
"Error while parsing BuildPlanMap YAML: " forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => a -> String
show a
parse_exception
loadBuildPlanMapYAML :: FilePath -> IO (Either ErrorMsg BuildPlanMap)
loadBuildPlanMapYAML :: String -> IO (Either String BuildPlanMap)
loadBuildPlanMapYAML String
yaml_file = ByteString -> Either String BuildPlanMap
parseBuildPlanMapYAML forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
yaml_file where