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

-- | Either an actual resolver value, or an abstract description of one (e.g.,
-- latest nightly).
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)

-- | The name of an LTS Haskell or Stackage Nightly snapshot.
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
        ]

-- | Convert a 'SnapName' into its short representation, e.g. @lts-2.8@,
-- @nightly-2015-03-05@.
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

-- | Parse the short representation of a 'SnapName'.
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)

-- | Most recent Nightly and newest LTS version per major release.
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"