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

-- | 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 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))

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