{-# LANGUAGE KindSignatures #-}

{-|
Module      : Network.N2O.Types
Description : Basic types
Copyright   : (c) Marat Khafizov, 2018
License     : BSD-3
Maintainer  : xafizoff@gmail.com
Stability   : experimental
Portability : not portable

Basic types

-}
module Network.N2O.Types where

import qualified Data.Binary as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Data.IORef
import Data.Map.Strict (Map, (!?), insert)
import qualified Data.Text.Lazy as TL

-- | An HTTP header

type Header = (BS.ByteString, BS.ByteString)

-- | An HTTP request

data Req = Req
  { Req -> ByteString
reqPath :: BS.ByteString
  , Req -> ByteString
reqMeth :: BS.ByteString
  , Req -> ByteString
reqVers :: BS.ByteString
  , Req -> [Header]
reqHead :: [Header]
  }

-- | The N2O context data type

-- This is the key data type of the N2O. @(f :: * -> *)@ - type constructor

-- for the protocol handler's input type. @(a :: *)@ - base type for the

-- event handler's input type. I.e. @(f a)@ gives input type for the

-- protocol handler. @(Event a)@ gives input type for the event handler.

data Context (f :: * -> *) a = Context
  { Context f a -> Event a -> N2O f a (Result a)
cxHandler :: Event a -> N2O f a (Result a)
  , Context f a -> Req
cxReq :: Req
  , Context f a -> [Context f a -> Context f a]
cxMiddleware :: [Context f a -> Context f a]
  , Context f a -> [Proto f a]
cxProtos :: [Proto f a]
  , Context f a -> ByteString -> Maybe a
cxDePickle :: BL.ByteString -> Maybe a
  , Context f a -> a -> ByteString
cxPickle :: a -> BL.ByteString
  , Context f a -> Map ByteString ByteString
cxState :: Map BS.ByteString BL.ByteString
  }

-- | Result of the message processing

data Result a
  = Reply a
  | Ok
  | Unknown
  | Empty
  deriving (Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result a] -> ShowS
$cshowList :: forall a. Show a => [Result a] -> ShowS
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
Show, Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c== :: forall a. Eq a => Result a -> Result a -> Bool
Eq)

-- | N2O protocol handler

newtype Proto f a = Proto
  { Proto f a -> f a -> N2O f a (Result (f a))
protoInfo :: f a -> N2O f a (Result (f a))
  }

-- | Event data type

data Event a
  = Init
  | Message a
  | Terminate

-- | Local mutable state

type State f a = IORef (Context f a)

-- | 'N2OT' over 'IO' with 'N2OState' as env

type N2O f a = N2OT (State f a) IO

-- | Reader monad transformer

newtype N2OT state m a = N2OT
  { N2OT state m a -> state -> m a
runN2O :: state -> m a
  }

instance Functor m => Functor (N2OT state m) where
  fmap :: (a -> b) -> N2OT state m a -> N2OT state m b
fmap a -> b
f (N2OT state -> m a
g) = (state -> m b) -> N2OT state m b
forall state (m :: * -> *) a. (state -> m a) -> N2OT state m a
N2OT ((a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> (state -> m a) -> state -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. state -> m a
g)

instance Applicative m => Applicative (N2OT state m) where
  pure :: a -> N2OT state m a
pure = (state -> m a) -> N2OT state m a
forall state (m :: * -> *) a. (state -> m a) -> N2OT state m a
N2OT ((state -> m a) -> N2OT state m a)
-> (a -> state -> m a) -> a -> N2OT state m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> state -> m a
forall a b. a -> b -> a
const (m a -> state -> m a) -> (a -> m a) -> a -> state -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  (N2OT state -> m (a -> b)
f) <*> :: N2OT state m (a -> b) -> N2OT state m a -> N2OT state m b
<*> (N2OT state -> m a
g) = (state -> m b) -> N2OT state m b
forall state (m :: * -> *) a. (state -> m a) -> N2OT state m a
N2OT ((state -> m b) -> N2OT state m b)
-> (state -> m b) -> N2OT state m b
forall a b. (a -> b) -> a -> b
$ \state
state -> state -> m (a -> b)
f state
state m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> state -> m a
g state
state

instance Monad m => Monad (N2OT state m) where
  N2OT state m a
m >>= :: N2OT state m a -> (a -> N2OT state m b) -> N2OT state m b
>>= a -> N2OT state m b
k =
    (state -> m b) -> N2OT state m b
forall state (m :: * -> *) a. (state -> m a) -> N2OT state m a
N2OT ((state -> m b) -> N2OT state m b)
-> (state -> m b) -> N2OT state m b
forall a b. (a -> b) -> a -> b
$ \state
state -> do
      a
a <- N2OT state m a -> state -> m a
forall state (m :: * -> *) a. N2OT state m a -> state -> m a
runN2O N2OT state m a
m state
state
      N2OT state m b -> state -> m b
forall state (m :: * -> *) a. N2OT state m a -> state -> m a
runN2O (a -> N2OT state m b
k a
a) state
state