{-# OPTIONS_GHC -Wno-orphans #-}

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}

{-|
Module      : GHCup.Types.JSON
Description : GHCup JSON types/instances
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : portable
-}
module GHCup.Types.JSON where

import           GHCup.Types
import           GHCup.Types.Stack (SetupInfo)
import           GHCup.Types.JSON.MapIgnoreUnknownKeys ()
import           GHCup.Types.JSON.Utils
import           GHCup.Types.JSON.Versions ()
import           GHCup.Prelude.MegaParsec
import           GHCup.Utils.URI

import           Control.Applicative            ( (<|>) )
import           Data.Aeson              hiding (Key)
import           Data.Aeson.TH
import           Data.Aeson.Types        hiding (Key)
import           Data.ByteString                ( ByteString )
import           Data.List.NonEmpty             ( NonEmpty(..) )
import           Data.Maybe
import           Data.Text.Encoding            as E
import           Data.Foldable
import           Data.Versions
import           Data.Void
import           URI.ByteString hiding (parseURI)
import           Text.Casing

import qualified Data.List.NonEmpty            as NE
import qualified Data.Text                     as T
import qualified Data.Text.Encoding.Error      as E
import qualified Text.Megaparsec               as MP
import qualified Text.Megaparsec.Char          as MPC

instance ToJSON LinuxDistro where
  toJSON :: LinuxDistro -> Value
toJSON = Text -> Value
String (Text -> Value) -> (LinuxDistro -> Text) -> LinuxDistro -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (LinuxDistro -> String) -> LinuxDistro -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinuxDistro -> String
forall a. Show a => a -> String
show

instance FromJSON LinuxDistro where
  parseJSON :: Value -> Parser LinuxDistro
parseJSON = String
-> (Text -> Parser LinuxDistro) -> Value -> Parser LinuxDistro
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"LinuxDistro" ((Text -> Parser LinuxDistro) -> Value -> Parser LinuxDistro)
-> (Text -> Parser LinuxDistro) -> Value -> Parser LinuxDistro
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> String
T.unpack (Text -> Text
T.toLower Text
t) of
    String
"debian"   -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
Debian
    String
"ubuntu"   -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
Ubuntu
    String
"mint"     -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
Mint
    String
"fedora"   -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
Fedora
    String
"centos"   -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
CentOS
    String
"redhat"   -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
RedHat
    String
"alpine"   -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
Alpine
    String
"amazonlinux" -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
AmazonLinux
    String
"rocky"    -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
Rocky
    String
"void"     -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
Void
    String
"gentoo"   -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
Gentoo
    String
"exherbo"  -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
Exherbo
    String
"opensuse" -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
OpenSUSE
    String
"unknownlinux" -> LinuxDistro -> Parser LinuxDistro
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinuxDistro
UnknownLinux
    String
_ -> String -> Parser LinuxDistro
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown Linux distro"

deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMode
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Chunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Release
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GPGSetting
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "r-") . T.pack . kebab . tail $ str' } ''PlatformRequest

instance ToJSON Tag where
  toJSON :: Tag -> Value
toJSON Tag
Latest             = Text -> Value
String Text
"Latest"
  toJSON Tag
Recommended        = Text -> Value
String Text
"Recommended"
  toJSON Tag
Prerelease         = Text -> Value
String Text
"Prerelease"
  toJSON Tag
Nightly            = Text -> Value
String Text
"Nightly"
  toJSON Tag
Old                = Text -> Value
String Text
"old"
  toJSON (Base       PVP
pvp'') = Text -> Value
String (Text
"base-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PVP -> Text
prettyPVP PVP
pvp'')
  toJSON Tag
LatestPrerelease   = Text -> Value
String Text
"LatestPrerelease"
  toJSON Tag
LatestNightly      = Text -> Value
String Text
"LatestNightly"
  toJSON Tag
Experimental       = Text -> Value
String Text
"Experimental"
  toJSON (UnknownTag String
x    ) = Text -> Value
String (String -> Text
T.pack String
x)

instance FromJSON Tag where
  parseJSON :: Value -> Parser Tag
parseJSON = String -> (Text -> Parser Tag) -> Value -> Parser Tag
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Tag" ((Text -> Parser Tag) -> Value -> Parser Tag)
-> (Text -> Parser Tag) -> Value -> Parser Tag
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> String
T.unpack Text
t of
    String
"Latest"                             -> Tag -> Parser Tag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
Latest
    String
"Recommended"                        -> Tag -> Parser Tag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
Recommended
    String
"Prerelease"                         -> Tag -> Parser Tag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
Prerelease
    String
"Nightly"                            -> Tag -> Parser Tag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
Nightly
    String
"LatestPrerelease"                   -> Tag -> Parser Tag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
LatestPrerelease
    String
"LatestNightly"                      -> Tag -> Parser Tag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
LatestNightly
    String
"Experimental"                       -> Tag -> Parser Tag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
Experimental
    String
"old"                                -> Tag -> Parser Tag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
Old
    (Char
'b' : Char
'a' : Char
's' : Char
'e' : Char
'-' : String
ver') -> case Text -> Either ParsingError PVP
pvp (String -> Text
T.pack String
ver') of
      Right PVP
x -> Tag -> Parser Tag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tag -> Parser Tag) -> Tag -> Parser Tag
forall a b. (a -> b) -> a -> b
$ PVP -> Tag
Base PVP
x
      Left  ParsingError
e -> String -> Parser Tag
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Tag)
-> (ParsingError -> String) -> ParsingError -> Parser Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsingError -> String
forall a. Show a => a -> String
show (ParsingError -> Parser Tag) -> ParsingError -> Parser Tag
forall a b. (a -> b) -> a -> b
$ ParsingError
e
    String
x -> Tag -> Parser Tag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Tag
UnknownTag String
x)

instance ToJSON URI where
  toJSON :: URI -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (URI -> Text) -> URI -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
E.decodeUtf8With OnDecodeError
E.lenientDecode (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef'


instance FromJSON URI where
  parseJSON :: Value -> Parser URI
parseJSON = String -> (Text -> Parser URI) -> Value -> Parser URI
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"URL" ((Text -> Parser URI) -> Value -> Parser URI)
-> (Text -> Parser URI) -> Value -> Parser URI
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case ByteString -> Either URIParseError URI
parseURI (Text -> ByteString
encodeUtf8 Text
t) of
      Right URI
x -> URI -> Parser URI
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure URI
x
      Left  URIParseError
e -> String -> Parser URI
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser URI)
-> (URIParseError -> String) -> URIParseError -> Parser URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParseError -> String
forall a. Show a => a -> String
show (URIParseError -> Parser URI) -> URIParseError -> Parser URI
forall a b. (a -> b) -> a -> b
$ URIParseError
e

instance ToJSON GHCTargetVersion where
  toJSON :: GHCTargetVersion -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (GHCTargetVersion -> Text) -> GHCTargetVersion -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCTargetVersion -> Text
tVerToText

instance FromJSON GHCTargetVersion where
  parseJSON :: Value -> Parser GHCTargetVersion
parseJSON = String
-> (Text -> Parser GHCTargetVersion)
-> Value
-> Parser GHCTargetVersion
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"GHCTargetVersion" ((Text -> Parser GHCTargetVersion)
 -> Value -> Parser GHCTargetVersion)
