-- |
-- Module      : Data.Conduit.JsonRpc.Methods
-- Copyright   : (c) 2012-2013 Gabriele Sales <gbrsales@gmail.com>
--
-- JSON-RPC methods.

{-# LANGUAGE GADTs      #-}
{-# LANGUAGE RankNTypes #-}

module Data.Conduit.JsonRpc.Methods
  ( Method(..)
  , MethodError(..)

  , NamedMethod
  , method

  , Methods
  , fromList
  , lookup )
where

import           Data.Aeson
import qualified Data.HashMap.Strict as M
import           Data.Text           (Text)
import           Prelude             hiding (lookup)


{-|
A wrapper over a monadic function that can either succeed or fail with a
'MethodError'.

Hides the input and output types.
-}
data Method m where
  Method :: forall i m o. (FromJSON i, ToJSON o)
         => (i -> m (Either MethodError o)) -> Method m

-- | Represents an error with an integer code and a textual message.
data MethodError = MethodError !Int !Text
  deriving (MethodError -> MethodError -> Bool
(MethodError -> MethodError -> Bool)
-> (MethodError -> MethodError -> Bool) -> Eq MethodError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MethodError -> MethodError -> Bool
$c/= :: MethodError -> MethodError -> Bool
== :: MethodError -> MethodError -> Bool
$c== :: MethodError -> MethodError -> Bool
Eq, Int -> MethodError -> ShowS
[MethodError] -> ShowS
MethodError -> String
(Int -> MethodError -> ShowS)
-> (MethodError -> String)
-> ([MethodError] -> ShowS)
-> Show MethodError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MethodError] -> ShowS
$cshowList :: [MethodError] -> ShowS
show :: MethodError -> String
$cshow :: MethodError -> String
showsPrec :: Int -> MethodError -> ShowS
$cshowsPrec :: Int -> MethodError -> ShowS
Show)


-- | A 'Method' with a name.
newtype NamedMethod m = NamedMethod { NamedMethod m -> (Text, Method m)
unWrap :: (Text, Method m) }

{-|
Builds a 'NamedMethod' given its name and function.

Useful in conjuction with 'fromList'.
-}
method :: (FromJSON i, ToJSON o)
       => Text
       -> (i -> m (Either MethodError o))
       -> NamedMethod m
method :: Text -> (i -> m (Either MethodError o)) -> NamedMethod m
method Text
name i -> m (Either MethodError o)
f = (Text, Method m) -> NamedMethod m
forall (m :: * -> *). (Text, Method m) -> NamedMethod m
NamedMethod (Text
name, (i -> m (Either MethodError o)) -> Method m
forall i (m :: * -> *) o.
(FromJSON i, ToJSON o) =>
(i -> m (Either MethodError o)) -> Method m
Method i -> m (Either MethodError o)
f)

-- | Collection of 'NamedMethod's.
newtype Methods m = Methods (M.HashMap Text (Method m))

-- | Builds a collection from a list of 'NamedMethod's.
fromList :: [NamedMethod m] -> Methods m
fromList :: [NamedMethod m] -> Methods m
fromList = HashMap Text (Method m) -> Methods m
forall (m :: * -> *). HashMap Text (Method m) -> Methods m
Methods (HashMap Text (Method m) -> Methods m)
-> ([NamedMethod m] -> HashMap Text (Method m))
-> [NamedMethod m]
-> Methods m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Method m)] -> HashMap Text (Method m)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(Text, Method m)] -> HashMap Text (Method m))
-> ([NamedMethod m] -> [(Text, Method m)])
-> [NamedMethod m]
-> HashMap Text (Method m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedMethod m -> (Text, Method m))
-> [NamedMethod m] -> [(Text, Method m)]
forall a b. (a -> b) -> [a] -> [b]
map NamedMethod m -> (Text, Method m)
forall (m :: * -> *). NamedMethod m -> (Text, Method m)
unWrap

-- | Looks up the method corresponding to the given name.
lookup :: Methods m -> Text -> Maybe (Method m)
lookup :: Methods m -> Text -> Maybe (Method m)
lookup (Methods HashMap Text (Method m)
m) Text
name = Text -> HashMap Text (Method m) -> Maybe (Method m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
name HashMap Text (Method m)
m