-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- The type of commands sent from Web API handlers to the Controller,
-- and the type of replies.
module Swarm.TUI.Model.WebCommand (
  WebCommand (..),
  WebInvocationState (..),
  RejectionReason (..),
) where

import Data.Aeson (FromJSON (..), ToJSON (..), genericParseJSON, genericToJSON)
import Data.Text (Text)
import GHC.Generics (Generic)
import Swarm.Util.JSON (optionsMinimize)

data WebCommand = RunWebCode {WebCommand -> Text
webEntry :: Text, WebCommand -> WebInvocationState -> IO ()
webReply :: WebInvocationState -> IO ()}

data RejectionReason = NoActiveGame | AlreadyRunning | ParseError String
  deriving (RejectionReason -> RejectionReason -> Bool
(RejectionReason -> RejectionReason -> Bool)
-> (RejectionReason -> RejectionReason -> Bool)
-> Eq RejectionReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RejectionReason -> RejectionReason -> Bool
== :: RejectionReason -> RejectionReason -> Bool
$c/= :: RejectionReason -> RejectionReason -> Bool
/= :: RejectionReason -> RejectionReason -> Bool
Eq, Eq RejectionReason
Eq RejectionReason =>
(RejectionReason -> RejectionReason -> Ordering)
-> (RejectionReason -> RejectionReason -> Bool)
-> (RejectionReason -> RejectionReason -> Bool)
-> (RejectionReason -> RejectionReason -> Bool)
-> (RejectionReason -> RejectionReason -> Bool)
-> (RejectionReason -> RejectionReason -> RejectionReason)
-> (RejectionReason -> RejectionReason -> RejectionReason)
-> Ord RejectionReason
RejectionReason -> RejectionReason -> Bool
RejectionReason -> RejectionReason -> Ordering
RejectionReason -> RejectionReason -> RejectionReason
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 :: RejectionReason -> RejectionReason -> Ordering
compare :: RejectionReason -> RejectionReason -> Ordering
$c< :: RejectionReason -> RejectionReason -> Bool
< :: RejectionReason -> RejectionReason -> Bool
$c<= :: RejectionReason -> RejectionReason -> Bool
<= :: RejectionReason -> RejectionReason -> Bool
$c> :: RejectionReason -> RejectionReason -> Bool
> :: RejectionReason -> RejectionReason -> Bool
$c>= :: RejectionReason -> RejectionReason -> Bool
>= :: RejectionReason -> RejectionReason -> Bool
$cmax :: RejectionReason -> RejectionReason -> RejectionReason
max :: RejectionReason -> RejectionReason -> RejectionReason
$cmin :: RejectionReason -> RejectionReason -> RejectionReason
min :: RejectionReason -> RejectionReason -> RejectionReason
Ord, Int -> RejectionReason -> ShowS
[RejectionReason] -> ShowS
RejectionReason -> String
(Int -> RejectionReason -> ShowS)
-> (RejectionReason -> String)
-> ([RejectionReason] -> ShowS)
-> Show RejectionReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RejectionReason -> ShowS
showsPrec :: Int -> RejectionReason -> ShowS
$cshow :: RejectionReason -> String
show :: RejectionReason -> String
$cshowList :: [RejectionReason] -> ShowS
showList :: [RejectionReason] -> ShowS
Show, (forall x. RejectionReason -> Rep RejectionReason x)
-> (forall x. Rep RejectionReason x -> RejectionReason)
-> Generic RejectionReason
forall x. Rep RejectionReason x -> RejectionReason
forall x. RejectionReason -> Rep RejectionReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RejectionReason -> Rep RejectionReason x
from :: forall x. RejectionReason -> Rep RejectionReason x
$cto :: forall x. Rep RejectionReason x -> RejectionReason
to :: forall x. Rep RejectionReason x -> RejectionReason
Generic)