-> (Text -> Parser GHCTargetVersion)
-> Value
-> Parser GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Parsec Void Text GHCTargetVersion
-> String -> Text -> Either ParsingError GHCTargetVersion
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text GHCTargetVersion
ghcTargetVerP String
"" Text
t of
    Right GHCTargetVersion
x -> GHCTargetVersion -> Parser GHCTargetVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCTargetVersion
x
    Left  ParsingError
e -> String -> Parser GHCTargetVersion
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser GHCTargetVersion)
-> String -> Parser GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ String
"Failure in GHCTargetVersion (FromJSON)" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ParsingError -> String
forall a. Show a => a -> String
show ParsingError
e

instance ToJSONKey GHCTargetVersion where
  toJSONKey :: ToJSONKeyFunction GHCTargetVersion
toJSONKey = (GHCTargetVersion -> Text) -> ToJSONKeyFunction GHCTargetVersion
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ((GHCTargetVersion -> Text) -> ToJSONKeyFunction GHCTargetVersion)
-> (GHCTargetVersion -> Text) -> ToJSONKeyFunction GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
x -> GHCTargetVersion -> Text
tVerToText GHCTargetVersion
x

instance FromJSONKey GHCTargetVersion where
  fromJSONKey :: FromJSONKeyFunction GHCTargetVersion
fromJSONKey = (Text -> Parser GHCTargetVersion)
-> FromJSONKeyFunction GHCTargetVersion
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser GHCTargetVersion)
 -> FromJSONKeyFunction GHCTargetVersion)
-> (Text -> Parser GHCTargetVersion)
-> FromJSONKeyFunction GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Parsec Void Text GHCTargetVersion
-> String -> Text -> Either ParsingError GHCTargetVersion
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text GHCTargetVersion
ghcTargetVerP String
"" Text
t of
    Right GHCTargetVersion
x -> GHCTargetVersion -> Parser GHCTargetVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCTargetVersion
x
    Left  ParsingError
e -> String -> Parser GHCTargetVersion
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser GHCTargetVersion)
-> String -> Parser GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ String
"Failure in GHCTargetVersion (FromJSONKey)" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ParsingError -> String
forall a. Show a => a -> String
show ParsingError
e


instance ToJSONKey Platform where
  toJSONKey :: ToJSONKeyFunction Platform
toJSONKey = (Platform -> Text) -> ToJSONKeyFunction Platform
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ((Platform -> Text) -> ToJSONKeyFunction Platform)
-> (Platform -> Text) -> ToJSONKeyFunction Platform
forall a b. (a -> b) -> a -> b
$ \case
    Platform
Darwin  -> String -> Text
T.pack String
"Darwin"
    Platform
FreeBSD -> String -> Text
T.pack String
"FreeBSD"
    Linux LinuxDistro
d -> String -> Text
T.pack (String
"Linux_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> LinuxDistro -> String
forall a. Show a => a -> String
show LinuxDistro
d)
    Platform
OpenBSD -> String -> Text
T.pack String
"OpenBSD"
    Platform
Windows -> String -> Text
T.pack String
"Windows"

instance FromJSONKey Platform where
  fromJSONKey :: FromJSONKeyFunction Platform
fromJSONKey = (Text -> Parser Platform) -> FromJSONKeyFunction Platform
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Platform) -> FromJSONKeyFunction Platform)
-> (Text -> Parser Platform) -> FromJSONKeyFunction Platform
forall a b. (a -> b) -> a -> b
$ \Text
t -> if
    | String -> Text
T.pack String
"Darwin" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t -> Platform -> Parser Platform
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Platform
Darwin
    | String -> Text
T.pack String
"FreeBSD" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t -> Platform -> Parser Platform
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Platform
FreeBSD
    | String -> Text
T.pack String
"OpenBSD" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t -> Platform -> Parser Platform
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Platform
OpenBSD
    | String -> Text
T.pack String
"Windows" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t -> Platform -> Parser Platform
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Platform
Windows
    | String -> Text
T.pack String
"Linux_" Text -> Text -> Bool
`T.isPrefixOf` Text
t -> case
        Text -> Text -> Maybe Text
T.stripPrefix (String -> Text
T.pack String
"Linux_") Text
t
      of
        Just Text
dstr ->
          case
              (ByteString -> Maybe LinuxDistro
forall a. FromJSON a => ByteString -> Maybe a
decodeStrict (Text -> ByteString
E.encodeUtf8 (String -> Text
T.pack String
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dstr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
"\"")) :: Maybe
                  LinuxDistro
              )
            of
              Just LinuxDistro
d -> Platform -> Parser Platform
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Platform -> Parser Platform) -> Platform -> Parser Platform
forall a b. (a -> b) -> a -> b
$ LinuxDistro -> Platform
Linux LinuxDistro
d
              Maybe LinuxDistro
Nothing ->
                String -> Parser Platform
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
                  (String -> Parser Platform) -> String -> Parser Platform
forall a b. (a -> b) -> a -> b
$  String
"Unexpected failure in decoding LinuxDistro: "
                  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
dstr
        Maybe Text
Nothing -> String -> Parser Platform
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected failure in Platform stripPrefix"
    | Bool
otherwise -> String -> Parser Platform
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failure in Platform (FromJSONKey)"

instance ToJSONKey Architecture where
  toJSONKey :: ToJSONKeyFunction Architecture
toJSONKey = JSONKeyOptions -> ToJSONKeyFunction Architecture
forall a.
(Generic a, GToJSONKey (Rep a)) =>
JSONKeyOptions -> ToJSONKeyFunction a
genericToJSONKey JSONKeyOptions
defaultJSONKeyOptions

instance FromJSONKey Architecture where
  fromJSONKey :: FromJSONKeyFunction Architecture
fromJSONKey = JSONKeyOptions -> FromJSONKeyFunction Architecture
forall a.
(Generic a, GFromJSONKey (Rep a)) =>
JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey JSONKeyOptions
defaultJSONKeyOptions

instance ToJSONKey Tool where
  toJSONKey :: ToJSONKeyFunction Tool
toJSONKey = JSONKeyOptions -> ToJSONKeyFunction Tool
forall a.
(Generic a, GToJSONKey (Rep a)) =>
JSONKeyOptions -> ToJSONKeyFunction a
genericToJSONKey JSONKeyOptions
defaultJSONKeyOptions

instance FromJSONKey Tool where
  fromJSONKey :: FromJSONKeyFunction Tool
fromJSONKey = JSONKeyOptions -> FromJSONKeyFunction Tool
forall a.
(Generic a, GFromJSONKey (Rep a)) =>
JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey JSONKeyOptions
defaultJSONKeyOptions

instance ToJSON TarDir where
  toJSON :: TarDir -> Value
toJSON (RealDir  String
p) = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
p
  toJSON (RegexDir String
r) = [Pair] -> Value
object [Key
"RegexDir" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
r]

instance FromJSON TarDir where
  parseJSON :: Value -> Parser TarDir
parseJSON Value
v = Value -> Parser TarDir
realDir Value
v Parser TarDir -> Parser TarDir -> Parser TarDir
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser TarDir
regexDir Value
v
   where
    realDir :: Value -> Parser TarDir
