{-# 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

-- | A raw service, operating on bytes
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 forall a. CandidArg a => ByteString -> Either String a
decode ByteString
b of
    Left String
err -> forall a. String -> m a
onErr String
err
    Right a
x -> forall a. CandidArg a => a -> ByteString
encode 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 (forall a. CandidArg a => a -> ByteString
encode a
x)
    case forall a. CandidArg a => ByteString -> Either String a
decode ByteString
b of
      Left String
err -> forall a. String -> m a
onErr String
err
      Right b
y -> forall (m :: * -> *) a. Monad m => a -> m a
return b
y

-- | A Candid service. The @r@ describes the type of a 'Rec'.
type CandidService m r = (Forall r (CandidMethod m), AllUniqueLabels r)

-- | Turns a raw service (function operating on bytes) into a typed Candid service (a record of typed methods). The raw service is typically code that talks over the network.
toCandidService ::
  forall m r.
  CandidService m r =>
   -- | What to do if the raw service returns unparsable data
  (forall a. String -> m a) ->
  RawService m ->
  Rec r
toCandidService :: forall (m :: * -> *) (r :: Row (*)).
CandidService m r =>
(forall a. String -> m a) -> RawService m -> Rec r
toCandidService forall a. String -> m a
onErr RawService m
f = forall (c :: * -> Constraint) (ρ :: Row (*)).
(Forall ρ c, AllUniqueLabels ρ) =>
(forall (l :: Symbol) a. (KnownSymbol l, c a) => Label l -> a)
-> Rec ρ
fromLabels @(CandidMethod m) forall a b. (a -> b) -> a -> b
$ \Label l
l ->
  forall (m :: * -> *) f.
CandidMethod m f =>
(forall a. String -> m a) -> RawMethod m -> f
toMeth forall a. String -> m a
onErr (RawService m
f (forall (s :: Symbol). KnownSymbol s => Label s -> Text
toKey Label l
l))

-- | Turns a typed candid service into a raw service. Typically used in a framework warpping Candid services.
fromCandidService ::
  forall m r.
  CandidService m r =>
  -- | What to do if the method name does not exist
  (forall a. T.Text -> m a) ->
  -- | What to do when the caller provides unparsable data
  (forall a. String -> m a) ->
  Rec r ->
  RawService m
fromCandidService :: forall (m :: * -> *) (r :: Row (*)).
CandidService m r =>
(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 forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
meth HashMap Text (ByteString -> m ByteString)
m of
      Just ByteString -> m ByteString
f -> ByteString -> m ByteString
f ByteString
a
      Maybe (ByteString -> m ByteString)
Nothing -> forall a. Text -> m a
notFound Text
meth
  where
    m :: H.HashMap T.Text (RawMethod m)
    m :: HashMap Text (ByteString -> m ByteString)
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 (m :: * -> *) f.
CandidMethod m f =>
(forall a. String -> m a) -> f -> RawMethod m
fromMeth forall a. String -> m a
onErr) Rec r
r