{-# 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.JSON.Utils
import           GHCup.Prelude.MegaParsec

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.Text.Encoding            as E
import           Data.Versions
import           Data.Void
import           URI.ByteString
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


deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMode
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
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-" 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 (UnknownTag String
x    ) = Text -> Value
String (String -> Text
T.pack String
x)

instance FromJSON Tag where
  parseJSON :: Value -> Parser Tag
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Tag" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> String
T.unpack Text
t of
    String
"Latest"                             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
Latest
    String
"Recommended"                        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
Recommended
    String
"Prerelease"                         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
Prerelease
    String
"Nightly"                            -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
Nightly
    String
"LatestPrerelease"                   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
LatestPrerelease
    String
"LatestNightly"                      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
LatestNightly
    String
"old"                                -> 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PVP -> Tag
Base PVP
x
      Left  ParsingError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ParsingError
e
    String
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Tag
UnknownTag String
x)

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


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

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

instance FromJSON GHCTargetVersion where
  parseJSON :: Value -> Parser GHCTargetVersion
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"GHCTargetVersion" forall a b. (a -> b) -> a -> b
$ \Text
t -> case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCTargetVersion
x
    Left  ParsingError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failure in GHCTargetVersion (FromJSON)" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ParsingError
e

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

instance FromJSONKey GHCTargetVersion where
  fromJSONKey :: FromJSONKeyFunction GHCTargetVersion
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser forall a b. (a -> b) -> a -> b
$ \Text
t -> case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCTargetVersion
x
    Left  ParsingError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failure in GHCTargetVersion (FromJSONKey)" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ParsingError
e

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

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

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

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

instance ToJSONKey (Maybe Versioning) where
  toJSONKey :: ToJSONKeyFunction (Maybe Versioning)
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText forall a b. (a -> b) -> a -> b
$ \case
    Just Versioning
x  -> Versioning -> Text
prettyV Versioning
x
    Maybe Versioning
Nothing -> String -> Text
T.pack String
"unknown_versioning"

instance FromJSONKey (Maybe Versioning) where
  fromJSONKey :: FromJSONKeyFunction (Maybe Versioning)
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser forall a b. (a -> b) -> a -> b
$ \Text
t ->
    if Text
t forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"unknown_versioning" then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing else forall {f :: * -> *}. MonadFail f => Text -> f (Maybe Versioning)
just Text
t
   where
    just :: Text -> f (Maybe Versioning)
just Text
t = case Text -> Either ParsingError Versioning
versioning Text
t of
      Right Versioning
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Versioning
x
      Left  ParsingError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failure in (Maybe Versioning) (FromJSONKey)" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ParsingError
e

instance ToJSONKey Platform where
  toJSONKey :: ToJSONKeyFunction Platform
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText 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_" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show LinuxDistro
d)
    Platform
Windows -> String -> Text
T.pack String
"Windows"

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

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

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

instance ToJSONKey (Maybe Version) where
  toJSONKey :: ToJSONKeyFunction (Maybe Version)
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText forall a b. (a -> b) -> a -> b
$ \case
    Just Version
x  -> Version -> Text
prettyVer Version
x
    Maybe Version
Nothing -> String -> Text
T.pack String
"unknown_version"

instance FromJSONKey (Maybe Version) where
  fromJSONKey :: FromJSONKeyFunction (Maybe Version)
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser forall a b. (a -> b) -> a -> b
$ \Text
t ->
    if Text
t forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"unknown_version" then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing else forall {f :: * -> *}. MonadFail f => Text -> f (Maybe Version)
just Text
t
   where
    just :: Text -> f (Maybe Version)
just Text
t = case Text -> Either ParsingError Version
version Text
t of
      Right Version
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Version
x
      Left  ParsingError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failure in (Maybe Version) (FromJSONKey)" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ParsingError
e

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

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

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

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

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

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

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

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

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

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

instance ToJSON TarDir where
  toJSON :: TarDir -> Value
