summaryrefslogtreecommitdiff
path: root/src/Network/KRPC/Method.hs
blob: 3a2bd020417a03fc85876b99e75a4508306b3c59 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
-- |
--   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

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