{-# language DeriveFunctor #-}
{-# language DerivingStrategies #-}
{-# language KindSignatures #-}

module OkChannel
  ( M(..)
  , ReceiveException(..)
  , SendException
  , showsPrecReceiveException
  , showsPrecSendException
  , Resource
  , send
  , receive
  ) where

import Data.Bytes (Bytes)
import Data.Bytes.Chunks (Chunks(ChunksNil,ChunksCons))
import Data.Void (Void,absurd)

import qualified Data.Bytes as Bytes
import qualified Data.Bytes.Chunks as Chunks

type Resource = ()

data ReceiveException = ExpectedMoreInput
  deriving (Int -> ReceiveException -> ShowS
[ReceiveException] -> ShowS
ReceiveException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReceiveException] -> ShowS
$cshowList :: [ReceiveException] -> ShowS
show :: ReceiveException -> String
$cshow :: ReceiveException -> String
showsPrec :: Int -> ReceiveException -> ShowS
$cshowsPrec :: Int -> ReceiveException -> ShowS
Show)

showsPrecReceiveException :: Int -> ReceiveException -> String -> String
showsPrecReceiveException :: Int -> ReceiveException -> ShowS
showsPrecReceiveException = forall a. Show a => Int -> a -> ShowS
showsPrec

type SendException = Void

showsPrecSendException :: Int -> SendException -> String -> String
showsPrecSendException :: Int -> SendException -> ShowS
showsPrecSendException Int
_ SendException
x String
_ = forall a. SendException -> a
absurd SendException
x

-- First arg is input, second arg is output
-- The input is peeled off one byte sequence at a time by receive
-- We use this feature to feed input byte-by-byte to test streaming
-- features.
data M a = M (Chunks -> Bytes -> (Chunks,Bytes,a))
  deriving stock (forall a b. a -> M b -> M a
forall a b. (a -> b) -> M a -> M b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> M b -> M a
$c<$ :: forall a b. a -> M b -> M a
fmap :: forall a b. (a -> b) -> M a -> M b
$cfmap :: forall a b. (a -> b) -> M a -> M b
Functor)

bindM :: M a -> (a -> M b) -> M b
bindM :: forall a b. M a -> (a -> M b) -> M b
bindM (M Chunks -> Bytes -> (Chunks, Bytes, a)
f) a -> M b
g = forall a. (Chunks -> Bytes -> (Chunks, Bytes, a)) -> M a
M forall a b. (a -> b) -> a -> b
$ \Chunks
inbound0 Bytes
outbound0 ->
  case Chunks -> Bytes -> (Chunks, Bytes, a)
f Chunks
inbound0 Bytes
outbound0 of
    (Chunks
inbound1,Bytes
outbound1,a
a) ->
      case a -> M b
g a
a of
        M Chunks -> Bytes -> (Chunks, Bytes, b)
h -> Chunks -> Bytes -> (Chunks, Bytes, b)
h Chunks
inbound1 Bytes
outbound1

pureM :: a -> M a
pureM :: forall a. a -> M a
pureM a
a = forall a. (Chunks -> Bytes -> (Chunks, Bytes, a)) -> M a
M forall a b. (a -> b) -> a -> b
$ \Chunks
x Bytes
y -> (Chunks
x,Bytes
y,a
a)

instance Applicative M where
  pure :: forall a. a -> M a
pure = forall a. a -> M a
pureM
  M (a -> b)
f <*> :: forall a b. M (a -> b) -> M a -> M b
<*> M a
a = M (a -> b)
f forall a b. M a -> (a -> M b) -> M b
`bindM` \a -> b
f' -> M a
a forall a b. M a -> (a -> M b) -> M b
`bindM` \a
a' -> forall a. a -> M a
pureM (a -> b
f' a
a')

instance Monad M where
  >>= :: forall a b. M a -> (a -> M b) -> M b
(>>=) = forall a b. M a -> (a -> M b) -> M b
bindM

send ::
     ()
  -> Chunks
  -> M (Either SendException ())
send :: () -> Chunks -> M (Either SendException ())
send ()
_ Chunks
b = forall a. (Chunks -> Bytes -> (Chunks, Bytes, a)) -> M a
M forall a b. (a -> b) -> a -> b
$ \Chunks
inbound Bytes
outbound ->
  (Chunks
inbound,Bytes
outbound forall a. Semigroup a => a -> a -> a
<> Chunks -> Bytes
Chunks.concat Chunks
b,forall a b. b -> Either a b
Right ())

receive ::
     ()
  -> M (Either ReceiveException Bytes)
receive :: () -> M (Either ReceiveException Bytes)
receive ()
_ = forall a. (Chunks -> Bytes -> (Chunks, Bytes, a)) -> M a
M forall a b. (a -> b) -> a -> b
$ \Chunks
inbound0 Bytes
outbound ->
  let go :: Chunks -> (Chunks, Bytes, Either ReceiveException Bytes)
go Chunks
inbound = case Chunks
inbound of
        Chunks
ChunksNil -> (Chunks
inbound,Bytes
outbound,forall a b. a -> Either a b
Left ReceiveException
ExpectedMoreInput)
        ChunksCons Bytes
b Chunks
ch -> case Bytes -> Bool
Bytes.null Bytes
b of
          Bool
True -> Chunks -> (Chunks, Bytes, Either ReceiveException Bytes)
go Chunks
ch
          Bool
False -> (Chunks
ch,Bytes
outbound,forall a b. b -> Either a b
Right Bytes
b)
   in Chunks -> (Chunks, Bytes, Either ReceiveException Bytes)
go Chunks
inbound0