realDir = String -> (Text -> Parser TarDir) -> Value -> Parser TarDir
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"TarDir" ((Text -> Parser TarDir) -> Value -> Parser TarDir)
-> (Text -> Parser TarDir) -> Value -> Parser TarDir
forall a b. (a -> b) -> a -> b
$ \Text
t -> do
      String
fp <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
String Text
t)
      TarDir -> Parser TarDir
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> TarDir
RealDir String
fp)
    regexDir :: Value -> Parser TarDir
regexDir = String -> (Object -> Parser TarDir) -> Value -> Parser TarDir
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TarDir" ((Object -> Parser TarDir) -> Value -> Parser TarDir)
-> (Object -> Parser TarDir) -> Value -> Parser TarDir
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      String
r <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"RegexDir"
      TarDir -> Parser TarDir
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TarDir -> Parser TarDir) -> TarDir -> Parser TarDir
forall a b. (a -> b) -> a -> b
$ String -> TarDir
RegexDir String
r


instance ToJSON VersionCmp where
  toJSON :: VersionCmp -> Value
toJSON = Text -> Value
String (Text -> Value) -> (VersionCmp -> Text) -> VersionCmp -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionCmp -> Text
versionCmpToText

instance FromJSON VersionCmp where
  parseJSON :: Value -> Parser VersionCmp
parseJSON = String -> (Text -> Parser VersionCmp) -> Value -> Parser VersionCmp
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"VersionCmp" ((Text -> Parser VersionCmp) -> Value -> Parser VersionCmp)
-> (Text -> Parser VersionCmp) -> Value -> Parser VersionCmp
forall a b. (a -> b) -> a -> b
$ \Text
t -> do
    case Parsec Void Text VersionCmp
-> String -> Text -> Either ParsingError VersionCmp
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text VersionCmp
versionCmpP String
"" Text
t of
      Right VersionCmp
r -> VersionCmp -> Parser VersionCmp
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionCmp
r
      Left  ParsingError
e -> String -> Parser VersionCmp
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ParsingError -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
MP.errorBundlePretty ParsingError
e)

instance ToJSON ByteString where
  toJSON :: ByteString -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
E.decodeUtf8With OnDecodeError
E.lenientDecode

instance FromJSON ByteString where
  parseJSON :: Value -> Parser ByteString
parseJSON = String -> (Text -> Parser ByteString) -> Value -> Parser ByteString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ByteString" ((Text -> Parser ByteString) -> Value -> Parser ByteString)
-> (Text -> Parser ByteString) -> Value -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ \Text
t -> ByteString -> Parser ByteString
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Parser ByteString)
-> ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 Text
t

versionCmpToText :: VersionCmp -> T.Text
versionCmpToText :: VersionCmp -> Text
versionCmpToText (VR_gt   Versioning
ver') = Text
"> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
ver'
versionCmpToText (VR_gteq Versioning
ver') = Text
">= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
ver'
versionCmpToText (VR_lt   Versioning
ver') = Text
"< " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
ver'
versionCmpToText (VR_lteq Versioning
ver') = Text
"<= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
ver'
versionCmpToText (VR_eq   Versioning
ver') = Text
"== " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
ver'

versionCmpP :: MP.Parsec Void T.Text VersionCmp
versionCmpP :: Parsec Void Text VersionCmp
versionCmpP = (Text -> Parsec Void Text VersionCmp)
-> (VersionCmp -> Parsec Void Text VersionCmp)
-> Either Text VersionCmp
-> Parsec Void Text VersionCmp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parsec Void Text VersionCmp
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parsec Void Text VersionCmp)
-> (Text -> String) -> Text -> Parsec Void Text VersionCmp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) VersionCmp -> Parsec Void Text VersionCmp
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text VersionCmp -> Parsec Void Text VersionCmp)
-> ParsecT Void Text Identity (Either Text VersionCmp)
-> Parsec Void Text VersionCmp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Text -> Versioning -> Either Text VersionCmp
forall {a}.
(Eq a, IsString a, Semigroup a) =>
a -> Versioning -> Either a VersionCmp
translate (Text -> Versioning -> Either Text VersionCmp)
-> ParsecT Void Text Identity Text
-> ParsecT
     Void Text Identity (Versioning -> Either Text VersionCmp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token Text -> [Token Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'>', Char
'<', Char
'=']))) ParsecT Void Text Identity (Versioning -> Either Text VersionCmp)
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity (Either Text VersionCmp)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity Versioning
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Versioning
versioningEnd))
 where
   translate :: a -> Versioning -> Either a VersionCmp
translate a
">" Versioning
v  = VersionCmp -> Either a VersionCmp
forall a b. b -> Either a b
Right (VersionCmp -> Either a VersionCmp)
-> VersionCmp -> Either a VersionCmp
forall a b. (a -> b) -> a -> b
$ Versioning -> VersionCmp
VR_gt Versioning
v
   translate a
">=" Versioning
v = VersionCmp -> Either a VersionCmp
forall a b. b -> Either a b
Right (VersionCmp -> Either a VersionCmp)
-> VersionCmp -> Either a VersionCmp
forall a b. (a -> b) -> a -> b
$ Versioning -> VersionCmp
VR_gteq Versioning
v
   translate a
"<" Versioning
v  = VersionCmp -> Either a VersionCmp
forall a b. b -> Either a b
Right (VersionCmp -> Either a VersionCmp)
-> VersionCmp -> Either a VersionCmp
forall a b. (a -> b) -> a -> b
$ Versioning -> VersionCmp
VR_lt Versioning
v
   translate a
"<=" Versioning
v = VersionCmp -> Either a VersionCmp
forall a b. b -> Either a b
Right (VersionCmp -> Either a VersionCmp)
-> VersionCmp -> Either a VersionCmp
forall a b. (a -> b) -> a -> b
$ Versioning -> VersionCmp
VR_lteq Versioning
v
   translate a
"==" Versioning
v = VersionCmp -> Either a VersionCmp
forall a b. b -> Either a b
Right (VersionCmp -> Either a VersionCmp)
-> VersionCmp -> Either a VersionCmp
forall a b. (a -> b) -> a -> b
$ Versioning -> VersionCmp
VR_eq Versioning
v
   translate a
"" Versioning
v   = VersionCmp -> Either a VersionCmp
forall a b. b -> Either a b
Right (VersionCmp -> Either a VersionCmp)
-> VersionCmp -> Either a VersionCmp
forall a b. (a -> b) -> a -> b
$ Versioning -> VersionCmp
VR_eq Versioning
v
   translate a
c  Versioning
_   = a -> Either a VersionCmp
forall a b. a -> Either a b
Left (a -> Either a VersionCmp) -> a -> Either a VersionCmp
forall a b. (a -> b) -> a -> b
$ a
"unexpected comparator: " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
c


instance ToJSON VersionRange where
  toJSON :: VersionRange -> Value
toJSON = Text -> Value
String (Text -> Value) -> (VersionRange -> Text) -> VersionRange -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> Text
verRangeToText

verRangeToText :: VersionRange -> T.Text
verRangeToText :: VersionRange -> Text
verRangeToText  (SimpleRange NonEmpty VersionCmp
cmps) =
  let inner :: Text
