{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ConstraintKinds #-}
module Codec.Candid.Service where
import qualified Data.Text as T
import qualified Data.HashMap.Strict as H
import qualified Data.ByteString.Lazy as BS
import Data.Row
import Data.Row.Records
import Data.Row.Internal
import Data.Kind
import Codec.Candid.Class
type RawService m = T.Text -> BS.ByteString -> m BS.ByteString
type RawMethod m = BS.ByteString -> m BS.ByteString
class CandidMethod (m :: Type -> Type) f | f -> m where
fromMeth :: (forall a. String -> m a) -> f -> RawMethod m
toMeth :: (forall a. String -> m a) -> RawMethod m -> f
instance (CandidArg a, CandidArg b, Monad m) => CandidMethod m (a -> m b) where
fromMeth :: (forall a. String -> m a) -> (a -> m b) -> RawMethod m
fromMeth forall a. String -> m a
onErr a -> m b
m ByteString
b = case ByteString -> Either String a
forall a. CandidArg a => ByteString -> Either String a
decode ByteString
b of
Left String
err -> String -> m ByteString
forall a. String -> m a
onErr String
err
Right a
x -> b -> ByteString
forall a. CandidArg a => a -> ByteString
encode (b -> ByteString) -> m b -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
m a
x
toMeth :: (forall a. String -> m a) -> RawMethod m -> a -> m b
toMeth forall a. String -> m a
onErr RawMethod m
f a
x = do
ByteString
b <- RawMethod m
f (a -> ByteString
forall a. CandidArg a => a -> ByteString
encode a
x)
case ByteString -> Either String b
forall a. CandidArg a => ByteString -> Either String a
decode ByteString
b of
Left String
err -> String -> m b
forall a. String -> m a
onErr String
err
Right b
y -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
y
type CandidService m r = (Forall r (CandidMethod m), AllUniqueLabels r)
toCandidService ::
forall m r.
CandidService m r =>
(forall a. String -> m a) ->
RawService m ->
Rec r
toCandidService :: (forall a. String -> m a) -> RawService m -> Rec r
toCandidService forall a. String -> m a
onErr RawService m
f = forall (ρ :: Row *).
(Forall ρ (CandidMethod m), AllUniqueLabels ρ) =>
(forall (l :: Symbol) a.
(KnownSymbol l, CandidMethod m a) =>
Label l -> a)
-> Rec ρ
forall (c :: * -> Constraint) (ρ :: Row *).
(Forall ρ c, AllUniqueLabels ρ) =>
(forall (l :: Symbol) a. (KnownSymbol l, c a) => Label l -> a)
-> Rec ρ
fromLabels @(CandidMethod m) ((forall (l :: Symbol) a.
(KnownSymbol l, CandidMethod m a) =>
Label l -> a)
-> Rec r)
-> (forall (l :: Symbol) a.
(KnownSymbol l, CandidMethod m a) =>
Label l -> a)
-> Rec r
forall a b. (a -> b) -> a -> b
$ \Label l
l ->
(forall a. String -> m a) -> RawMethod m -> a
forall (m :: * -> *) f.
CandidMethod m f =>
(forall a. String -> m a) -> RawMethod m -> f
toMeth forall a. String -> m a
onErr (RawService m
f (Label l -> Text
forall (s :: Symbol). KnownSymbol s => Label s -> Text
toKey Label l
l))
fromCandidService ::
forall m r.
CandidService m r =>
(forall a. T.Text -> m a) ->
(forall a. String -> m a) ->
Rec r ->
RawService m
fromCandidService :: (forall a. Text -> m a)
-> (forall a. String -> m a) -> Rec r -> RawService m
fromCandidService forall a. Text -> m a
notFound forall a. String -> m a
onErr Rec r
r =
\Text
meth ByteString
a -> case Text -> HashMap Text (RawMethod m) -> Maybe (RawMethod m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
meth HashMap Text (RawMethod m)
m of
Just RawMethod m
f -> RawMethod m
f ByteString
a
Maybe (RawMethod m)
Nothing -> Text -> m ByteString
forall a. Text -> m a
notFound Text
meth
where
m :: H.HashMap T.Text (RawMethod m)
m :: HashMap Text (RawMethod m)
m = (forall a. CandidMethod m a => a -> RawMethod m)
-> Rec r -> HashMap Text (RawMethod m)
forall (c :: * -> Constraint) (r :: Row *) s b.
(IsString s, Eq s, Hashable s, Forall r c) =>
(forall a. c a => a -> b) -> Rec r -> HashMap s b
eraseToHashMap @(CandidMethod m) ((forall a. String -> m a) -> a -> RawMethod m
forall (m :: * -> *) f.
CandidMethod m f =>
(forall a. String -> m a) -> f -> RawMethod m
fromMeth forall a. String -> m a
onErr) Rec r
r