{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}

module Hercules.Agent.WorkerProtocol.WorkerConfig where

import Control.Monad.Fail (fail)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Hercules.CNix.Verbosity qualified
import Katip qualified
import Protolude

-- | Sets up the worker environment.
data WorkerConfig = WorkerConfig
  { -- | Verbosity
    WorkerConfig -> ViaShowRead Severity
verbosity :: !(ViaShowRead Katip.Severity),
    -- | Nix Verbosity
    WorkerConfig -> ViaShowRead Verbosity
nixVerbosity :: !(ViaShowRead Hercules.CNix.Verbosity.Verbosity),
    -- | Nix Options
    WorkerConfig -> [(Text, Text)]
nixOptions :: ![(Text, Text)]
  }
  deriving ((forall x. WorkerConfig -> Rep WorkerConfig x)
-> (forall x. Rep WorkerConfig x -> WorkerConfig)
-> Generic WorkerConfig
forall x. Rep WorkerConfig x -> WorkerConfig
forall x. WorkerConfig -> Rep WorkerConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WorkerConfig -> Rep WorkerConfig x
from :: forall x. WorkerConfig -> Rep WorkerConfig x
$cto :: forall x. Rep WorkerConfig x -> WorkerConfig
to :: forall x. Rep WorkerConfig x -> WorkerConfig
Generic, Int -> WorkerConfig -> ShowS
[WorkerConfig] -> ShowS
WorkerConfig -> String
(Int -> WorkerConfig -> ShowS)
-> (WorkerConfig -> String)
-> ([WorkerConfig] -> ShowS)
-> Show WorkerConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkerConfig -> ShowS
showsPrec :: Int -> WorkerConfig -> ShowS
$cshow :: WorkerConfig -> String
show :: WorkerConfig -> String
$cshowList :: [WorkerConfig] -> ShowS
showList :: [WorkerConfig] -> ShowS
Show)
  -- This uses JSON so that we can getLine and parse it in the worker before
  -- doing any command parsing. Maybe we don't need framing (a line) and we
  -- can switch to Binary?
  deriving anyclass ([WorkerConfig] -> Value
[WorkerConfig] -> Encoding
WorkerConfig -> Value
WorkerConfig -> Encoding
(WorkerConfig -> Value)
-> (WorkerConfig -> Encoding)
-> ([WorkerConfig] -> Value)
-> ([WorkerConfig] -> Encoding)
-> ToJSON WorkerConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: WorkerConfig -> Value
toJSON :: WorkerConfig -> Value
$ctoEncoding :: WorkerConfig -> Encoding
toEncoding :: WorkerConfig -> Encoding
$ctoJSONList :: [WorkerConfig] -> Value
toJSONList :: [WorkerConfig] -> Value
$ctoEncodingList :: [WorkerConfig] -> Encoding
toEncodingList :: [WorkerConfig] -> Encoding
ToJSON, Value -> Parser [WorkerConfig]
Value -> Parser WorkerConfig
(Value -> Parser WorkerConfig)
-> (Value -> Parser [WorkerConfig]) -> FromJSON WorkerConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser WorkerConfig
parseJSON :: Value -> Parser WorkerConfig
$cparseJSONList :: Value -> Parser [WorkerConfig]
parseJSONList :: Value -> Parser [WorkerConfig]
FromJSON)

