module Hix.Data.GhciConfig where

import Data.Aeson (FromJSON, FromJSONKey)
import GHC.Exts (IsList)

import Hix.Data.ComponentConfig (EnvRunner, PackageName, PackagesConfig)

newtype RunnerName =
  RunnerName { RunnerName -> Text
unRunnerName :: Text }
  deriving stock (RunnerName -> RunnerName -> Bool
(RunnerName -> RunnerName -> Bool)
-> (RunnerName -> RunnerName -> Bool) -> Eq RunnerName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunnerName -> RunnerName -> Bool
== :: RunnerName -> RunnerName -> Bool
$c/= :: RunnerName -> RunnerName -> Bool
/= :: RunnerName -> RunnerName -> Bool
Eq, Int -> RunnerName -> ShowS
[RunnerName] -> ShowS
RunnerName -> String
(Int -> RunnerName -> ShowS)
-> (RunnerName -> String)
-> ([RunnerName] -> ShowS)
-> Show RunnerName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunnerName -> ShowS
showsPrec :: Int -> RunnerName -> ShowS
$cshow :: RunnerName -> String
show :: RunnerName -> String
$cshowList :: [RunnerName] -> ShowS
showList :: [RunnerName] -> ShowS
Show, (forall x. RunnerName -> Rep RunnerName x)
-> (forall x. Rep RunnerName x -> RunnerName) -> Generic RunnerName
forall x. Rep RunnerName x -> RunnerName
forall x. RunnerName -> Rep RunnerName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunnerName -> Rep RunnerName x
from :: forall x. RunnerName -> Rep RunnerName x
$cto :: forall x. Rep RunnerName x -> RunnerName
to :: forall x. Rep RunnerName x -> RunnerName
Generic)
  deriving newtype (String -> RunnerName
(String -> RunnerName) -> IsString RunnerName
forall a. (String -> a) -> IsString a
$cfromString :: String -> RunnerName
fromString :: String -> RunnerName
IsString, Eq RunnerName
Eq RunnerName
-> (RunnerName -> RunnerName -> Ordering)
-> (RunnerName -> RunnerName -> Bool)
-> (RunnerName -> RunnerName -> Bool)
-> (RunnerName -> RunnerName -> Bool)
-> (RunnerName -> RunnerName -> Bool)
-> (RunnerName -> RunnerName -> RunnerName)
-> (RunnerName -> RunnerName -> RunnerName)
-> Ord RunnerName
RunnerName -> RunnerName -> Bool
RunnerName -> RunnerName -> Ordering
RunnerName -> RunnerName -> RunnerName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunnerName -> RunnerName -> Ordering
compare :: RunnerName -> RunnerName -> Ordering
$c< :: RunnerName -> RunnerName -> Bool
< :: RunnerName -> RunnerName -> Bool
$c<= :: RunnerName -> RunnerName -> Bool
<= :: RunnerName -> RunnerName -> Bool
$c> :: RunnerName -> RunnerName -> Bool
> :: RunnerName -> RunnerName -> Bool
$c>= :: RunnerName -> RunnerName -> Bool
>= :: RunnerName -> RunnerName -> Bool
$cmax :: RunnerName -> RunnerName -> RunnerName
max :: RunnerName -> RunnerName -> RunnerName
$cmin :: RunnerName -> RunnerName -> RunnerName
min :: RunnerName -> RunnerName -> RunnerName
Ord, FromJSONKeyFunction [RunnerName]
FromJSONKeyFunction RunnerName
FromJSONKeyFunction RunnerName
-> FromJSONKeyFunction [RunnerName] -> FromJSONKey RunnerName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction RunnerName
fromJSONKey :: FromJSONKeyFunction RunnerName
$cfromJSONKeyList :: FromJSONKeyFunction [RunnerName]
fromJSONKeyList :: FromJSONKeyFunction [RunnerName]
FromJSONKey)