toJSON (RealDir  String
p) = forall a. ToJSON a => a -> Value
toJSON String
p
  toJSON (RegexDir String
r) = [Pair] -> Value
object [Key
"RegexDir" forall kv v. (KeyValue 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser TarDir
regexDir Value
v
   where
    realDir :: Value -> Parser TarDir
realDir = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"TarDir" forall a b. (a -> b) -> a -> b
$ \Text
t -> do
      String
fp <- forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
String Text
t)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> TarDir
RealDir String
fp)
    regexDir :: Value -> Parser TarDir
regexDir = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TarDir" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      String
r <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"RegexDir"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> TarDir
RegexDir String
r


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

instance FromJSON VersionCmp where
  parseJSON :: Value -> Parser VersionCmp
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"VersionCmp" forall a b. (a -> b) -> a -> b
$ \Text
t -> do
    case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionCmp
r
      Left  ParsingError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (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 = forall a. ToJSON a => a -> Value
toJSON 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 = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ByteString" forall a b. (a -> b) -> a -> b
$ \Text
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
"> " forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
ver'
versionCmpToText (VR_gteq Versioning
ver') = Text
">= " forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
ver'
versionCmpToText (VR_lt   Versioning
ver') = Text
"< " forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
ver'
versionCmpToText (VR_lteq Versioning
ver') = Text
"<= " forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
ver'
versionCmpToText (VR_eq   Versioning
ver') = 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 =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Versioning -> VersionCmp
VR_gt (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
">" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Versioning
versioningEnd)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          Versioning -> VersionCmp
VR_gteq
          (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
">=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Versioning
versioningEnd)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          Versioning -> VersionCmp
VR_lt
          (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"<" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Versioning
versioningEnd)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          Versioning -> VersionCmp
VR_lteq
          (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"<=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Versioning
versioningEnd)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          Versioning -> VersionCmp
VR_eq
          (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"==" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Versioning
versioningEnd)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          Versioning -> VersionCmp
VR_eq
          (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Versioning
versioningEnd)

instance ToJSON VersionRange where
  toJSON :: VersionRange -> Value
toJSON = Text -> Value
String 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 = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Text
x Text
y -> Text
x forall a. Semigroup a => a -> a -> a
<> Text
" && " forall a. Semigroup a => a -> a -> a
<> Text
y)
                     (VersionCmp -> Text
versionCmpToText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty VersionCmp
cmps)
  in  Text
"( " forall a. Semigroup a => a -> a -> a
<> Text
inner 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 forall a. Semigroup a => a -> a -> a
<> Text
" || " forall a. Semigroup a => a -> a -> a
<> Text
right

instance FromJSON VersionRange where
  parseJSON :: Value -> Parser VersionRange
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"VersionRange" forall a b. (a -> b) -> a -> b
$ \Text
t -> do
    case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionRange
r
      Left  ParsingError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof
 where
  go :: Parsec Void Text VersionRange
go =
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text VersionRange
orParse
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty VersionCmp -> VersionRange
SimpleRange Parsec Void Text (NonEmpty VersionCmp)
andParse)
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty VersionCmp -> VersionRange
SimpleRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text (NonEmpty VersionCmp)
andParse forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure Parsec Void Text VersionCmp
versionCmpP)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"||" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space 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 :: Parsec Void Text (NonEmpty VersionCmp)
andParse =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\VersionCmp
h [VersionCmp]
t -> VersionCmp
h forall a. a -> [a] -> NonEmpty a
:| [VersionCmp]
t)
         (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"(" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text VersionCmp
versionCmpP)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"&&" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text VersionCmp
versionCmpP))
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
")"
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  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 =
  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (Parsec Void Text Text -> ParsecT Void Text Identity Versioning
verP (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
" " forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
")" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"&&") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space)
    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 = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText 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 = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser forall a b. (a -> b) -> a -> b
$ \Text
t ->
    if Text
t forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"unknown_versioning" then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing else forall {f :: * -> *}. MonadFail f => Text -> f (Maybe VersionRange)
just Text
t
   where
    just :: Text -> f (Maybe VersionRange)
just Text
t = case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just VersionRange
x
      Left  ParsingError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failure in (Maybe VersionRange) (FromJSONKey)" forall a. Semigroup a => a -> a -> a
<> 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
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
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
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key

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

deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings