module Periodic.Server.Types
  ( Command (..)
  , ClientConfig (..)
  , CSEnv
  , ServerCommand (..)
  ) where
import           Data.Binary                  (Binary (..), getWord8)
import           Data.Binary.Get              (lookAhead)
import           Periodic.IOList              (IOList)
import           Periodic.Node                (SessionEnv1)
import qualified Periodic.Types.ClientCommand as CC
import           Periodic.Types.Job           (FuncName, JobHandle)
import           Periodic.Types.ServerCommand (ServerCommand (..))
import qualified Periodic.Types.WorkerCommand as WC

data Command = CC CC.ClientCommand
    | WC WC.WorkerCommand

instance Binary Command where
  get :: Get Command
get = do
    Word8
cmd <- Get Word8 -> Get Word8
forall a. Get a -> Get a
lookAhead Get Word8
getWord8
    case Word8
cmd of
      1  -> WorkerCommand -> Command
WC (WorkerCommand -> Command) -> Get WorkerCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get WorkerCommand
forall t. Binary t => Get t
get
      2  -> WorkerCommand -> Command
WC (WorkerCommand -> Command) -> Get WorkerCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get WorkerCommand
forall t. Binary t => Get t
get
      3  -> WorkerCommand -> Command
WC (WorkerCommand -> Command) -> Get WorkerCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get WorkerCommand
forall t. Binary t => Get t
get
      4  -> WorkerCommand -> Command
WC (WorkerCommand -> Command) -> Get WorkerCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get WorkerCommand
forall t. Binary t => Get t
get
      11 -> WorkerCommand -> Command
WC (WorkerCommand -> Command) -> Get WorkerCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get WorkerCommand
forall t. Binary t => Get t
get
      -- 9  -> WC <$> get
      7  -> WorkerCommand -> Command
WC (WorkerCommand -> Command) -> Get WorkerCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get WorkerCommand
forall t. Binary t => Get t
get
      8  -> WorkerCommand -> Command
WC (WorkerCommand -> Command) -> Get WorkerCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get WorkerCommand
forall t. Binary t => Get t
get
      21 -> WorkerCommand -> Command
WC (WorkerCommand -> Command) -> Get WorkerCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get WorkerCommand
forall t. Binary t => Get t
get
      27 -> WorkerCommand -> Command
WC (WorkerCommand -> Command) -> Get WorkerCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get WorkerCommand
forall t. Binary t => Get t
get
      28 -> WorkerCommand -> Command
WC (WorkerCommand -> Command) -> Get WorkerCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get WorkerCommand
forall t. Binary t => Get t
get
      13 -> ClientCommand -> Command
CC (ClientCommand -> Command) -> Get ClientCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClientCommand
forall t. Binary t => Get t
get
      14 -> ClientCommand -> Command
CC (ClientCommand -> Command) -> Get ClientCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClientCommand
forall t. Binary t => Get t
get
      9  -> ClientCommand -> Command
CC (ClientCommand -> Command) -> Get ClientCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClientCommand
forall t. Binary t => Get t
get
      15 -> ClientCommand -> Command
CC (ClientCommand -> Command) -> Get ClientCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClientCommand
forall t. Binary t => Get t
get
      17 -> ClientCommand -> Command
CC (ClientCommand -> Command) -> Get ClientCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClientCommand
forall t. Binary t => Get t
get
      20 -> ClientCommand -> Command
CC (ClientCommand -> Command) -> Get ClientCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClientCommand
forall t. Binary t => Get t
get
      22 -> ClientCommand -> Command
CC (ClientCommand -> Command) -> Get ClientCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClientCommand
forall t. Binary t => Get t
get
      23 -> ClientCommand -> Command
CC (ClientCommand -> Command) -> Get ClientCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClientCommand
forall t. Binary t => Get t
get
      18 -> ClientCommand -> Command
CC (ClientCommand -> Command) -> Get ClientCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClientCommand
forall t. Binary t => Get t
get
      19 -> ClientCommand -> Command
CC (ClientCommand -> Command) -> Get ClientCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClientCommand
forall t. Binary t => Get t
get
      25 -> ClientCommand -> Command
CC (ClientCommand -> Command) -> Get ClientCommand -> Get Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClientCommand
forall t. Binary t => Get t
get
      _  -> [Char] -> Get Command
forall a. HasCallStack => [Char] -> a
error ([Char] -> Get Command) -> [Char] -> Get Command
forall a b. (a -> b) -> a -> b
$ "Error Command" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
cmd

  put :: Command -> Put
put (CC cmd :: ClientCommand
cmd) = ClientCommand -> Put
forall t. Binary t => t -> Put
put ClientCommand
cmd
  put (WC cmd :: WorkerCommand
cmd) = WorkerCommand -> Put
forall t. Binary t => t -> Put
put WorkerCommand
cmd

data ClientConfig = ClientConfig
    { ClientConfig -> IOList FuncName
wFuncList :: IOList FuncName
    , ClientConfig -> IOList JobHandle
wJobQueue :: IOList JobHandle
    }

type CSEnv = SessionEnv1 ClientConfig Command