{-# 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 (PartialResolver -> String) -> PartialResolver -> String
forall a b. (a -> b) -> a -> b
$ ExactResolver -> PartialResolver
PartialExact (ExactResolver -> PartialResolver)
-> ExactResolver -> PartialResolver
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/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
resolver_str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".yaml"
ExactNightly Word
_ Word
_ Word
_ -> String
"https://raw.githubusercontent.com/fpco/stackage-nightly/master/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
resolver_str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".yaml"
newtype V1BuildPlanMap = V1BuildPlanMap (HM.HashMap PackageName Version) deriving (Int -> V1BuildPlanMap -> String -> String
[V1BuildPlanMap] -> String -> String
V1BuildPlanMap -> String
(Int -> V1BuildPlanMap -> String -> String)
-> (V1BuildPlanMap -> String)
-> ([V1BuildPlanMap] -> String -> String)
-> Show V1BuildPlanMap
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> V1BuildPlanMap -> String -> String
showsPrec :: Int -> V1BuildPlanMap -> String -> String
$cshow :: V1BuildPlanMap -> String
show :: V1BuildPlanMap -> String
$cshowList :: [V1BuildPlanMap] -> String -> String
showList :: [V1BuildPlanMap] -> String -> String
Show,V1BuildPlanMap -> V1BuildPlanMap -> Bool
(V1BuildPlanMap -> V1BuildPlanMap -> Bool)
-> (V1BuildPlanMap -> V1BuildPlanMap -> Bool) -> Eq V1BuildPlanMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: V1BuildPlanMap -> V1BuildPlanMap -> Bool
== :: V1BuildPlanMap -> V1BuildPlanMap -> Bool
$c/= :: V1BuildPlanMap -> V1BuildPlanMap -> Bool
/= :: 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 (HashMap PackageName Version -> V1BuildPlanMap)
-> HashMap PackageName Version -> V1BuildPlanMap
forall a b. (a -> b) -> a -> b
$ KeyMap Version -> HashMap PackageName Version
forall v. KeyMap v -> HashMap PackageName v
toHashMapText KeyMap Version
p1 HashMap PackageName Version
-> HashMap PackageName Version -> HashMap PackageName Version
forall a. Semigroup a => a -> a -> a
<> KeyMap Version -> HashMap PackageName Version
forall v. KeyMap v -> HashMap PackageName v
toHashMapText KeyMap Version
p2) (KeyMap Version -> KeyMap Version -> V1BuildPlanMap)
-> Parser (KeyMap Version)
-> Parser (KeyMap Version -> V1BuildPlanMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (KeyMap Version)
core_packages Parser (KeyMap Version -> V1BuildPlanMap)
-> Parser (KeyMap Version) -> Parser V1BuildPlanMap
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 (Value -> Parser (KeyMap Version))
-> Parser Value -> Parser (KeyMap Version)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
object Object -> Key -> Parser Value
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 (Value -> Parser (KeyMap Version))
-> Parser Value -> Parser (KeyMap Version)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"core-packages")
parseSysInfo Value
_ = Parser (KeyMap Version)
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty
parseCorePackages :: Value -> Parser (KeyMap Version)
parseCorePackages (Object Object
o) = (Value -> Parser Version) -> Object -> Parser (KeyMap Version)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> KeyMap a -> f (KeyMap b)
traverse (\Value
v -> VersionJSON -> Version
unVersionJSON (VersionJSON -> Version) -> Parser VersionJSON -> Parser Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser VersionJSON
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v) Object
o
parseCorePackages Value
_ = Parser (KeyMap Version)
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty
other_packages :: Parser (KeyMap Version)
other_packages = Value -> Parser (KeyMap Version)
parsePackages (Value -> Parser (KeyMap Version))
-> Parser Value -> Parser (KeyMap Version)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
object Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"packages")
parsePackages :: Value -> Parser (KeyMap Version)
parsePackages (Object Object
o) = (Value -> Parser Version) -> Object -> Parser (KeyMap Version)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> KeyMap a -> f (KeyMap b)
traverse Value -> Parser Version
parsePackageObject Object
o
parsePackages Value
_ = Parser (KeyMap Version)
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty
parsePackageObject :: Value -> Parser Version
parsePackageObject (Object Object
o) = VersionJSON -> Version
unVersionJSON (VersionJSON -> Version) -> Parser VersionJSON -> Parser Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser VersionJSON
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version")
parsePackageObject Value
_ = Parser Version
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty
#if !MIN_VERSION_aeson(2,0,0)
toHashMapText = id
#endif
parseJSON Value
_ = Parser V1BuildPlanMap
forall a. Parser a
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 = (ParseException -> Either String BuildPlanMap)
-> (V1BuildPlanMap -> Either String BuildPlanMap)
-> Either ParseException V1BuildPlanMap
-> Either String BuildPlanMap
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String BuildPlanMap
forall a b. a -> Either a b
Left (String -> Either String BuildPlanMap)
-> (ParseException -> String)
-> ParseException
-> Either String BuildPlanMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> String
forall {a}. Show a => a -> String
toErrorMsg) (BuildPlanMap -> Either String BuildPlanMap
forall a b. b -> Either a b
Right (BuildPlanMap -> Either String BuildPlanMap)
-> (V1BuildPlanMap -> BuildPlanMap)
-> V1BuildPlanMap
-> Either String BuildPlanMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V1BuildPlanMap -> BuildPlanMap
toBuildPlanMap) (Either ParseException V1BuildPlanMap
-> Either String BuildPlanMap)
-> (ByteString -> Either ParseException V1BuildPlanMap)
-> ByteString
-> Either String BuildPlanMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseException V1BuildPlanMap
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' where
toErrorMsg :: a -> String
toErrorMsg a
parse_exception = String
"Error while parsing BuildPlanMap YAML: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
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 (ByteString -> Either String BuildPlanMap)
-> IO ByteString -> IO (Either String BuildPlanMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
yaml_file where