{-# 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 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

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

-- | 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 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!