newtype GhciSetupCode =
  GhciSetupCode { GhciSetupCode -> Text
unGhciSetupCode :: Text }
  deriving stock (GhciSetupCode -> GhciSetupCode -> Bool
(GhciSetupCode -> GhciSetupCode -> Bool)
-> (GhciSetupCode -> GhciSetupCode -> Bool) -> Eq GhciSetupCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhciSetupCode -> GhciSetupCode -> Bool
== :: GhciSetupCode -> GhciSetupCode -> Bool
$c/= :: GhciSetupCode -> GhciSetupCode -> Bool
/= :: GhciSetupCode -> GhciSetupCode -> Bool
Eq, Int -> GhciSetupCode -> ShowS
[GhciSetupCode] -> ShowS
GhciSetupCode -> String
(Int -> GhciSetupCode -> ShowS)
-> (GhciSetupCode -> String)
-> ([GhciSetupCode] -> ShowS)
-> Show GhciSetupCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhciSetupCode -> ShowS
showsPrec :: Int -> GhciSetupCode -> ShowS
$cshow :: GhciSetupCode -> String
show :: GhciSetupCode -> String
$cshowList :: [GhciSetupCode] -> ShowS
showList :: [GhciSetupCode] -> ShowS
Show, (forall x. GhciSetupCode -> Rep GhciSetupCode x)
-> (forall x. Rep GhciSetupCode x -> GhciSetupCode)
-> Generic GhciSetupCode
forall x. Rep GhciSetupCode x -> GhciSetupCode
forall x. GhciSetupCode -> Rep GhciSetupCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GhciSetupCode -> Rep GhciSetupCode x
from :: forall x. GhciSetupCode -> Rep GhciSetupCode x
$cto :: forall x. Rep GhciSetupCode x -> GhciSetupCode
to :: forall x. Rep GhciSetupCode x -> GhciSetupCode
Generic)
  deriving newtype (String -> GhciSetupCode
(String -> GhciSetupCode) -> IsString GhciSetupCode
forall a. (String -> a) -> IsString a
$cfromString :: String -> GhciSetupCode
fromString :: String -> GhciSetupCode
IsString, Eq GhciSetupCode
Eq GhciSetupCode
-> (GhciSetupCode -> GhciSetupCode -> Ordering)
-> (GhciSetupCode -> GhciSetupCode -> Bool)
-> (GhciSetupCode -> GhciSetupCode -> Bool)
-> (GhciSetupCode -> GhciSetupCode -> Bool)
-> (GhciSetupCode -> GhciSetupCode -> Bool)
-> (GhciSetupCode -> GhciSetupCode -> GhciSetupCode)
-> (GhciSetupCode -> GhciSetupCode -> GhciSetupCode)
-> Ord GhciSetupCode
GhciSetupCode -> GhciSetupCode -> Bool
GhciSetupCode -> GhciSetupCode -> Ordering
GhciSetupCode -> GhciSetupCode -> GhciSetupCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GhciSetupCode -> GhciSetupCode -> Ordering
compare :: GhciSetupCode -> GhciSetupCode -> Ordering
$c< :: GhciSetupCode -> GhciSetupCode -> Bool
< :: GhciSetupCode -> GhciSetupCode -> Bool
$c<= :: GhciSetupCode -> GhciSetupCode -> Bool
<= :: GhciSetupCode -> GhciSetupCode -> Bool
$c> :: GhciSetupCode -> GhciSetupCode -> Bool
> :: GhciSetupCode -> GhciSetupCode -> Bool
$c>= :: GhciSetupCode -> GhciSetupCode -> Bool
>= :: GhciSetupCode -> GhciSetupCode -> Bool
$cmax :: GhciSetupCode -> GhciSetupCode -> GhciSetupCode
max :: GhciSetupCode -> GhciSetupCode -> GhciSetupCode
$cmin :: GhciSetupCode -> GhciSetupCode -> GhciSetupCode
min :: GhciSetupCode -> GhciSetupCode -> GhciSetupCode
Ord, Value -> Parser [GhciSetupCode]
Value -> Parser GhciSetupCode
(Value -> Parser GhciSetupCode)
-> (Value -> Parser [GhciSetupCode]) -> FromJSON GhciSetupCode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GhciSetupCode
parseJSON :: Value -> Parser GhciSetupCode
$cparseJSONList :: Value -> Parser [GhciSetupCode]
parseJSONList :: Value -> Parser [GhciSetupCode]
FromJSON, NonEmpty GhciSetupCode -> GhciSetupCode
GhciSetupCode -> GhciSetupCode -> GhciSetupCode
(GhciSetupCode -> GhciSetupCode -> GhciSetupCode)
-> (NonEmpty GhciSetupCode -> GhciSetupCode)
-> (forall b. Integral b => b -> GhciSetupCode -> GhciSetupCode)
-> Semigroup GhciSetupCode
forall b. Integral b => b -> GhciSetupCode -> GhciSetupCode
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: GhciSetupCode -> GhciSetupCode -> GhciSetupCode
<> :: GhciSetupCode -> GhciSetupCode -> GhciSetupCode
$csconcat :: NonEmpty GhciSetupCode -> GhciSetupCode
sconcat :: NonEmpty GhciSetupCode -> GhciSetupCode
$cstimes :: forall b. Integral b => b -> GhciSetupCode -> GhciSetupCode
stimes :: forall b. Integral b => b -> GhciSetupCode -> GhciSetupCode
Semigroup, Semigroup GhciSetupCode
GhciSetupCode
Semigroup GhciSetupCode
-> GhciSetupCode
-> (GhciSetupCode -> GhciSetupCode -> GhciSetupCode)
-> ([GhciSetupCode] -> GhciSetupCode)
-> Monoid GhciSetupCode
[GhciSetupCode] -> GhciSetupCode
GhciSetupCode -> GhciSetupCode -> GhciSetupCode
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: GhciSetupCode
mempty :: GhciSetupCode
$cmappend :: GhciSetupCode -> GhciSetupCode -> GhciSetupCode
mappend :: GhciSetupCode -> GhciSetupCode -> GhciSetupCode
$cmconcat :: [GhciSetupCode] -> GhciSetupCode
mconcat :: [GhciSetupCode] -> GhciSetupCode
Monoid)

