-- | -- Copyright : (c) Sam Truzjan 2013, 2014 -- License : BSD3 -- Maintainer : pxqr.sta@gmail.com -- Stability : experimental -- Portability : portable -- -- Normally, you don't need to import this module. -- {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FunctionalDependencies #-} module Network.KRPC.Method ( Method (..) , KRPC (..) ) where #ifdef VERSION_bencoding import Data.BEncode (BEncode) #else import Data.Serialize #endif import Data.ByteString.Char8 as BC import Data.Char import Data.Monoid import Data.List as L import Data.String import Data.Typeable import Network.DatagramServer.Mainline -- | Method datatype used to describe method name, parameters and -- return values of procedure. Client use a method to /invoke/, server -- /implements/ the method to make the actual work. -- -- We use the following fantom types to ensure type-safiety: -- -- * param: Type of method parameters. -- -- * result: Type of return value of the method. -- newtype Method param result = Method { methodName :: MethodName } deriving ( Eq, Ord #ifdef VERSION_bencoding , IsString , BEncode #endif ) -- | Example: -- -- @show (Method \"concat\" :: [Int] Int) == \"concat :: [Int] -> Int\"@ -- instance (Typeable a, Typeable b) => Show (Method a b) where showsPrec _ = showsMethod showsMethod :: forall a b. ( Typeable a , Typeable b ) => Method a b -> ShowS showsMethod (Method name) = #ifdef VERSION_bencoding showString (BC.unpack name) <> #else shows (show name) <> #endif showString " :: " <> shows paramsTy <> showString " -> " <> shows valuesTy where impossible = error "KRPC.showsMethod: impossible" paramsTy = typeOf (impossible :: a) valuesTy = typeOf (impossible :: b) -- | In order to perform or handle KRPC query you need to provide -- corresponding 'KRPC' class. -- -- Example: -- -- @ -- data Ping = Ping Text deriving BEncode -- data Pong = Pong Text deriving BEncode -- -- instance 'KRPC' Ping Pong where -- method = \"ping\" -- @ -- class ( Typeable req, Typeable resp #ifdef VERSION_bencoding , BEncode req, BEncode resp #else , Serialize req, Serialize resp #endif ) => KRPC req resp | req -> resp, resp -> req where type Envelope req resp -- | Method name. Default implementation uses lowercased @req@ -- datatype name. -- method :: Method req resp #ifdef VERSION_bencoding -- TODO add underscores default method :: Typeable req => Method req resp method = Method $ fromString $ L.map toLower $ show $ typeOf hole where hole = error "krpc.method: impossible" :: req #endif unseal :: Envelope req resp -> Either String req seal :: resp -> Envelope req resp