-- |
-- Module: Staversion.Internal.BuildPlan.Pantry
-- Description: Pantry YAML format of build plan
-- 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.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)

-- | Name of a pantry snapshot
type PantryName = Text

-- | A build plan map loaded from a Pantry YAML file. This is not a
-- complete 'BuildPlanMap', because it implicitly refers to
-- 'CoreBuildPlanMap'. That's why its data constructor is not
-- exported.
data PantryBuildPlanMap =
  PantryBuildPlanMap
  { PantryBuildPlanMap -> Maybe PantryName
pantryName :: Maybe PantryName,
    PantryBuildPlanMap -> Compiler
pantryCompiler :: Compiler,
    PantryBuildPlanMap -> BuildPlanMap
pantryMap :: BuildPlanMap
  }

instance HasVersions PantryBuildPlanMap where
  packageVersion :: PantryBuildPlanMap -> PantryName -> Maybe Version
packageVersion PantryBuildPlanMap
pbp = BuildPlanMap -> PantryName -> Maybe Version
forall t. HasVersions t => t -> PantryName -> Maybe Version
packageVersion (PantryBuildPlanMap -> BuildPlanMap
pantryMap PantryBuildPlanMap
pbp)

instance FromJSON PantryBuildPlanMap where
  parseJSON :: Value -> Parser PantryBuildPlanMap
parseJSON (Object Object
o) =
    Maybe PantryName -> Compiler -> BuildPlanMap -> PantryBuildPlanMap
PantryBuildPlanMap
    (Maybe PantryName
 -> Compiler -> BuildPlanMap -> PantryBuildPlanMap)
-> Parser (Maybe PantryName)
-> Parser (Compiler -> BuildPlanMap -> PantryBuildPlanMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> PantryName -> Parser (Maybe PantryName)
forall a. FromJSON a => Object -> PantryName -> Parser (Maybe a)
.:! PantryName
"name")
    Parser (Compiler -> BuildPlanMap -> PantryBuildPlanMap)
-> Parser Compiler -> Parser (BuildPlanMap -> PantryBuildPlanMap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PantryCompiler -> Compiler)
-> Parser PantryCompiler -> Parser Compiler
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PantryCompiler -> Compiler
unPantryCompiler Parser PantryCompiler
parserCompiler
    Parser (BuildPlanMap -> PantryBuildPlanMap)
-> Parser BuildPlanMap -> Parser PantryBuildPlanMap
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([PantryPackage] -> BuildPlanMap)
-> Parser [PantryPackage] -> Parser BuildPlanMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PantryPackage] -> BuildPlanMap
fromPantryPackageList (Object
o Object -> PantryName -> Parser [PantryPackage]
forall a. FromJSON a => Object -> PantryName -> Parser a
.: PantryName
"packages")
    where
      parserCompiler :: Parser PantryCompiler
parserCompiler = (Object
o Object -> PantryName -> Parser PantryCompiler
forall a. FromJSON a => Object -> PantryName -> Parser a
.: PantryName
"compiler") Parser PantryCompiler
-> Parser PantryCompiler -> Parser PantryCompiler
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser PantryCompiler
parserResolverCompiler
      parserResolverCompiler :: Parser PantryCompiler
parserResolverCompiler = do
        Object
res <- Object
o Object -> PantryName -> Parser Object
forall a. FromJSON a => Object -> PantryName -> Parser a
.: PantryName
"resolver"
        Object
res Object -> PantryName -> Parser PantryCompiler
forall a. FromJSON a => Object -> PantryName -> Parser a
.: PantryName
"compiler"
  parseJSON Value
_ = Parser PantryBuildPlanMap
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Internal type to parse a package in Pantry YAML.
newtype PantryPackage = PantryPackage { PantryPackage -> (PantryName, Version)
unPantryPackage :: (PackageName, Version) }
  deriving (Int -> PantryPackage -> ShowS
[PantryPackage] -> ShowS
PantryPackage -> String
(Int -> PantryPackage -> ShowS)
-> (PantryPackage -> String)
-> ([PantryPackage] -> ShowS)
-> Show PantryPackage
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
(PantryPackage -> PantryPackage -> Bool)
-> (PantryPackage -> PantryPackage -> Bool) -> Eq PantryPackage
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
Eq PantryPackage
-> (PantryPackage -> PantryPackage -> Ordering)
-> (PantryPackage -> PantryPackage -> Bool)
-> (PantryPackage -> PantryPackage -> Bool)
-> (PantryPackage -> PantryPackage -> Bool)
-> (PantryPackage -> PantryPackage -> Bool)
-> (PantryPackage -> PantryPackage -> PantryPackage)
-> (PantryPackage -> PantryPackage -> PantryPackage)
-> Ord 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
$cp1Ord :: Eq PantryPackage
Ord)