newtype GhciRunExpr =
  GhciRunExpr { GhciRunExpr -> Text
unGhciRunExpr :: Text }
  deriving stock (GhciRunExpr -> GhciRunExpr -> Bool
(GhciRunExpr -> GhciRunExpr -> Bool)
-> (GhciRunExpr -> GhciRunExpr -> Bool) -> Eq GhciRunExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhciRunExpr -> GhciRunExpr -> Bool
== :: GhciRunExpr -> GhciRunExpr -> Bool
$c/= :: GhciRunExpr -> GhciRunExpr -> Bool
/= :: GhciRunExpr -> GhciRunExpr -> Bool
Eq, Int -> GhciRunExpr -> ShowS
[GhciRunExpr] -> ShowS
GhciRunExpr -> String
(Int -> GhciRunExpr -> ShowS)
-> (GhciRunExpr -> String)
-> ([GhciRunExpr] -> ShowS)
-> Show GhciRunExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhciRunExpr -> ShowS
showsPrec :: Int -> GhciRunExpr -> ShowS
$cshow :: GhciRunExpr -> String
show :: GhciRunExpr -> String
$cshowList :: [GhciRunExpr] -> ShowS
showList :: [GhciRunExpr] -> ShowS
Show, (forall x. GhciRunExpr -> Rep GhciRunExpr x)
-> (forall x. Rep GhciRunExpr x -> GhciRunExpr)
-> Generic GhciRunExpr
forall x. Rep GhciRunExpr x -> GhciRunExpr
forall x. GhciRunExpr -> Rep GhciRunExpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GhciRunExpr -> Rep GhciRunExpr x
from :: forall x. GhciRunExpr -> Rep GhciRunExpr x
$cto :: forall x. Rep GhciRunExpr x -> GhciRunExpr
to :: forall x. Rep GhciRunExpr x -> GhciRunExpr
Generic)
  deriving newtype (String -> GhciRunExpr
(String -> GhciRunExpr) -> IsString GhciRunExpr
forall a. (String -> a) -> IsString a
$cfromString :: String -> GhciRunExpr
fromString :: String -> GhciRunExpr
IsString, Eq GhciRunExpr
Eq GhciRunExpr
-> (GhciRunExpr -> GhciRunExpr -> Ordering)
-> (GhciRunExpr -> GhciRunExpr -> Bool)
-> (GhciRunExpr -> GhciRunExpr -> Bool)
-> (GhciRunExpr -> GhciRunExpr -> Bool)
-> (GhciRunExpr -> GhciRunExpr -> Bool)
-> (GhciRunExpr -> GhciRunExpr -> GhciRunExpr)
-> (GhciRunExpr -> GhciRunExpr -> GhciRunExpr)
-> Ord GhciRunExpr
GhciRunExpr -> GhciRunExpr -> Bool
GhciRunExpr -> GhciRunExpr -> Ordering
GhciRunExpr -> GhciRunExpr -> GhciRunExpr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GhciRunExpr -> GhciRunExpr -> Ordering
compare :: GhciRunExpr -> GhciRunExpr -> Ordering
$c< :: GhciRunExpr -> GhciRunExpr -> Bool
< :: GhciRunExpr -> GhciRunExpr -> Bool
$c<= :: GhciRunExpr -> GhciRunExpr -> Bool
<= :: GhciRunExpr -> GhciRunExpr -> Bool
$c> :: GhciRunExpr -> GhciRunExpr -> Bool
> :: GhciRunExpr -> GhciRunExpr -> Bool
$c>= :: GhciRunExpr -> GhciRunExpr -> Bool
>= :: GhciRunExpr -> GhciRunExpr -> Bool
$cmax :: GhciRunExpr -> GhciRunExpr -> GhciRunExpr
max :: GhciRunExpr -> GhciRunExpr -> GhciRunExpr
$cmin :: GhciRunExpr -> GhciRunExpr -> GhciRunExpr
min :: GhciRunExpr -> GhciRunExpr -> GhciRunExpr
Ord, Value -> Parser [GhciRunExpr]
Value -> Parser GhciRunExpr
(Value -> Parser GhciRunExpr)
-> (Value -> Parser [GhciRunExpr]) -> FromJSON GhciRunExpr
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GhciRunExpr
parseJSON :: Value -> Parser GhciRunExpr
$cparseJSONList :: Value -> Parser [GhciRunExpr]
parseJSONList :: Value -> Parser [GhciRunExpr]
FromJSON)