newtype ViaShowRead a = ViaShowRead {forall a. ViaShowRead a -> a
unViaShowRead :: a}
  deriving newtype ((forall x. ViaShowRead a -> Rep (ViaShowRead a) x)
-> (forall x. Rep (ViaShowRead a) x -> ViaShowRead a)
-> Generic (ViaShowRead a)
forall a x. Generic a => Rep (ViaShowRead a) x -> ViaShowRead a
forall a x. Generic a => ViaShowRead a -> Rep (ViaShowRead a) x
forall x. Rep (ViaShowRead a) x -> ViaShowRead a
forall x. ViaShowRead a -> Rep (ViaShowRead a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall a x. Generic a => ViaShowRead a -> Rep (ViaShowRead a) x
from :: forall x. ViaShowRead a -> Rep (ViaShowRead a) x
$cto :: forall a x. Generic a => Rep (ViaShowRead a) x -> ViaShowRead a
to :: forall x. Rep (ViaShowRead a) x -> ViaShowRead a
Generic, Int -> ViaShowRead a -> ShowS
[ViaShowRead a] -> ShowS
ViaShowRead a -> String
(Int -> ViaShowRead a -> ShowS)
-> (ViaShowRead a -> String)
-> ([ViaShowRead a] -> ShowS)
-> Show (ViaShowRead a)
forall a. Show a => Int -> ViaShowRead a -> ShowS
forall a. Show a => [ViaShowRead a] -> ShowS
forall a. Show a => ViaShowRead a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ViaShowRead a -> ShowS
showsPrec :: Int -> ViaShowRead a -> ShowS
$cshow :: forall a. Show a => ViaShowRead a -> String
show :: ViaShowRead a -> String
$cshowList :: forall a. Show a => [ViaShowRead a] -> ShowS
showList :: [ViaShowRead a] -> ShowS
Show, ReadPrec [ViaShowRead a]
ReadPrec (ViaShowRead a)
Int -> ReadS (ViaShowRead a)
ReadS [ViaShowRead a]
(Int -> ReadS (ViaShowRead a))
-> ReadS [ViaShowRead a]
-> ReadPrec (ViaShowRead a)
-> ReadPrec [ViaShowRead a]
-> Read (ViaShowRead a)
forall a. Read a => ReadPrec [ViaShowRead a]
forall a. Read a => ReadPrec (ViaShowRead a)
forall a. Read a => Int -> ReadS (ViaShowRead a)
forall a. Read a => ReadS [ViaShowRead a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (ViaShowRead a)
readsPrec :: Int -> ReadS (ViaShowRead a)
$creadList :: forall a. Read a => ReadS [ViaShowRead a]
readList :: ReadS [ViaShowRead a]
$creadPrec :: forall a. Read a => ReadPrec (ViaShowRead a)
readPrec :: ReadPrec (ViaShowRead a)
$creadListPrec :: forall a. Read a => ReadPrec [ViaShowRead a]
readListPrec :: ReadPrec [ViaShowRead a]
Read, ViaShowRead a -> ViaShowRead a -> Bool
(ViaShowRead a -> ViaShowRead a -> Bool)
-> (ViaShowRead a -> ViaShowRead a -> Bool) -> Eq (ViaShowRead a)
forall a. Eq a => ViaShowRead a -> ViaShowRead a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ViaShowRead a -> ViaShowRead a -> Bool
== :: ViaShowRead a -> ViaShowRead a -> Bool
$c/= :: forall a. Eq a => ViaShowRead a -> ViaShowRead a -> Bool
/= :: ViaShowRead a -> ViaShowRead a -> Bool
Eq, Eq (ViaShowRead a)
Eq (ViaShowRead a)
-> (ViaShowRead a -> ViaShowRead a -> Ordering)
-> (ViaShowRead a -> ViaShowRead a -> Bool)
-> (ViaShowRead a -> ViaShowRead a -> Bool)
-> (ViaShowRead a -> ViaShowRead a -> Bool)
-> (ViaShowRead a -> ViaShowRead a -> Bool)
-> (ViaShowRead a -> ViaShowRead a -> ViaShowRead a)
-> (ViaShowRead a -> ViaShowRead a -> ViaShowRead a)
-> Ord (ViaShowRead a)
ViaShowRead a -> ViaShowRead a -> Bool
ViaShowRead a -> ViaShowRead a -> Ordering
ViaShowRead a -> ViaShowRead a -> ViaShowRead a
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
forall {a}. Ord a => Eq (ViaShowRead a)
forall a. Ord a => ViaShowRead a -> ViaShowRead a -> Bool
forall a. Ord a => ViaShowRead a -> ViaShowRead a -> Ordering
forall a. Ord a => ViaShowRead a -> ViaShowRead a -> ViaShowRead a
$ccompare :: forall a. Ord a => ViaShowRead a -> ViaShowRead a -> Ordering
compare :: ViaShowRead a -> ViaShowRead a -> Ordering
$c< :: forall a. Ord a => ViaShowRead a -> ViaShowRead a -> Bool
< :: ViaShowRead a -> ViaShowRead a -> Bool
$c<= :: forall a. Ord a => ViaShowRead a -> ViaShowRead a -> Bool
<= :: ViaShowRead a -> ViaShowRead a -> Bool
$c> :: forall a. Ord a => ViaShowRead a -> ViaShowRead a -> Bool
> :: ViaShowRead a -> ViaShowRead a -> Bool
$c>= :: forall a. Ord a => ViaShowRead a -> ViaShowRead a -> Bool
>= :: ViaShowRead a -> ViaShowRead a -> Bool
$cmax :: forall a. Ord a => ViaShowRead a -> ViaShowRead a -> ViaShowRead a
max :: ViaShowRead a -> ViaShowRead a -> ViaShowRead a
$cmin :: forall a. Ord a => ViaShowRead a -> ViaShowRead a -> ViaShowRead a
min :: ViaShowRead a -> ViaShowRead a -> ViaShowRead a
Ord)

instance (Show a) => ToJSON (ViaShowRead a) where
  toJSON :: ViaShowRead a -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON @[Char] (String -> Value)
-> (ViaShowRead a -> String) -> ViaShowRead a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a b. (Show a, StringConv String b) => a -> b
show (a -> String) -> (ViaShowRead a -> a) -> ViaShowRead a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViaShowRead a -> a
forall a. ViaShowRead a -> a
unViaShowRead

instance (Read a) => FromJSON (ViaShowRead a) where
  parseJSON :: Value -> Parser (ViaShowRead a)
parseJSON Value
v = do
    String
s <- forall a. FromJSON a => Value -> Parser a
parseJSON @[Char] Value
v
    case String -> Maybe a
forall b a. (Read b, StringConv a String) => a -> Maybe b
readMaybe String
s of
      Maybe a
Nothing -> String -> Parser (ViaShowRead a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (ViaShowRead a))
-> String -> Parser (ViaShowRead a)
forall a b. (a -> b) -> a -> b
$ String
"Could not parse " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a b. (Show a, StringConv String b) => a -> b
show String
s
      Just a
a -> ViaShowRead a -> Parser (ViaShowRead a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ViaShowRead a -> Parser (ViaShowRead a))
-> ViaShowRead a -> Parser (ViaShowRead a)
forall a b. (a -> b) -> a -> b
$ a -> ViaShowRead a
forall a. a -> ViaShowRead a
ViaShowRead a
a