fromPantryPackageList :: [PantryPackage] -> BuildPlanMap
fromPantryPackageList :: [PantryPackage] -> BuildPlanMap
fromPantryPackageList = [(PantryName, Version)] -> BuildPlanMap
BuildPlanMap.fromList ([(PantryName, Version)] -> BuildPlanMap)
-> ([PantryPackage] -> [(PantryName, Version)])
-> [PantryPackage]
-> BuildPlanMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PantryPackage -> (PantryName, Version))
-> [PantryPackage] -> [(PantryName, Version)]
forall a b. (a -> b) -> [a] -> [b]
map PantryPackage -> (PantryName, Version)
unPantryPackage

instance FromJSON PantryPackage where
  parseJSON :: Value -> Parser PantryPackage
parseJSON (Object Object
o) = ((PantryName, Version) -> PantryPackage)
-> Parser (PantryName, Version) -> Parser PantryPackage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PantryName, Version) -> PantryPackage
PantryPackage (Parser (PantryName, Version) -> Parser PantryPackage)
-> Parser (PantryName, Version) -> Parser PantryPackage
forall a b. (a -> b) -> a -> b
$ PantryName -> Parser (PantryName, Version)
parsePText (PantryName -> Parser (PantryName, Version))
-> Parser PantryName -> Parser (PantryName, Version)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o Object -> PantryName -> Parser PantryName
forall a. FromJSON a => Object -> PantryName -> Parser a
.: PantryName
"hackage")
    where
      parsePText :: Text -> Aeson.Parser (PackageName, Version)
      parsePText :: PantryName -> Parser (PantryName, Version)
parsePText PantryName
t = (ParseErrorBundle PantryName (ErrorFancy Void)
 -> Parser (PantryName, Version))
-> ((PantryName, Version) -> Parser (PantryName, Version))
-> Either
     (ParseErrorBundle PantryName (ErrorFancy Void))
     (PantryName, Version)
-> Parser (PantryName, Version)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser (PantryName, Version)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (PantryName, Version))
-> (ParseErrorBundle PantryName (ErrorFancy Void) -> String)
-> ParseErrorBundle PantryName (ErrorFancy Void)
-> Parser (PantryName, Version)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle PantryName (ErrorFancy Void) -> String
forall a. Show a => a -> String
show) (PantryName, Version) -> Parser (PantryName, Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (ParseErrorBundle PantryName (ErrorFancy Void))
   (PantryName, Version)
 -> Parser (PantryName, Version))
-> Either
     (ParseErrorBundle PantryName (ErrorFancy Void))
     (PantryName, Version)
-> Parser (PantryName, Version)
forall a b. (a -> b) -> a -> b
$ Parsec (ErrorFancy Void) PantryName (PantryName, Version)
-> String
-> PantryName
-> Either
     (ParseErrorBundle PantryName (ErrorFancy Void))
     (PantryName, Version)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser Parsec (ErrorFancy Void) PantryName (PantryName, Version)
the_parser String
"" PantryName
t
      the_parser :: Parsec (ErrorFancy Void) PantryName (PantryName, Version)
the_parser = Parser ()
-> Parsec (ErrorFancy Void) PantryName (PantryName, Version)
parserPackage (ParsecT (ErrorFancy Void) PantryName Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT (ErrorFancy Void) PantryName Identity Char -> Parser ())
-> ParsecT (ErrorFancy Void) PantryName Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token PantryName
-> ParsecT (ErrorFancy Void) PantryName Identity (Token PantryName)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token PantryName
'@')
  parseJSON Value
_ = Parser PantryPackage
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Internal type to parse a compiler in Pantry YAML.
newtype PantryCompiler = PantryCompiler { PantryCompiler -> Compiler
unPantryCompiler :: Compiler }
  deriving (Int -> PantryCompiler -> ShowS
[PantryCompiler] -> ShowS
PantryCompiler -> String
(Int -> PantryCompiler -> ShowS)
-> (PantryCompiler -> String)
-> ([PantryCompiler] -> ShowS)
-> Show PantryCompiler
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
(PantryCompiler -> PantryCompiler -> Bool)
-> (PantryCompiler -> PantryCompiler -> Bool) -> Eq PantryCompiler
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
Eq PantryCompiler
-> (PantryCompiler -> PantryCompiler -> Ordering)
-> (PantryCompiler -> PantryCompiler -> Bool)
-> (PantryCompiler -> PantryCompiler -> Bool)
-> (PantryCompiler -> PantryCompiler -> Bool)
-> (PantryCompiler -> PantryCompiler -> Bool)
-> (PantryCompiler -> PantryCompiler -> PantryCompiler)
-> (PantryCompiler -> PantryCompiler -> PantryCompiler)
-> Ord 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
$cp1Ord :: Eq PantryCompiler
Ord)

instance FromJSON PantryCompiler where
  parseJSON :: Value -> Parser PantryCompiler
parseJSON (String PantryName
s) = ((PantryName, Version) -> PantryCompiler)
-> Parser (PantryName, Version) -> Parser PantryCompiler
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PantryName, Version) -> PantryCompiler
toCompiler (Parser (PantryName, Version) -> Parser PantryCompiler)
-> Parser (PantryName, Version) -> Parser PantryCompiler
forall a b. (a -> b) -> a -> b
$ (ParseErrorBundle PantryName (ErrorFancy Void)
 -> Parser (PantryName, Version))
-> ((PantryName, Version) -> Parser (PantryName, Version))
-> Either
     (ParseErrorBundle PantryName (ErrorFancy Void))
     (PantryName, Version)
-> Parser (PantryName, Version)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser (PantryName, Version)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (PantryName, Version))
-> (ParseErrorBundle PantryName (ErrorFancy Void) -> String)
-> ParseErrorBundle PantryName (ErrorFancy Void)
-> Parser (PantryName, Version)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle PantryName (ErrorFancy Void) -> String
forall a. Show a => a -> String
show) (PantryName, Version) -> Parser (PantryName, Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (ParseErrorBundle PantryName (ErrorFancy Void))
   (PantryName, Version)
 -> Parser (PantryName, Version))
-> Either
     (ParseErrorBundle PantryName (ErrorFancy Void))
     (PantryName, Version)
-> Parser (PantryName, Version)
forall a b. (a -> b) -> a -> b
$ Parsec (ErrorFancy Void) PantryName (PantryName, Version)
-> String
-> PantryName
-> Either
     (ParseErrorBundle PantryName (ErrorFancy Void))
     (PantryName, Version)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser Parsec (ErrorFancy Void) PantryName (PantryName, Version)
the_parser String
"" PantryName
s
    where
      the_parser :: Parsec (ErrorFancy Void) PantryName (PantryName, Version)
the_parser = Parser ()
-> Parsec (ErrorFancy Void) PantryName (PantryName, Version)
parserPackage (Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof)
      toCompiler :: (PantryName, Version) -> PantryCompiler
toCompiler (PantryName
name, Version
ver) = Compiler -> PantryCompiler
PantryCompiler (Compiler -> PantryCompiler) -> Compiler -> PantryCompiler
forall a b. (a -> b) -> a -> b
$ PantryName -> CompilerVersion -> Compiler
Compiler PantryName
name (CompilerVersion -> Compiler) -> CompilerVersion -> Compiler
forall a b. (a -> b) -> a -> b
$ Version -> CompilerVersion
CVNumbered Version
ver
  parseJSON Value
_ = Parser PantryCompiler
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Combine 'PantryBuildPlanMap' and 'CoreBuildPlanMap' to make a
-- complete 'BuildPlanMap'.
toBuildPlanMap :: CoreBuildPlanMap -> PantryBuildPlanMap -> Either String BuildPlanMap
toBuildPlanMap :: CoreBuildPlanMap
-> PantryBuildPlanMap -> Either String BuildPlanMap
toBuildPlanMap CoreBuildPlanMap
cbp PantryBuildPlanMap
pbp = 
  if Compiler
ccv Compiler -> Compiler -> Bool
forall a. Eq a => a -> a -> Bool
== Compiler
pcv
  then BuildPlanMap -> Either String BuildPlanMap
forall a b. b -> Either a b
Right (BuildPlanMap -> Either String BuildPlanMap)
-> BuildPlanMap -> Either String BuildPlanMap
forall a b. (a -> b) -> a -> b
$ PantryBuildPlanMap -> BuildPlanMap
pantryMap PantryBuildPlanMap
pbp BuildPlanMap -> BuildPlanMap -> BuildPlanMap
forall a. Semigroup a => a -> a -> a
<> CoreBuildPlanMap -> BuildPlanMap
coreMap CoreBuildPlanMap
cbp
  else String -> Either String BuildPlanMap
forall a b. a -> Either a b
Left (String
"Unmatched compiler versions: Core: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Compiler -> String
forall a. Show a => a -> String
show Compiler
ccv String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", Pantry: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Compiler -> String
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

-- | Select a 'CoreBuildPlanMap' from the given map to make a complete
-- 'BuildPlanMap' from 'PantryBuildPlanMap'.
coresToBuildPlanMap :: CompilerCores -> PantryBuildPlanMap -> Either String BuildPlanMap
coresToBuildPlanMap :: CompilerCores -> PantryBuildPlanMap -> Either String BuildPlanMap
coresToBuildPlanMap CompilerCores
cmap PantryBuildPlanMap
pbp = do
  CoreBuildPlanMap
cbp <- Either String CoreBuildPlanMap
-> (CoreBuildPlanMap -> Either String CoreBuildPlanMap)
-> Maybe CoreBuildPlanMap
-> Either String CoreBuildPlanMap
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String CoreBuildPlanMap
forall a b. a -> Either a b
Left (String
"No CoreBuildPlanMap for compiler " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Compiler -> String
forall a. Show a => a -> String
show Compiler
compiler)) CoreBuildPlanMap -> Either String CoreBuildPlanMap
forall a b. b -> Either a b
Right (Maybe CoreBuildPlanMap -> Either String CoreBuildPlanMap)
-> Maybe CoreBuildPlanMap -> Either String CoreBuildPlanMap
forall a b. (a -> b) -> a -> b
$ Compiler -> CompilerCores -> Maybe CoreBuildPlanMap
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

-- | Parse a YAML document for a 'CoreBuildPlanMap'.
parseBuildPlanMapYAML :: BS.ByteString -> Either ErrorMsg PantryBuildPlanMap
parseBuildPlanMapYAML :: ByteString -> Either String PantryBuildPlanMap
parseBuildPlanMapYAML = (ParseException -> Either String PantryBuildPlanMap)
-> (PantryBuildPlanMap -> Either String PantryBuildPlanMap)
-> Either ParseException PantryBuildPlanMap
-> Either String PantryBuildPlanMap
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String PantryBuildPlanMap
forall a b. a -> Either a b
Left (String -> Either String PantryBuildPlanMap)
-> (ParseException -> String)
-> ParseException
-> Either String PantryBuildPlanMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> String
forall a. Show a => a -> String
toErrorMsg) PantryBuildPlanMap -> Either String PantryBuildPlanMap
forall a b. b -> Either a b
Right (Either ParseException PantryBuildPlanMap
 -> Either String PantryBuildPlanMap)
-> (ByteString -> Either ParseException PantryBuildPlanMap)
-> ByteString
-> Either String PantryBuildPlanMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseException PantryBuildPlanMap
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither'
  where
    toErrorMsg :: a -> String
toErrorMsg a
e = String
"Error while parsing PantryBuildPlanMap: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
e

-- | Fetch a Pantry build plan file from the Web.
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/" String -> ShowS
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/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
major String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
minor String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".yaml"
        ExactNightly Word
year Word
month Word
day -> String
"nightly/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
year String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
month String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
day String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".yaml"

parserPackage :: P.Parser () -- ^ Parser of a symbol that follows the packageName-version string.
              -> P.Parser (PackageName, Version)
parserPackage :: Parser ()
-> Parsec (ErrorFancy Void) PantryName (PantryName, Version)
parserPackage Parser ()
end = do
  (String
pstr, Version
ver) <- ParsecT (ErrorFancy Void) PantryName Identity Char
-> Parser Version -> Parser (String, Version)
forall a end. Parser a -> Parser end -> Parser ([a], end)
manyTillWithEnd ParsecT (ErrorFancy Void) PantryName Identity Char
P.anyChar Parser Version
versionAndEnd
  (PantryName, Version)
-> Parsec (ErrorFancy Void) PantryName (PantryName, Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PantryName
pack String
pstr, Version
ver)
  where
    versionAndEnd :: Parser Version
versionAndEnd = do
      ParsecT (ErrorFancy Void) PantryName Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT (ErrorFancy Void) PantryName Identity Char -> Parser ())
-> ParsecT (ErrorFancy Void) PantryName Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token PantryName
-> ParsecT (ErrorFancy Void) PantryName Identity (Token PantryName)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token PantryName
'-'
      Version
v <- Parser Version
parserVersion
      Parser ()
end
      Version -> Parser Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
v