newtype GhciArgs =
  GhciArgs { GhciArgs -> [Text]
unGhciArgs :: [Text] }
  deriving stock (GhciArgs -> GhciArgs -> Bool
(GhciArgs -> GhciArgs -> Bool)
-> (GhciArgs -> GhciArgs -> Bool) -> Eq GhciArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhciArgs -> GhciArgs -> Bool
== :: GhciArgs -> GhciArgs -> Bool
$c/= :: GhciArgs -> GhciArgs -> Bool
/= :: GhciArgs -> GhciArgs -> Bool
Eq, Int -> GhciArgs -> ShowS
[GhciArgs] -> ShowS
GhciArgs -> String
(Int -> GhciArgs -> ShowS)
-> (GhciArgs -> String) -> ([GhciArgs] -> ShowS) -> Show GhciArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhciArgs -> ShowS
showsPrec :: Int -> GhciArgs -> ShowS
$cshow :: GhciArgs -> String
show :: GhciArgs -> String
$cshowList :: [GhciArgs] -> ShowS
showList :: [GhciArgs] -> ShowS
Show, (forall x. GhciArgs -> Rep GhciArgs x)
-> (forall x. Rep GhciArgs x -> GhciArgs) -> Generic GhciArgs
forall x. Rep GhciArgs x -> GhciArgs
forall x. GhciArgs -> Rep GhciArgs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GhciArgs -> Rep GhciArgs x
from :: forall x. GhciArgs -> Rep GhciArgs x
$cto :: forall x. Rep GhciArgs x -> GhciArgs
to :: forall x. Rep GhciArgs x -> GhciArgs
Generic)
  deriving newtype (Int -> [Item GhciArgs] -> GhciArgs
[Item GhciArgs] -> GhciArgs
GhciArgs -> [Item GhciArgs]
([Item GhciArgs] -> GhciArgs)
-> (Int -> [Item GhciArgs] -> GhciArgs)
-> (GhciArgs -> [Item GhciArgs])
-> IsList GhciArgs
forall l.
([Item l] -> l)
-> (Int -> [Item l] -> l) -> (l -> [Item l]) -> IsList l
$cfromList :: [Item GhciArgs] -> GhciArgs
fromList :: [Item GhciArgs] -> GhciArgs
$cfromListN :: Int -> [Item GhciArgs] -> GhciArgs
fromListN :: Int -> [Item GhciArgs] -> GhciArgs
$ctoList :: GhciArgs -> [Item GhciArgs]
toList :: GhciArgs -> [Item GhciArgs]
IsList, Eq GhciArgs
Eq GhciArgs
-> (GhciArgs -> GhciArgs -> Ordering)
-> (GhciArgs -> GhciArgs -> Bool)
-> (GhciArgs -> GhciArgs -> Bool)
-> (GhciArgs -> GhciArgs -> Bool)
-> (GhciArgs -> GhciArgs -> Bool)
-> (GhciArgs -> GhciArgs -> GhciArgs)
-> (GhciArgs -> GhciArgs -> GhciArgs)
-> Ord GhciArgs
GhciArgs -> GhciArgs -> Bool
GhciArgs -> GhciArgs -> Ordering
GhciArgs -> GhciArgs -> GhciArgs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GhciArgs -> GhciArgs -> Ordering
compare :: GhciArgs -> GhciArgs -> Ordering
$c< :: GhciArgs -> GhciArgs -> Bool
< :: GhciArgs -> GhciArgs -> Bool
$c<= :: GhciArgs -> GhciArgs -> Bool
<= :: GhciArgs -> GhciArgs -> Bool
$c> :: GhciArgs -> GhciArgs -> Bool
> :: GhciArgs -> GhciArgs -> Bool
$c>= :: GhciArgs -> GhciArgs -> Bool
>= :: GhciArgs -> GhciArgs -> Bool
$cmax :: GhciArgs -> GhciArgs -> GhciArgs
max :: GhciArgs -> GhciArgs -> GhciArgs
$cmin :: GhciArgs -> GhciArgs -> GhciArgs
min :: GhciArgs -> GhciArgs -> GhciArgs
Ord, Value -> Parser [GhciArgs]
Value -> Parser GhciArgs
(Value -> Parser GhciArgs)
-> (Value -> Parser [GhciArgs]) -> FromJSON GhciArgs
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GhciArgs
parseJSON :: Value -> Parser GhciArgs
$cparseJSONList :: Value -> Parser [GhciArgs]
parseJSONList :: Value -> Parser [GhciArgs]
FromJSON)