inner = (Text -> Text -> Text) -> [Text] -> Text
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Text
x Text
y -> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" && " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y)
                     (VersionCmp -> Text
versionCmpToText (VersionCmp -> Text) -> [VersionCmp] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty VersionCmp -> [VersionCmp]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty VersionCmp
cmps)
  in  Text
"( " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" )"
verRangeToText (OrRange NonEmpty VersionCmp
cmps VersionRange
range) =
  let left :: Text
left  = VersionRange -> Text
verRangeToText (NonEmpty VersionCmp -> VersionRange
SimpleRange NonEmpty VersionCmp
cmps)
      right :: Text
right = VersionRange -> Text
verRangeToText VersionRange
range
  in  Text
left Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" || " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
right

instance FromJSON VersionRange where
  parseJSON :: Value -> Parser VersionRange
parseJSON = String
-> (Text -> Parser VersionRange) -> Value -> Parser VersionRange
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"VersionRange" ((Text -> Parser VersionRange) -> Value -> Parser VersionRange)
-> (Text -> Parser VersionRange) -> Value -> Parser VersionRange
forall a b. (a -> b) -> a -> b
$ \Text
t -> do
    case Parsec Void Text VersionRange
-> String -> Text -> Either ParsingError VersionRange
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text VersionRange
versionRangeP String
"" Text
t of
      Right VersionRange
r -> VersionRange -> Parser VersionRange
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionRange
r
      Left  ParsingError
e -> String -> Parser VersionRange
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ParsingError -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
MP.errorBundlePretty ParsingError
e)

versionRangeP :: MP.Parsec Void T.Text VersionRange
versionRangeP :: Parsec Void Text VersionRange
versionRangeP = Parsec Void Text VersionRange
go Parsec Void Text VersionRange
-> ParsecT Void Text Identity () -> Parsec Void Text VersionRange
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof
 where
  go :: Parsec Void Text VersionRange
go =
    Parsec Void Text VersionRange -> Parsec Void Text VersionRange
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text VersionRange
orParse
      Parsec Void Text VersionRange
-> Parsec Void Text VersionRange -> Parsec Void Text VersionRange
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text VersionRange -> Parsec Void Text VersionRange
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ((NonEmpty VersionCmp -> VersionRange)
-> ParsecT Void Text Identity (NonEmpty VersionCmp)
-> Parsec Void Text VersionRange
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty VersionCmp -> VersionRange
SimpleRange ParsecT Void Text Identity (NonEmpty VersionCmp)
andParse)
      Parsec Void Text VersionRange
-> Parsec Void Text VersionRange -> Parsec Void Text VersionRange
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VersionCmp -> VersionRange)
-> Parsec Void Text VersionCmp -> Parsec Void Text VersionRange
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty VersionCmp -> VersionRange
SimpleRange (NonEmpty VersionCmp -> VersionRange)
-> (VersionCmp -> NonEmpty VersionCmp)
-> VersionCmp
-> VersionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionCmp -> NonEmpty VersionCmp
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) Parsec Void Text VersionCmp
versionCmpP

  orParse :: MP.Parsec Void T.Text VersionRange
  orParse :: Parsec Void Text VersionRange
orParse =
    (\NonEmpty VersionCmp
a VersionRange
o -> NonEmpty VersionCmp -> VersionRange -> VersionRange
OrRange NonEmpty VersionCmp
a VersionRange
o)
      (NonEmpty VersionCmp -> VersionRange -> VersionRange)
-> ParsecT Void Text Identity (NonEmpty VersionCmp)
-> ParsecT Void Text Identity (VersionRange -> VersionRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity (NonEmpty VersionCmp)
-> ParsecT Void Text Identity (NonEmpty VersionCmp)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void Text Identity (NonEmpty VersionCmp)
andParse ParsecT Void Text Identity (NonEmpty VersionCmp)
-> ParsecT Void Text Identity (NonEmpty VersionCmp)
-> ParsecT Void Text Identity (NonEmpty VersionCmp)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VersionCmp -> NonEmpty VersionCmp)
-> Parsec Void Text VersionCmp
-> ParsecT Void Text Identity (NonEmpty VersionCmp)
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VersionCmp -> NonEmpty VersionCmp
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Parsec Void Text VersionCmp
versionCmpP)
      ParsecT Void Text Identity (VersionRange -> VersionRange)
-> Parsec Void Text VersionRange -> Parsec Void Text VersionRange
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"||" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space ParsecT Void Text Identity ()
-> Parsec Void Text VersionRange -> Parsec Void Text VersionRange
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text VersionRange
go)

  andParse :: MP.Parsec Void T.Text (NonEmpty VersionCmp)
  andParse :: ParsecT Void Text Identity (NonEmpty VersionCmp)
andParse =
    (VersionCmp -> [VersionCmp] -> NonEmpty VersionCmp)
-> Parsec Void Text VersionCmp
-> ParsecT Void Text Identity ([VersionCmp] -> NonEmpty VersionCmp)
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\VersionCmp
h [VersionCmp]
t -> VersionCmp
h VersionCmp -> [VersionCmp] -> NonEmpty VersionCmp
forall a. a -> [a] -> NonEmpty a
:| [VersionCmp]
t)
         (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"(" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space ParsecT Void Text Identity ()
-> Parsec Void Text VersionCmp -> Parsec Void Text VersionCmp
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text VersionCmp
versionCmpP)
      ParsecT Void Text Identity ([VersionCmp] -> NonEmpty VersionCmp)
-> ParsecT Void Text Identity [VersionCmp]
-> ParsecT Void Text Identity (NonEmpty VersionCmp)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [VersionCmp]
-> ParsecT Void Text Identity [VersionCmp]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (Parsec Void Text VersionCmp
-> ParsecT Void Text Identity [VersionCmp]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"&&" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space ParsecT Void Text Identity ()
-> Parsec Void Text VersionCmp -> Parsec Void Text VersionCmp
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text VersionCmp
versionCmpP))
      ParsecT Void Text Identity (NonEmpty VersionCmp)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (NonEmpty VersionCmp)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space
      ParsecT Void Text Identity (NonEmpty VersionCmp)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (NonEmpty VersionCmp)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
")"
      ParsecT Void Text Identity (NonEmpty VersionCmp)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (NonEmpty VersionCmp)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space

versioningEnd :: MP.Parsec Void T.Text Versioning
versioningEnd :: ParsecT Void Text Identity Versioning
versioningEnd =
  ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity Versioning
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Versioning
verP (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Text
Tokens Text
" " ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Text
Tokens Text
")" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Text
Tokens Text
"&&") ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Versioning
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space)
    ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity Versioning
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Versioning
versioning'

instance ToJSONKey (Maybe VersionRange) where
  toJSONKey :: ToJSONKeyFunction (Maybe VersionRange)
toJSONKey = (Maybe VersionRange -> Text)
-> ToJSONKeyFunction (Maybe VersionRange)
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ((Maybe VersionRange -> Text)
 -> ToJSONKeyFunction (Maybe VersionRange))
-> (Maybe VersionRange -> Text)
-> ToJSONKeyFunction (Maybe VersionRange)
forall a b. (a -> b) -> a -> b
$ \case
    Just VersionRange
