{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE UndecidableInstances #-}
module Stack.Types.Resolver
(AbstractResolver(..)
,readAbstractResolver
,SnapName(..)
,Snapshots (..)
,renderSnapName
,parseSnapName
) where
import Pantry.Internal.AesonExtended
(FromJSON, parseJSON,
withObject, (.:), withText)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Text as T
import Data.Text.Read (decimal)
import Data.Time (Day)
import Options.Applicative (ReadM)
import qualified Options.Applicative.Types as OA
import Stack.Prelude
data AbstractResolver
= ARLatestNightly
| ARLatestLTS
| ARLatestLTSMajor !Int
| ARResolver !RawSnapshotLocation
| ARGlobal
instance Show AbstractResolver where
show :: AbstractResolver -> String
show = Text -> String
T.unpack (Text -> String)
-> (AbstractResolver -> Text) -> AbstractResolver -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (AbstractResolver -> Utf8Builder) -> AbstractResolver -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractResolver -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance Display AbstractResolver where
display :: AbstractResolver -> Utf8Builder
display ARLatestNightly = "nightly"
display ARLatestLTS = "lts"
display (ARLatestLTSMajor x :: Int
x) = "lts-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
x
display (ARResolver usl :: RawSnapshotLocation
usl) = RawSnapshotLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawSnapshotLocation
usl
display ARGlobal = "global"
readAbstractResolver :: ReadM (Unresolved AbstractResolver)
readAbstractResolver :: ReadM (Unresolved AbstractResolver)
readAbstractResolver = do
String
s <- ReadM String
OA.readerAsk
case String
s of
"global" -> Unresolved AbstractResolver -> ReadM (Unresolved AbstractResolver)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved AbstractResolver
-> ReadM (Unresolved AbstractResolver))
-> Unresolved AbstractResolver
-> ReadM (Unresolved AbstractResolver)
forall a b. (a -> b) -> a -> b
$ AbstractResolver -> Unresolved AbstractResolver
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbstractResolver
ARGlobal
"nightly" -> Unresolved AbstractResolver -> ReadM (Unresolved AbstractResolver)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved AbstractResolver
-> ReadM (Unresolved AbstractResolver))
-> Unresolved AbstractResolver
-> ReadM (Unresolved AbstractResolver)
forall a b. (a -> b) -> a -> b
$ AbstractResolver -> Unresolved AbstractResolver
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbstractResolver
ARLatestNightly
"lts" -> Unresolved AbstractResolver -> ReadM (Unresolved AbstractResolver)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved AbstractResolver
-> ReadM (Unresolved AbstractResolver))
-> Unresolved AbstractResolver
-> ReadM (Unresolved AbstractResolver)
forall a b. (a -> b) -> a -> b
$ AbstractResolver -> Unresolved AbstractResolver
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbstractResolver
ARLatestLTS
'l':'t':'s':'-':x :: String
x | Right (x' :: Int
x', "") <- Reader Int
forall a. Integral a => Reader a
decimal Reader Int -> Reader Int
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x ->
Unresolved AbstractResolver -> ReadM (Unresolved AbstractResolver)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved AbstractResolver
-> ReadM (Unresolved AbstractResolver))
-> Unresolved AbstractResolver
-> ReadM (Unresolved AbstractResolver)
forall a b. (a -> b) -> a -> b
$ AbstractResolver -> Unresolved AbstractResolver
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbstractResolver -> Unresolved AbstractResolver)
-> AbstractResolver -> Unresolved AbstractResolver
forall a b. (a -> b) -> a -> b
$ Int -> AbstractResolver
ARLatestLTSMajor Int
x'
_ -> Unresolved AbstractResolver -> ReadM (Unresolved AbstractResolver)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved AbstractResolver
-> ReadM (Unresolved AbstractResolver))
-> Unresolved AbstractResolver
-> ReadM (Unresolved AbstractResolver)
forall a b. (a -> b) -> a -> b
$ RawSnapshotLocation -> AbstractResolver
ARResolver (RawSnapshotLocation -> AbstractResolver)
-> Unresolved RawSnapshotLocation -> Unresolved AbstractResolver
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocation (String -> Text
T.pack String
s)
data SnapName
= LTS !Int !Int
| Nightly !Day
deriving ((forall x. SnapName -> Rep SnapName x)
-> (forall x. Rep SnapName x -> SnapName) -> Generic SnapName
forall x. Rep SnapName x -> SnapName
forall x. SnapName -> Rep SnapName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SnapName x -> SnapName
$cfrom :: forall x. SnapName -> Rep SnapName x
Generic, Typeable, Int -> SnapName -> ShowS
[SnapName] -> ShowS
SnapName -> String
(Int -> SnapName -> ShowS)
-> (SnapName -> String) -> ([SnapName] -> ShowS) -> Show SnapName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapName] -> ShowS
$cshowList :: [SnapName] -> ShowS
show :: SnapName -> String
$cshow :: SnapName -> String
showsPrec :: Int -> SnapName -> ShowS
$cshowsPrec :: Int -> SnapName -> ShowS
Show, Typeable SnapName
DataType
Constr
Typeable SnapName =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SnapName -> c SnapName)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SnapName)
-> (SnapName -> Constr)
-> (SnapName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SnapName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SnapName))
-> ((forall b. Data b => b -> b) -> SnapName -> SnapName)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SnapName -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SnapName -> r)
-> (forall u. (forall d. Data d => d -> u) -> SnapName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SnapName -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SnapName -> m SnapName)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SnapName -> m SnapName)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SnapName -> m SnapName)
-> Data SnapName
SnapName -> DataType
SnapName -> Constr
(forall b. Data b => b -> b) -> SnapName -> SnapName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SnapName -> c SnapName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SnapName
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SnapName -> u
forall u. (forall d. Data d => d -> u) -> SnapName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SnapName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SnapName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SnapName -> m SnapName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SnapName -> m SnapName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SnapName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SnapName -> c SnapName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SnapName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SnapName)
$cNightly :: Constr
$cLTS :: Constr
$tSnapName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SnapName -> m SnapName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SnapName -> m SnapName
gmapMp :: (forall d. Data d => d -> m d) -> SnapName -> m SnapName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SnapName -> m SnapName
gmapM :: (forall d. Data d => d -> m d) -> SnapName -> m SnapName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SnapName -> m SnapName
gmapQi :: Int -> (forall d. Data d => d -> u) -> SnapName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SnapName -> u
gmapQ :: (forall d. Data d => d -> u) -> SnapName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SnapName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SnapName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SnapName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SnapName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SnapName -> r
gmapT :: (forall b. Data b => b -> b) -> SnapName -> SnapName
$cgmapT :: (forall b. Data b => b -> b) -> SnapName -> SnapName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SnapName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SnapName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SnapName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SnapName)
dataTypeOf :: SnapName -> DataType
$cdataTypeOf :: SnapName -> DataType
toConstr :: SnapName -> Constr
$ctoConstr :: SnapName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SnapName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SnapName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SnapName -> c SnapName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SnapName -> c SnapName
$cp1Data :: Typeable SnapName
Data, SnapName -> SnapName -> Bool
(SnapName -> SnapName -> Bool)
-> (SnapName -> SnapName -> Bool) -> Eq SnapName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapName -> SnapName -> Bool
$c/= :: SnapName -> SnapName -> Bool
== :: SnapName -> SnapName -> Bool
$c== :: SnapName -> SnapName -> Bool
Eq)
instance NFData SnapName
instance Display SnapName where
display :: SnapName -> Utf8Builder
display = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Text -> Utf8Builder)
-> (SnapName -> Text) -> SnapName -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapName -> Text
renderSnapName
data BuildPlanTypesException
= ParseSnapNameException !Text
| ParseResolverException !Text
| FilepathInDownloadedSnapshot !Text
deriving Typeable
instance Exception BuildPlanTypesException
instance Show BuildPlanTypesException where
show :: BuildPlanTypesException -> String
show (ParseSnapNameException t :: Text
t) = "Invalid snapshot name: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
show (ParseResolverException t :: Text
t) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "Invalid resolver value: "
, Text -> String
T.unpack Text
t
, ". Possible valid values include lts-2.12, nightly-YYYY-MM-DD, ghc-7.10.2, and ghcjs-0.1.0_ghc-7.10.2. "
, "See https://www.stackage.org/snapshots for a complete list."
]
show (FilepathInDownloadedSnapshot url :: Text
url) = [String] -> String
unlines
[ "Downloaded snapshot specified a 'resolver: { location: filepath }' "
, "field, but filepaths are not allowed in downloaded snapshots.\n"
, "Filepath specified: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
url
]
renderSnapName :: SnapName -> Text
renderSnapName :: SnapName -> Text
renderSnapName (LTS x :: Int
x y :: Int
y) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["lts-", Int -> String
forall a. Show a => a -> String
show Int
x, ".", Int -> String
forall a. Show a => a -> String
show Int
y]
renderSnapName (Nightly d :: Day
d) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "nightly-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Day -> String
forall a. Show a => a -> String
show Day
d
parseSnapName :: MonadThrow m => Text -> m SnapName
parseSnapName :: Text -> m SnapName
parseSnapName t0 :: Text
t0 =
case Maybe SnapName
lts Maybe SnapName -> Maybe SnapName -> Maybe SnapName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SnapName
nightly of
Nothing -> BuildPlanTypesException -> m SnapName
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (BuildPlanTypesException -> m SnapName)
-> BuildPlanTypesException -> m SnapName
forall a b. (a -> b) -> a -> b
$ Text -> BuildPlanTypesException
ParseSnapNameException Text
t0
Just sn :: SnapName
sn -> SnapName -> m SnapName
forall (m :: * -> *) a. Monad m => a -> m a
return SnapName
sn
where
lts :: Maybe SnapName
lts = do
Text
t1 <- Text -> Text -> Maybe Text
T.stripPrefix "lts-" Text
t0
Right (x :: Int
x, t2 :: Text
t2) <- Either String (Int, Text) -> Maybe (Either String (Int, Text))
forall a. a -> Maybe a
Just (Either String (Int, Text) -> Maybe (Either String (Int, Text)))
-> Either String (Int, Text) -> Maybe (Either String (Int, Text))
forall a b. (a -> b) -> a -> b
$ Reader Int
forall a. Integral a => Reader a
decimal Text
t1
Text
t3 <- Text -> Text -> Maybe Text
T.stripPrefix "." Text
t2
Right (y :: Int
y, "") <- Either String (Int, Text) -> Maybe (Either String (Int, Text))
forall a. a -> Maybe a
Just (Either String (Int, Text) -> Maybe (Either String (Int, Text)))
-> Either String (Int, Text) -> Maybe (Either String (Int, Text))
forall a b. (a -> b) -> a -> b
$ Reader Int
forall a. Integral a => Reader a
decimal Text
t3
SnapName -> Maybe SnapName
forall (m :: * -> *) a. Monad m => a -> m a
return (SnapName -> Maybe SnapName) -> SnapName -> Maybe SnapName
forall a b. (a -> b) -> a -> b
$ Int -> Int -> SnapName
LTS Int
x Int
y
nightly :: Maybe SnapName
nightly = do
Text
t1 <- Text -> Text -> Maybe Text
T.stripPrefix "nightly-" Text
t0
Day -> SnapName
Nightly (Day -> SnapName) -> Maybe Day -> Maybe SnapName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Day
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t1)
data Snapshots = Snapshots
{ Snapshots -> Day
snapshotsNightly :: !Day
, Snapshots -> IntMap Int
snapshotsLts :: !(IntMap Int)
}
deriving Int -> Snapshots -> ShowS
[Snapshots] -> ShowS
Snapshots -> String
(Int -> Snapshots -> ShowS)
-> (Snapshots -> String)
-> ([Snapshots] -> ShowS)
-> Show Snapshots
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Snapshots] -> ShowS
$cshowList :: [Snapshots] -> ShowS
show :: Snapshots -> String
$cshow :: Snapshots -> String
showsPrec :: Int -> Snapshots -> ShowS
$cshowsPrec :: Int -> Snapshots -> ShowS
Show
instance FromJSON Snapshots where
parseJSON :: Value -> Parser Snapshots
parseJSON = String -> (Object -> Parser Snapshots) -> Value -> Parser Snapshots
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Snapshots" ((Object -> Parser Snapshots) -> Value -> Parser Snapshots)
-> (Object -> Parser Snapshots) -> Value -> Parser Snapshots
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> Day -> IntMap Int -> Snapshots
Snapshots
(Day -> IntMap Int -> Snapshots)
-> Parser Day -> Parser (IntMap Int -> Snapshots)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "nightly" Parser Text -> (Text -> Parser Day) -> Parser Day
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Day
forall (m :: * -> *). MonadFail m => Text -> m Day
parseNightly)
Parser (IntMap Int -> Snapshots)
-> Parser (IntMap Int) -> Parser Snapshots
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([IntMap Int] -> IntMap Int)
-> Parser [IntMap Int] -> Parser (IntMap Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [IntMap Int] -> IntMap Int
forall (f :: * -> *) a. Foldable f => f (IntMap a) -> IntMap a
IntMap.unions (((Text, Value) -> Parser (IntMap Int))
-> [(Text, Value)] -> Parser [IntMap Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Value -> Parser (IntMap Int)
parseLTS (Value -> Parser (IntMap Int))
-> ((Text, Value) -> Value) -> (Text, Value) -> Parser (IntMap Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Value) -> Value
forall a b. (a, b) -> b
snd)
([(Text, Value)] -> Parser [IntMap Int])
-> [(Text, Value)] -> Parser [IntMap Int]
forall a b. (a -> b) -> a -> b
$ ((Text, Value) -> Bool) -> [(Text, Value)] -> [(Text, Value)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
isLTS (Text -> Bool) -> ((Text, Value) -> Text) -> (Text, Value) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Value) -> Text
forall a b. (a, b) -> a
fst)
([(Text, Value)] -> [(Text, Value)])
-> [(Text, Value)] -> [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList Object
o)
where
parseNightly :: Text -> m Day
parseNightly t :: Text
t =
case Text -> Either SomeException SnapName
forall (m :: * -> *). MonadThrow m => Text -> m SnapName
parseSnapName Text
t of
Left e :: SomeException
e -> String -> m Day
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Day) -> String -> m Day
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
Right (LTS _ _) -> String -> m Day
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Unexpected LTS value"
Right (Nightly d :: Day
d) -> Day -> m Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
d
isLTS :: Text -> Bool
isLTS = ("lts-" Text -> Text -> Bool
`T.isPrefixOf`)
parseLTS :: Value -> Parser (IntMap Int)
parseLTS = String
-> (Text -> Parser (IntMap Int)) -> Value -> Parser (IntMap Int)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "LTS" ((Text -> Parser (IntMap Int)) -> Value -> Parser (IntMap Int))
-> (Text -> Parser (IntMap Int)) -> Value -> Parser (IntMap Int)
forall a b. (a -> b) -> a -> b
$ \t :: Text
t ->
case Text -> Either SomeException SnapName
forall (m :: * -> *). MonadThrow m => Text -> m SnapName
parseSnapName Text
t of
Left e :: SomeException
e -> String -> Parser (IntMap Int)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (IntMap Int)) -> String -> Parser (IntMap Int)
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
Right (LTS x :: Int
x y :: Int
y) -> IntMap Int -> Parser (IntMap Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap Int -> Parser (IntMap Int))
-> IntMap Int -> Parser (IntMap Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> IntMap Int
forall a. Int -> a -> IntMap a
IntMap.singleton Int
x Int
y
Right (Nightly _) -> String -> Parser (IntMap Int)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Unexpected nightly value"