newtype ChangeDir =
  ChangeDir { ChangeDir -> Bool
unChangeDir :: Bool }
  deriving stock (ChangeDir -> ChangeDir -> Bool
(ChangeDir -> ChangeDir -> Bool)
-> (ChangeDir -> ChangeDir -> Bool) -> Eq ChangeDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChangeDir -> ChangeDir -> Bool
== :: ChangeDir -> ChangeDir -> Bool
$c/= :: ChangeDir -> ChangeDir -> Bool
/= :: ChangeDir -> ChangeDir -> Bool
Eq, Int -> ChangeDir -> ShowS
[ChangeDir] -> ShowS
ChangeDir -> String
(Int -> ChangeDir -> ShowS)
-> (ChangeDir -> String)
-> ([ChangeDir] -> ShowS)
-> Show ChangeDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeDir -> ShowS
showsPrec :: Int -> ChangeDir -> ShowS
$cshow :: ChangeDir -> String
show :: ChangeDir -> String
$cshowList :: [ChangeDir] -> ShowS
showList :: [ChangeDir] -> ShowS
Show, (forall x. ChangeDir -> Rep ChangeDir x)
-> (forall x. Rep ChangeDir x -> ChangeDir) -> Generic ChangeDir
forall x. Rep ChangeDir x -> ChangeDir
forall x. ChangeDir -> Rep ChangeDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChangeDir -> Rep ChangeDir x
from :: forall x. ChangeDir -> Rep ChangeDir x
$cto :: forall x. Rep ChangeDir x -> ChangeDir
to :: forall x. Rep ChangeDir x -> ChangeDir
Generic)

data EnvConfig =
  EnvConfig {
    EnvConfig -> PackagesConfig
packages :: PackagesConfig,
    EnvConfig -> EnvRunner
defaultEnv :: EnvRunner,
    EnvConfig -> Maybe PackageName
mainPackage :: Maybe PackageName
  }
  deriving stock (EnvConfig -> EnvConfig -> Bool
(EnvConfig -> EnvConfig -> Bool)
-> (EnvConfig -> EnvConfig -> Bool) -> Eq EnvConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnvConfig -> EnvConfig -> Bool
== :: EnvConfig -> EnvConfig -> Bool
$c/= :: EnvConfig -> EnvConfig -> Bool
/= :: EnvConfig -> EnvConfig -> Bool
Eq, Int -> EnvConfig -> ShowS
[EnvConfig] -> ShowS
EnvConfig -> String
(Int -> EnvConfig -> ShowS)
-> (EnvConfig -> String)
-> ([EnvConfig] -> ShowS)
-> Show EnvConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvConfig -> ShowS
showsPrec :: Int -> EnvConfig -> ShowS
$cshow :: EnvConfig -> String
show :: EnvConfig -> String
$cshowList :: [EnvConfig] -> ShowS
showList :: [EnvConfig] -> ShowS
Show, (forall x. EnvConfig -> Rep EnvConfig x)
-> (forall x. Rep EnvConfig x -> EnvConfig) -> Generic EnvConfig
forall x. Rep EnvConfig x -> EnvConfig
forall x. EnvConfig -> Rep EnvConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnvConfig -> Rep EnvConfig x
from :: forall x. EnvConfig -> Rep EnvConfig x
$cto :: forall x. Rep EnvConfig x -> EnvConfig
to :: forall x. Rep EnvConfig x -> EnvConfig
Generic)
  deriving anyclass (Value -> Parser [EnvConfig]
Value -> Parser EnvConfig
(Value -> Parser EnvConfig)
-> (Value -> Parser [EnvConfig]) -> FromJSON EnvConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser EnvConfig
parseJSON :: Value -> Parser EnvConfig
$cparseJSONList :: Value -> Parser [EnvConfig]
parseJSONList :: Value -> Parser [EnvConfig]
FromJSON)

data GhciConfig =
  GhciConfig {
    GhciConfig -> PackagesConfig
packages :: PackagesConfig,
    GhciConfig -> Maybe PackageName
mainPackage :: Maybe PackageName,
    GhciConfig -> Map RunnerName GhciSetupCode
setup :: Map RunnerName GhciSetupCode,
    GhciConfig -> Map RunnerName GhciRunExpr
run :: Map RunnerName GhciRunExpr,
    GhciConfig -> GhciArgs
args :: GhciArgs
  }
  deriving stock (GhciConfig -> GhciConfig -> Bool
(GhciConfig -> GhciConfig -> Bool)
-> (GhciConfig -> GhciConfig -> Bool) -> Eq GhciConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhciConfig -> GhciConfig -> Bool
== :: GhciConfig -> GhciConfig -> Bool
$c/= :: GhciConfig -> GhciConfig -> Bool
/= :: GhciConfig -> GhciConfig -> Bool
Eq, Int -> GhciConfig -> ShowS
[GhciConfig] -> ShowS
GhciConfig -> String
(Int -> GhciConfig -> ShowS)
-> (GhciConfig -> String)
-> ([GhciConfig] -> ShowS)
-> Show GhciConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhciConfig -> ShowS
showsPrec :: Int -> GhciConfig -> ShowS
$cshow :: GhciConfig -> String
show :: GhciConfig -> String
$cshowList :: [GhciConfig] -> ShowS
showList :: [GhciConfig] -> ShowS
Show, (forall x. GhciConfig -> Rep GhciConfig x)
-> (forall x. Rep GhciConfig x -> GhciConfig) -> Generic GhciConfig
forall x. Rep GhciConfig x -> GhciConfig
forall x. GhciConfig -> Rep GhciConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GhciConfig -> Rep GhciConfig x
from :: forall x. GhciConfig -> Rep GhciConfig x
$cto :: forall x. Rep GhciConfig x -> GhciConfig
to :: forall x. Rep GhciConfig x -> GhciConfig
Generic)
  deriving anyclass (Value -> Parser [GhciConfig]
Value -> Parser GhciConfig
(Value -> Parser GhciConfig)
-> (Value -> Parser [GhciConfig]) -> FromJSON GhciConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GhciConfig
parseJSON :: Value -> Parser GhciConfig
$cparseJSONList :: Value -> Parser [GhciConfig]
parseJSONList :: Value -> Parser [GhciConfig]
FromJSON)