{-# LANGUAGE CPP #-}
-- |
-- Module: Staversion.Internal.BuildPlan.V1
-- Description: The legacy "version 1" of build plan YAML files
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. End-users should not use it.__
--
-- @since 0.2.4.0

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)


-- | Fetch build plan YAML data from the Internet. This function
-- fetches a build plan YAML file of "version 1" format.
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

-- | Parse "version 1" format of build plan YAML file.
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

-- | Load a 'BuildPlanMap' from a file.
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 -- TODO: make it memory-efficient!