x -> VersionRange -> Text
verRangeToText VersionRange
x
    Maybe VersionRange
Nothing -> Text
"unknown_versioning"

instance FromJSONKey (Maybe VersionRange)  where
  fromJSONKey :: FromJSONKeyFunction (Maybe VersionRange)
fromJSONKey = (Text -> Parser (Maybe VersionRange))
-> FromJSONKeyFunction (Maybe VersionRange)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser (Maybe VersionRange))
 -> FromJSONKeyFunction (Maybe VersionRange))
-> (Text -> Parser (Maybe VersionRange))
-> FromJSONKeyFunction (Maybe VersionRange)
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"unknown_versioning" then Maybe VersionRange -> Parser (Maybe VersionRange)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VersionRange
forall a. Maybe a
Nothing else Text -> Parser (Maybe VersionRange)
forall {f :: * -> *}. MonadFail f => Text -> f (Maybe VersionRange)
just Text
t
   where
    just :: Text -> f (Maybe VersionRange)
just Text
t = case Parsec Void Text VersionRange
-> String -> Text -> Either ParsingError VersionRange
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text VersionRange
versionRangeP String
"" Text
t of
      Right VersionRange
x -> Maybe VersionRange -> f (Maybe VersionRange)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe VersionRange -> f (Maybe VersionRange))
-> Maybe VersionRange -> f (Maybe VersionRange)
forall a b. (a -> b) -> a -> b
$ VersionRange -> Maybe VersionRange
forall a. a -> Maybe a
Just VersionRange
x
      Left  ParsingError
e -> String -> f (Maybe VersionRange)
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f (Maybe VersionRange))
-> String -> f (Maybe VersionRange)
forall a b. (a -> b) -> a -> b
$ String
"Failure in (Maybe VersionRange) (FromJSONKey)" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ParsingError -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
MP.errorBundlePretty ParsingError
e


deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo

instance FromJSON GHCupInfo where
  parseJSON :: Value -> Parser GHCupInfo
parseJSON = String -> (Object -> Parser GHCupInfo) -> Value -> Parser GHCupInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GHCupInfo" ((Object -> Parser GHCupInfo) -> Value -> Parser GHCupInfo)
-> (Object -> Parser GHCupInfo) -> Value -> Parser GHCupInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe ToolRequirements
toolRequirements' <- Object
o Object -> Key -> Parser (Maybe ToolRequirements)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"toolRequirements"
    Maybe URI
metadataUpdate    <- Object
o Object -> Key -> Parser (Maybe URI)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadataUpdate"
    GHCupDownloads
ghcupDownloads'   <- Object
o Object -> Key -> Parser GHCupDownloads
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"ghcupDownloads"
    GHCupInfo -> Parser GHCupInfo
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ToolRequirements -> GHCupDownloads -> Maybe URI -> GHCupInfo
GHCupInfo (ToolRequirements -> Maybe ToolRequirements -> ToolRequirements
forall a. a -> Maybe a -> a
fromMaybe ToolRequirements
forall a. Monoid a => a
mempty Maybe ToolRequirements
toolRequirements') GHCupDownloads
ghcupDownloads' Maybe URI
metadataUpdate)

deriveToJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo

instance ToJSON NewURLSource where
  toJSON :: NewURLSource -> Value
toJSON NewURLSource
NewGHCupURL       = Text -> Value
String Text
"GHCupURL"
  toJSON NewURLSource
NewStackSetupURL  = Text -> Value
String Text
"StackSetupURL"
  toJSON (NewGHCupInfo GHCupInfo
gi) = [Pair] -> Value
object [ Key
"ghcup-info" Key -> GHCupInfo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GHCupInfo
gi ]
  toJSON (NewSetupInfo SetupInfo
si) = [Pair] -> Value
object [ Key
"setup-info" Key -> SetupInfo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SetupInfo
si ]
  toJSON (NewURI URI
uri)      = URI -> Value
forall a. ToJSON a => a -> Value
toJSON URI
uri
  toJSON (NewChannelAlias ChannelAlias
c) = ChannelAlias -> Value
forall a. ToJSON a => a -> Value
toJSON ChannelAlias
c

instance ToJSON URLSource where
  toJSON :: URLSource -> Value
toJSON = [NewURLSource] -> Value
forall a. ToJSON a => a -> Value
toJSON ([NewURLSource] -> Value)
-> (URLSource -> [NewURLSource]) -> URLSource -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URLSource -> [NewURLSource]
fromURLSource

instance ToJSON ChannelAlias where
  toJSON :: ChannelAlias -> Value
toJSON = Text -> Value
String (Text -> Value) -> (ChannelAlias -> Text) -> ChannelAlias -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelAlias -> Text
channelAliasText

instance FromJSON ChannelAlias where
  parseJSON :: Value -> Parser ChannelAlias
parseJSON = String
-> (Text -> Parser ChannelAlias) -> Value -> Parser ChannelAlias
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ChannelAlias" ((Text -> Parser ChannelAlias) -> Value -> Parser ChannelAlias)
-> (Text -> Parser ChannelAlias) -> Value -> Parser ChannelAlias
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    let aliases :: [(Text, ChannelAlias)]
aliases = (ChannelAlias -> (Text, ChannelAlias))
-> [ChannelAlias] -> [(Text, ChannelAlias)]
forall a b. (a -> b) -> [a] -> [b]
map (\ChannelAlias
c -> (ChannelAlias -> Text
channelAliasText ChannelAlias
c, ChannelAlias
c)) [ChannelAlias
forall a. Bounded a => a
minBound..ChannelAlias
forall a. Bounded a => a
maxBound]
    in case Text -> [(Text, ChannelAlias)] -> Maybe ChannelAlias
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
t [(Text, ChannelAlias)]
aliases of
      Just ChannelAlias
c -> ChannelAlias -> Parser ChannelAlias
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChannelAlias
c
      Maybe ChannelAlias
Nothing -> String -> Parser ChannelAlias
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ChannelAlias) -> String -> Parser ChannelAlias
forall a b. (a -> b) -> a -> b
$ String
"Unexpected ChannelAlias: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Modifier
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Port
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Host
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''UserInfo
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' (T.unpack . T.toLower) . T.stripPrefix (T.pack "authority") . T.pack $ str' } ''Authority
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirror
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirrors

instance FromJSON URLSource where
  parseJSON :: Value -> Parser URLSource
parseJSON Value
v =
        Value -> Parser URLSource
parseGHCupURL Value
v
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
parseStackURL Value
v
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
parseOwnSourceLegacy Value
v
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
parseOwnSourceNew1 Value
v
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
parseOwnSourceNew2 Value
v
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
parseOwnSpec Value
v
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
legacyParseAddSource Value
v
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
newParseAddSource Value
v
    -- new since Stack SetupInfo
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
parseOwnSpecNew Value
v
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
parseOwnSourceNew3 Value
v
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
newParseAddSource2 Value
v
    -- more lenient versions
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
parseOwnSpecLenient Value
v
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
parseOwnSourceLenient Value
v
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
parseAddSourceLenient Value
v
    -- simplified list
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
parseNewUrlSource Value
v
    Parser URLSource -> Parser URLSource -> Parser URLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser URLSource
parseNewUrlSource' Value
v
   where
    convert'' :: Either GHCupInfo URI -> Either (Either GHCupInfo SetupInfo) URI
    convert'' :: Either GHCupInfo URI -> Either (Either GHCupInfo SetupInfo) URI
convert'' (Left GHCupInfo
gi)  = Either GHCupInfo SetupInfo
-> Either (Either GHCupInfo SetupInfo) URI
forall a b. a -> Either a b
Left (GHCupInfo -> Either GHCupInfo SetupInfo
forall a b. a -> Either a b
Left GHCupInfo
gi)
    convert'' (Right URI
uri) = URI -> Either (Either GHCupInfo SetupInfo) URI
forall a b. b -> Either a b
Right URI
uri

    parseOwnSourceLegacy :: Value -> Parser URLSource
parseOwnSourceLegacy = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      URI
r :: URI <- Object
o Object -> Key -> Parser URI
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"OwnSource"
      URLSource -> Parser URLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either (Either GHCupInfo SetupInfo) URI] -> URLSource
OwnSource [URI -> Either (Either GHCupInfo SetupInfo) URI
forall a b. b -> Either a b
Right URI
r])
    parseOwnSourceNew1 :: Value -> Parser URLSource
parseOwnSourceNew1 = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      [URI]
r :: [URI] <- Object
o Object -> Key -> Parser [URI]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"OwnSource"
      URLSource -> Parser URLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either (Either GHCupInfo SetupInfo) URI] -> URLSource
OwnSource ((URI -> Either (Either GHCupInfo SetupInfo) URI)
-> [URI] -> [Either (Either GHCupInfo SetupInfo) URI]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap URI -> Either (Either GHCupInfo SetupInfo) URI
forall a b. b -> Either a b
Right [URI]
r))
    parseOwnSourceNew2 :: Value -> Parser URLSource
parseOwnSourceNew2 = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      [Either GHCupInfo URI]
r :: [Either GHCupInfo URI] <- Object
o Object -> Key -> Parser [Either GHCupInfo URI]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"OwnSource"
      URLSource -> Parser URLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either (Either GHCupInfo SetupInfo) URI] -> URLSource
OwnSource (Either GHCupInfo URI -> Either (Either GHCupInfo SetupInfo) URI
convert'' (Either GHCupInfo URI -> Either (Either GHCupInfo SetupInfo) URI)
-> [Either GHCupInfo URI]
-> [Either (Either GHCupInfo SetupInfo) URI]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either GHCupInfo URI]
r))
    parseOwnSpec :: Value -> Parser URLSource
parseOwnSpec = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      GHCupInfo
r :: GHCupInfo <- Object
o Object -> Key -> Parser GHCupInfo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"OwnSpec"
      URLSource -> Parser URLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either GHCupInfo SetupInfo -> URLSource
OwnSpec (Either GHCupInfo SetupInfo -> URLSource)
-> Either GHCupInfo SetupInfo -> URLSource
forall a b. (a -> b) -> a -> b
$ GHCupInfo -> Either GHCupInfo SetupInfo
forall a b. a -> Either a b
Left GHCupInfo
r)
    parseGHCupURL :: Value -> Parser URLSource
parseGHCupURL = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      [Value]
_ :: [Value] <- Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"GHCupURL"
      URLSource -> Parser URLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure URLSource
GHCupURL
    parseStackURL :: Value -> Parser URLSource
parseStackURL = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      [Value]
_ :: [Value] <- Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"StackSetupURL"
      URLSource -> Parser URLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure URLSource
StackSetupURL
    legacyParseAddSource :: Value -> Parser URLSource
legacyParseAddSource = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Either GHCupInfo URI
r :: Either GHCupInfo URI <- Object
o Object -> Key -> Parser (Either GHCupInfo URI)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"AddSource"
      URLSource -> Parser URLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either (Either GHCupInfo SetupInfo) URI] -> URLSource
AddSource [Either GHCupInfo URI -> Either (Either GHCupInfo SetupInfo) URI
convert'' Either GHCupInfo URI
r])
    newParseAddSource :: Value -> Parser URLSource
newParseAddSource = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      [Either GHCupInfo URI]
r :: [Either GHCupInfo URI] <- Object
o Object -> Key -> Parser [Either GHCupInfo URI]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"AddSource"
      URLSource -> Parser URLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either (Either GHCupInfo SetupInfo) URI] -> URLSource
AddSource (Either GHCupInfo URI -> Either (Either GHCupInfo SetupInfo) URI
convert'' (Either GHCupInfo URI -> Either (Either GHCupInfo SetupInfo) URI)
-> [Either GHCupInfo URI]
-> [Either (Either GHCupInfo SetupInfo) URI]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either GHCupInfo URI]
r))

    -- new since Stack SetupInfo
    parseOwnSpecNew :: Value -> Parser URLSource
parseOwnSpecNew = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Either GHCupInfo SetupInfo
r :: Either GHCupInfo SetupInfo <- Object
o Object -> Key -> Parser (Either GHCupInfo SetupInfo)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"OwnSpec"
      URLSource -> Parser URLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either GHCupInfo SetupInfo -> URLSource
OwnSpec Either GHCupInfo SetupInfo
r)
    parseOwnSourceNew3 :: Value -> Parser URLSource
parseOwnSourceNew3 = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      [Either (Either GHCupInfo SetupInfo) URI]
r :: [Either (Either GHCupInfo SetupInfo) URI] <- Object
o Object -> Key -> Parser [Either (Either GHCupInfo SetupInfo) URI]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"OwnSource"
      URLSource -> Parser URLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either (Either GHCupInfo SetupInfo) URI] -> URLSource
OwnSource [Either (Either GHCupInfo SetupInfo) URI]
r)
    newParseAddSource2 :: Value -> Parser URLSource
newParseAddSource2 = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      [Either (Either GHCupInfo SetupInfo) URI]
r :: [Either (Either GHCupInfo SetupInfo) URI] <- Object
o Object -> Key -> Parser [Either (Either GHCupInfo SetupInfo) URI]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"AddSource"
      URLSource -> Parser URLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either (Either GHCupInfo SetupInfo) URI] -> URLSource
AddSource [Either (Either GHCupInfo SetupInfo) URI]
r)

    -- more lenient versions
    parseOwnSpecLenient :: Value -> Parser URLSource
parseOwnSpecLenient = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Object
spec :: Object <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"OwnSpec"
      Either GHCupInfo SetupInfo -> URLSource
OwnSpec (Either GHCupInfo SetupInfo -> URLSource)
-> Parser (Either GHCupInfo SetupInfo) -> Parser URLSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser (Either GHCupInfo SetupInfo)
lenientInfoParser Object
spec
    parseOwnSourceLenient :: Value -> Parser URLSource
parseOwnSourceLenient = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Array
mown :: Array <- Object
o Object -> Key -> Parser Array
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"OwnSource"
      [Either (Either GHCupInfo SetupInfo) URI] -> URLSource
OwnSource ([Either (Either GHCupInfo SetupInfo) URI] -> URLSource)
-> (Vector (Either (Either GHCupInfo SetupInfo) URI)
    -> [Either (Either GHCupInfo SetupInfo) URI])