data WebInvocationState = Rejected RejectionReason | InProgress | Complete String
  deriving (WebInvocationState -> WebInvocationState -> Bool
(WebInvocationState -> WebInvocationState -> Bool)
-> (WebInvocationState -> WebInvocationState -> Bool)
-> Eq WebInvocationState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WebInvocationState -> WebInvocationState -> Bool
== :: WebInvocationState -> WebInvocationState -> Bool
$c/= :: WebInvocationState -> WebInvocationState -> Bool
/= :: WebInvocationState -> WebInvocationState -> Bool
Eq, Eq WebInvocationState
Eq WebInvocationState =>
(WebInvocationState -> WebInvocationState -> Ordering)
-> (WebInvocationState -> WebInvocationState -> Bool)
-> (WebInvocationState -> WebInvocationState -> Bool)
-> (WebInvocationState -> WebInvocationState -> Bool)
-> (WebInvocationState -> WebInvocationState -> Bool)
-> (WebInvocationState -> WebInvocationState -> WebInvocationState)
-> (WebInvocationState -> WebInvocationState -> WebInvocationState)
-> Ord WebInvocationState
WebInvocationState -> WebInvocationState -> Bool
WebInvocationState -> WebInvocationState -> Ordering
WebInvocationState -> WebInvocationState -> WebInvocationState
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 :: WebInvocationState -> WebInvocationState -> Ordering
compare :: WebInvocationState -> WebInvocationState -> Ordering
$c< :: WebInvocationState -> WebInvocationState -> Bool
< :: WebInvocationState -> WebInvocationState -> Bool
$c<= :: WebInvocationState -> WebInvocationState -> Bool
<= :: WebInvocationState -> WebInvocationState -> Bool
$c> :: WebInvocationState -> WebInvocationState -> Bool
> :: WebInvocationState -> WebInvocationState -> Bool
$c>= :: WebInvocationState -> WebInvocationState -> Bool
>= :: WebInvocationState -> WebInvocationState -> Bool
$cmax :: WebInvocationState -> WebInvocationState -> WebInvocationState
max :: WebInvocationState -> WebInvocationState -> WebInvocationState
$cmin :: WebInvocationState -> WebInvocationState -> WebInvocationState
min :: WebInvocationState -> WebInvocationState -> WebInvocationState
Ord, Int -> WebInvocationState -> ShowS
[WebInvocationState] -> ShowS
WebInvocationState -> String
(Int -> WebInvocationState -> ShowS)
-> (WebInvocationState -> String)
-> ([WebInvocationState] -> ShowS)
-> Show WebInvocationState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WebInvocationState -> ShowS
showsPrec :: Int -> WebInvocationState -> ShowS
$cshow :: WebInvocationState -> String
show :: WebInvocationState -> String
$cshowList :: [WebInvocationState] -> ShowS
showList :: [WebInvocationState] -> ShowS
Show, (forall x. WebInvocationState -> Rep WebInvocationState x)
-> (forall x. Rep WebInvocationState x -> WebInvocationState)
-> Generic WebInvocationState
forall x. Rep WebInvocationState x -> WebInvocationState
forall x. WebInvocationState -> Rep WebInvocationState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WebInvocationState -> Rep WebInvocationState x
from :: forall x. WebInvocationState -> Rep WebInvocationState x
$cto :: forall x. Rep WebInvocationState x -> WebInvocationState
to :: forall x. Rep WebInvocationState x -> WebInvocationState
Generic)

-- --------------------------
-- ToJSON/FromJSON Instances
-- --------------------------

instance ToJSON RejectionReason where
  toJSON :: RejectionReason -> Value
toJSON = Options -> RejectionReason -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
optionsMinimize

instance FromJSON RejectionReason where
  parseJSON :: Value -> Parser RejectionReason
parseJSON = Options -> Value -> Parser RejectionReason
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
optionsMinimize

instance ToJSON WebInvocationState where
  toJSON :: WebInvocationState -> Value
toJSON = Options -> WebInvocationState -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
optionsMinimize

instance FromJSON WebInvocationState where
  parseJSON :: Value -> Parser WebInvocationState
parseJSON = Options -> Value -> Parser WebInvocationState
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
optionsMinimize