module Ribosome.Plugin.Mapping where

import Data.MessagePack (Object(ObjectString, ObjectNil))

import Ribosome.Data.Mapping (MappingError(InvalidArgs, NoSuchMapping), MappingIdent(MappingIdent))

data MappingHandler m =
  MappingHandler {
    MappingHandler m -> MappingIdent
mhMapping :: MappingIdent,
    MappingHandler m -> m ()
mhHandler :: m ()
  }

mappingHandler :: Text -> m () -> MappingHandler m
mappingHandler :: Text -> m () -> MappingHandler m
mappingHandler Text
ident =
  MappingIdent -> m () -> MappingHandler m
forall (m :: * -> *). MappingIdent -> m () -> MappingHandler m
MappingHandler (Text -> MappingIdent
MappingIdent Text
ident)

mapping :: MappingIdent -> [MappingHandler m] -> Maybe (MappingHandler m)
mapping :: MappingIdent -> [MappingHandler m] -> Maybe (MappingHandler m)
mapping MappingIdent
ident =
  (MappingHandler m -> Bool)
-> [MappingHandler m] -> Maybe (MappingHandler m)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((MappingIdent
ident MappingIdent -> MappingIdent -> Bool
forall a. Eq a => a -> a -> Bool
==) (MappingIdent -> Bool)
-> (MappingHandler m -> MappingIdent) -> MappingHandler m -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MappingHandler m -> MappingIdent
forall (m :: * -> *). MappingHandler m -> MappingIdent
mhMapping)

noSuchMapping :: MonadDeepError e MappingError m => MappingIdent -> m a
noSuchMapping :: MappingIdent -> m a
noSuchMapping =
  MappingError -> m a
forall e e' (m :: * -> *) a. MonadDeepError e e' m => e' -> m a
throwHoist (MappingError -> m a)
-> (MappingIdent -> MappingError) -> MappingIdent -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MappingIdent -> MappingError
NoSuchMapping

executeMapping :: MappingHandler m -> m ()
executeMapping :: MappingHandler m -> m ()
executeMapping (MappingHandler MappingIdent
_ m ()
f) =
  m ()
f

handleMappingRequest :: MonadDeepError e MappingError m => [MappingHandler m] -> [Object] -> m Object
handleMappingRequest :: [MappingHandler m] -> [Object] -> m Object
handleMappingRequest [MappingHandler m]
mappings [ObjectString s] =
  Object
ObjectNil Object -> m () -> m Object
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
-> (MappingHandler m -> m ()) -> Maybe (MappingHandler m) -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MappingIdent -> m ()
forall e (m :: * -> *) a.
MonadDeepError e MappingError m =>
MappingIdent -> m a
noSuchMapping MappingIdent
ident) MappingHandler m -> m ()
forall (m :: * -> *). MappingHandler m -> m ()
executeMapping (MappingIdent -> [MappingHandler m] -> Maybe (MappingHandler m)
forall (m :: * -> *).
MappingIdent -> [MappingHandler m] -> Maybe (MappingHandler m)
mapping MappingIdent
ident [MappingHandler m]
mappings)
  where
    ident :: MappingIdent
ident = Text -> MappingIdent
MappingIdent (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
s)
handleMappingRequest [MappingHandler m]
_ [Object]
args =
  MappingError -> m Object
forall e e' (m :: * -> *) a. MonadDeepError e e' m => e' -> m a
throwHoist ([Object] -> MappingError
InvalidArgs [Object]
args)