-> Vector (Either (Either GHCupInfo SetupInfo) URI)
-> URLSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Either (Either GHCupInfo SetupInfo) URI)
-> [Either (Either GHCupInfo SetupInfo) URI]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector (Either (Either GHCupInfo SetupInfo) URI) -> URLSource)
-> Parser (Vector (Either (Either GHCupInfo SetupInfo) URI))
-> Parser URLSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (Either (Either GHCupInfo SetupInfo) URI))
-> Array
-> Parser (Vector (Either (Either GHCupInfo SetupInfo) URI))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM Value -> Parser (Either (Either GHCupInfo SetupInfo) URI)
lenientInfoUriParser Array
mown
    parseAddSourceLenient :: Value -> Parser URLSource
parseAddSourceLenient = String -> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"URLSource" ((Object -> Parser URLSource) -> Value -> Parser URLSource)
-> (Object -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Array
madd :: Array <- Object
o Object -> Key -> Parser Array
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"AddSource"
      [Either (Either GHCupInfo SetupInfo) URI] -> URLSource
AddSource ([Either (Either GHCupInfo SetupInfo) URI] -> URLSource)
-> (Vector (Either (Either GHCupInfo SetupInfo) URI)
    -> [Either (Either GHCupInfo SetupInfo) URI])
-> Vector (Either (Either GHCupInfo SetupInfo) URI)
-> URLSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Either (Either GHCupInfo SetupInfo) URI)
-> [Either (Either GHCupInfo SetupInfo) URI]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector (Either (Either GHCupInfo SetupInfo) URI) -> URLSource)
-> Parser (Vector (Either (Either GHCupInfo SetupInfo) URI))
-> Parser URLSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (Either (Either GHCupInfo SetupInfo) URI))
-> Array
-> Parser (Vector (Either (Either GHCupInfo SetupInfo) URI))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM Value -> Parser (Either (Either GHCupInfo SetupInfo) URI)
lenientInfoUriParser Array
madd

    -- simplified
    parseNewUrlSource :: Value -> Parser URLSource
parseNewUrlSource = String -> (Array -> Parser URLSource) -> Value -> Parser URLSource
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"URLSource" ((Array -> Parser URLSource) -> Value -> Parser URLSource)
-> (Array -> Parser URLSource) -> Value -> Parser URLSource
forall a b. (a -> b) -> a -> b
$ \Array
a -> do
      [NewURLSource] -> URLSource
SimpleList ([NewURLSource] -> URLSource)
-> (Vector NewURLSource -> [NewURLSource])
-> Vector NewURLSource
-> URLSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector NewURLSource -> [NewURLSource]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector NewURLSource -> URLSource)
-> Parser (Vector NewURLSource) -> Parser URLSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser NewURLSource)
-> Array -> Parser (Vector NewURLSource)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM Value -> Parser NewURLSource
forall a. FromJSON a => Value -> Parser a
parseJSON Array
a
    parseNewUrlSource' :: Value -> Parser URLSource
parseNewUrlSource' Value
v' = [NewURLSource] -> URLSource
SimpleList ([NewURLSource] -> URLSource)
-> (NewURLSource -> [NewURLSource]) -> NewURLSource -> URLSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(NewURLSource -> [NewURLSource] -> [NewURLSource]
forall a. a -> [a] -> [a]
:[]) (NewURLSource -> URLSource)
-> Parser NewURLSource -> Parser URLSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NewURLSource
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v'


lenientInfoUriParser :: Value -> Parser (Either (Either GHCupInfo SetupInfo) URI)
lenientInfoUriParser :: Value -> Parser (Either (Either GHCupInfo SetupInfo) URI)
lenientInfoUriParser (Object Object
o) = Either GHCupInfo SetupInfo
-> Either (Either GHCupInfo SetupInfo) URI
forall a b. a -> Either a b
Left (Either GHCupInfo SetupInfo
 -> Either (Either GHCupInfo SetupInfo) URI)
-> Parser (Either GHCupInfo SetupInfo)
-> Parser (Either (Either GHCupInfo SetupInfo) URI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser (Either GHCupInfo SetupInfo)
lenientInfoParser Object
o
lenientInfoUriParser v :: Value
v@(String Text
_) = URI -> Either (Either GHCupInfo SetupInfo) URI
forall a b. b -> Either a b
Right (URI -> Either (Either GHCupInfo SetupInfo) URI)
-> Parser URI -> Parser (Either (Either GHCupInfo SetupInfo) URI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser URI
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
lenientInfoUriParser Value
_ = String -> Parser (Either (Either GHCupInfo SetupInfo) URI)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected json in lenientInfoUriParser"


lenientInfoParser :: Object -> Parser (Either GHCupInfo SetupInfo)
lenientInfoParser :: Object -> Parser (Either GHCupInfo SetupInfo)
lenientInfoParser Object
o = do
  Maybe Object
setup_info :: Maybe Object <- Object
o Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"setup-info"
  case Maybe Object
setup_info of
    Maybe Object
Nothing -> do
      GHCupInfo
r <- Value -> Parser GHCupInfo
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Either GHCupInfo SetupInfo -> Parser (Either GHCupInfo SetupInfo)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either GHCupInfo SetupInfo -> Parser (Either GHCupInfo SetupInfo))
-> Either GHCupInfo SetupInfo
-> Parser (Either GHCupInfo SetupInfo)
forall a b. (a -> b) -> a -> b
$ GHCupInfo -> Either GHCupInfo SetupInfo
forall a b. a -> Either a b
Left GHCupInfo
r
    Just Object
setup_info' -> do
      SetupInfo
r <- Value -> Parser SetupInfo
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
setup_info')
      Either GHCupInfo SetupInfo -> Parser (Either GHCupInfo SetupInfo)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either GHCupInfo SetupInfo -> Parser (Either GHCupInfo SetupInfo))
-> Either GHCupInfo SetupInfo
-> Parser (Either GHCupInfo SetupInfo)
forall a b. (a -> b) -> a -> b
$ SetupInfo -> Either GHCupInfo SetupInfo
forall a b. b -> Either a b
Right SetupInfo
r

instance FromJSON NewURLSource where
  parseJSON :: Value -> Parser NewURLSource
parseJSON Value
v = Value -> Parser NewURLSource
uri Value
v Parser NewURLSource -> Parser NewURLSource -> Parser NewURLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser NewURLSource
url Value
v Parser NewURLSource -> Parser NewURLSource -> Parser NewURLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser NewURLSource
alias Value
v Parser NewURLSource -> Parser NewURLSource -> Parser NewURLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser NewURLSource
gi Value
v Parser NewURLSource -> Parser NewURLSource -> Parser NewURLSource
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser NewURLSource
si Value
v
   where
    alias :: Value -> Parser NewURLSource
alias = String
-> (Text -> Parser NewURLSource) -> Value -> Parser NewURLSource
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"NewURLSource" ((Text -> Parser NewURLSource) -> Value -> Parser NewURLSource)
-> (Text -> Parser NewURLSource) -> Value -> Parser NewURLSource
forall a b. (a -> b) -> a -> b
$ \Text
t -> ChannelAlias -> NewURLSource
NewChannelAlias (ChannelAlias -> NewURLSource)
-> Parser ChannelAlias -> Parser NewURLSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ChannelAlias
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
String Text
t)
    uri :: Value -> Parser NewURLSource
uri = String
-> (Text -> Parser NewURLSource) -> Value -> Parser NewURLSource
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"NewURLSource" ((Text -> Parser NewURLSource) -> Value -> Parser NewURLSource)
-> (Text -> Parser NewURLSource) -> Value -> Parser NewURLSource
forall a b. (a -> b) -> a -> b
$ \Text
t -> URI -> NewURLSource
NewURI (URI -> NewURLSource) -> Parser URI -> Parser NewURLSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser URI
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
String Text
t)
    url :: Value -> Parser NewURLSource
url = String
-> (Text -> Parser NewURLSource) -> Value -> Parser NewURLSource
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"NewURLSource" ((Text -> Parser NewURLSource) -> Value -> Parser NewURLSource)
-> (Text -> Parser NewURLSource) -> Value -> Parser NewURLSource
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> String
T.unpack Text
t of
                                            String
"GHCupURL" -> NewURLSource -> Parser NewURLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NewURLSource
NewGHCupURL
                                            String
"StackSetupURL" -> NewURLSource -> Parser NewURLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NewURLSource
NewStackSetupURL
                                            String
t' -> String -> Parser NewURLSource
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NewURLSource) -> String -> Parser NewURLSource
forall a b. (a -> b) -> a -> b
$ String
"Unexpected text value in NewURLSource: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
t'
    gi :: Value -> Parser NewURLSource
gi = String
-> (Object -> Parser NewURLSource) -> Value -> Parser NewURLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NewURLSource" ((Object -> Parser NewURLSource) -> Value -> Parser NewURLSource)
-> (Object -> Parser NewURLSource) -> Value -> Parser NewURLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
       GHCupInfo
ginfo :: GHCupInfo <- Object
o Object -> Key -> Parser GHCupInfo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ghcup-info"
       NewURLSource -> Parser NewURLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewURLSource -> Parser NewURLSource)
-> NewURLSource -> Parser NewURLSource
forall a b. (a -> b) -> a -> b
$ GHCupInfo -> NewURLSource
NewGHCupInfo GHCupInfo
ginfo

    si :: Value -> Parser NewURLSource
si = String
-> (Object -> Parser NewURLSource) -> Value -> Parser NewURLSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NewURLSource" ((Object -> Parser NewURLSource) -> Value -> Parser NewURLSource)
-> (Object -> Parser NewURLSource) -> Value -> Parser NewURLSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
       SetupInfo
sinfo :: SetupInfo <- Object
o Object -> Key -> Parser SetupInfo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"setup-info"
       NewURLSource -> Parser NewURLSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewURLSource -> Parser NewURLSource)
-> NewURLSource -> Parser NewURLSource
forall a b. (a -> b) -> a -> b
$ SetupInfo -> NewURLSource
NewSetupInfo SetupInfo
sinfo


instance FromJSON KeyCombination where
  parseJSON :: Value -> Parser KeyCombination
parseJSON Value
v = Value -> Parser KeyCombination
proper Value
v Parser KeyCombination
-> Parser KeyCombination -> Parser KeyCombination
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser KeyCombination
simple Value
v
   where
    simple :: Value -> Parser KeyCombination
simple = String
-> (Object -> Parser KeyCombination)
-> Value
-> Parser KeyCombination
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"KeyCombination" ((Object -> Parser KeyCombination)
 -> Value -> Parser KeyCombination)
-> (Object -> Parser KeyCombination)
-> Value
-> Parser KeyCombination
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Key
k <- Value -> Parser Key
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      KeyCombination -> Parser KeyCombination
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> [Modifier] -> KeyCombination
KeyCombination Key
k [])
    proper :: Value -> Parser KeyCombination
proper = String
-> (Object -> Parser KeyCombination)
-> Value
-> Parser KeyCombination
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"KeyCombination" ((Object -> Parser KeyCombination)
 -> Value -> Parser KeyCombination)
-> (Object -> Parser KeyCombination)
-> Value
-> Parser KeyCombination
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Key
k <- Object
o Object -> Key -> Parser Key
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Key"
      [Modifier]
m <- Object
o Object -> Key -> Parser [Modifier]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Mods"
      KeyCombination -> Parser KeyCombination
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyCombination -> Parser KeyCombination)
-> KeyCombination -> Parser KeyCombination
forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> KeyCombination
KeyCombination Key
k [Modifier]
m

instance ToJSON KeyCombination where
  toJSON :: KeyCombination -> Value
toJSON (KeyCombination Key
k [Modifier]
m) = [Pair] -> Value
object [Key
"Key" Key -> Key -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Key
k, Key
"Mods" Key -> [Modifier] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Modifier]
m]

instance FromJSON PagerConfig where
  parseJSON :: Value -> Parser PagerConfig
parseJSON Value
v = Value -> Parser PagerConfig
p1 Value
v Parser PagerConfig -> Parser PagerConfig -> Parser PagerConfig
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser PagerConfig
p2 Value
v Parser PagerConfig -> Parser PagerConfig -> Parser PagerConfig
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser PagerConfig
p3 Value
v
   where
    p2 :: Value -> Parser PagerConfig
p2 = String
-> (Bool -> Parser PagerConfig) -> Value -> Parser PagerConfig
forall a. String -> (Bool -> Parser a) -> Value -> Parser a
withBool String
"PagerConfig" ((Bool -> Parser PagerConfig) -> Value -> Parser PagerConfig)
-> (Bool -> Parser PagerConfig) -> Value -> Parser PagerConfig
forall a b. (a -> b) -> a -> b
$ \Bool
b -> PagerConfig -> Parser PagerConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PagerConfig -> Parser PagerConfig)
-> PagerConfig -> Parser PagerConfig
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe String -> PagerConfig
PagerConfig Bool
b Maybe String
forall a. Maybe a
Nothing
    p3 :: Value -> Parser PagerConfig
p3 = String
-> (Text -> Parser PagerConfig) -> Value -> Parser PagerConfig
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PagerConfig" ((Text -> Parser PagerConfig) -> Value -> Parser PagerConfig)
-> (Text -> Parser PagerConfig) -> Value -> Parser PagerConfig
forall a b. (a -> b) -> a -> b
$ \Text
t -> PagerConfig -> Parser PagerConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PagerConfig -> Parser PagerConfig)
-> PagerConfig -> Parser PagerConfig
forall a b. (a -> b) -> a -> b
$ String -> PagerConfig
allPagerConfig (Text -> String
T.unpack Text
t)
    p1 :: Value -> Parser PagerConfig
p1 = String
-> (Object -> Parser PagerConfig) -> Value -> Parser PagerConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PagerConfig" ((Object -> Parser PagerConfig) -> Value -> Parser PagerConfig)
-> (Object -> Parser PagerConfig) -> Value -> Parser PagerConfig
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
       Bool
list <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"list"
       Maybe String
cmd  <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cmd"
       PagerConfig -> Parser PagerConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PagerConfig -> Parser PagerConfig)
-> PagerConfig -> Parser PagerConfig
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe String -> PagerConfig
PagerConfig Bool
list Maybe String
cmd


deriveToJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "pager-") . T.pack . kebab $ str' } ''PagerConfig
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings