~ Separate method implementation.

This will break everything for now.

2 files changed, 45 insertions, 41 deletions

diff --git a/src/Remote/KRPC.hs b/src/Remote/KRPC.hs
index a6318ccd..8f2027f2 100644
--- a/src/Remote/KRPC.hs
+++ b/src/Remote/KRPC.hs
@@ -17,7 +17,7 @@ module Remote.KRPC
        , call, async, await
 
          -- * Server
-       , handler, server
+       , server
        ) where
 
 import Control.Exception
@@ -46,14 +46,14 @@ type RemoteAddr = KRemoteAddr
 
 queryCall :: BEncodable param
           => KRemote -> KRemoteAddr
-          -> Method remote param result -> param -> IO ()
+          -> Method param result -> param -> IO ()
 queryCall sock addr m arg = sendMessage q addr sock
   where
     q = kquery (L.head (methodName m)) [(L.head (methodParams m), toBEncode arg)]
 
 getResult :: BEncodable result
           => KRemote -> KRemoteAddr
-          -> Method remote param result -> IO result
+          -> Method param result -> IO result
 getResult sock addr m = do
   resp <- recvResponse addr sock
   case resp of
@@ -76,7 +76,7 @@ getResult sock addr m = do
 call :: (MonadBaseControl IO host, MonadIO host)
      => (BEncodable param, BEncodable result)
      => RemoteAddr
-     -> Method remote param result
+     -> Method param result
      -> param
      -> host result
 call addr m arg = liftIO $ withRemote $ \sock -> do
@@ -86,10 +86,11 @@ call addr m arg = liftIO $ withRemote $ \sock -> do
 
 newtype Async result = Async { waitResult :: IO result }
 
+-- TODO document errorneous usage
 async :: MonadIO host
       => (BEncodable param, BEncodable result)
       => RemoteAddr
-      -> Method remote param result
+      -> Method param result
       -> param
       -> host (Async result)
 async addr m arg = do
@@ -102,31 +103,37 @@ await :: MonadIO host => Async result -> host result
 await = liftIO . waitResult
 
 -- TODO better name
-type MHandler remote = Method remote BEncode (Result BEncode)
+type MHandler remote = ( Method BEncode (Result BEncode)
+                       , BEncode -> remote (Result BEncode)
+                       )
 
-handler :: forall (remote :: * -> *) (param :: *) (result :: *).
+-- we can safely erase types in (==>)
+(==>) :: forall (remote :: * -> *) (param :: *) (result :: *).
            (BEncodable param, BEncodable result)
         => Monad remote
-        => Method remote param result
-        -> Method remote BEncode (Result BEncode)
-handler m = m { methodBody = \x -> do
-                  case fromBEncode x of
-                    Right a -> liftM (Right . toBEncode) (methodBody m a)
+        => Method param result
+        -> (param -> remote result)
+        -> MHandler remote
+m ==> body = undefined
+  where
+    newbody x = case fromBEncode x of
+                    Right a -> liftM (Right . toBEncode) (body a)
                     Left e  -> return (Left e)
-              }
+
 
 -- TODO: allow forkIO
+-- TODO: allow overloading
 server :: (MonadBaseControl IO remote, MonadIO remote)
        => PortNumber
        -> [MHandler remote]
        -> remote ()
 server servport ms = remoteServer servport $ \_ q -> do
   let name = queryMethod q
-  let args = queryArgs q
+  let args = undefined -- queryArgs q
   let m = L.head ms
-  res <- methodBody m (snd (L.head (M.toList args)))
+  res <- undefined -- methodBody m (snd (L.head (M.toList args)))
   case res of
    Left  r -> return (Left (ProtocolError (T.pack r)))
    Right r -> do
-     let retName = L.head (methodVals m)
+     let retName = undefined -- L.head (methodVals m)
      return (Right (kresponse [(retName, r)]))
diff --git a/src/Remote/KRPC/Method.hs b/src/Remote/KRPC/Method.hs
index f4b0bb9a..3c757d07 100644
--- a/src/Remote/KRPC/Method.hs
+++ b/src/Remote/KRPC/Method.hs
@@ -1,12 +1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Remote.KRPC.Method
-       ( Method(methodName, methodParams, methodVals, methodBody)
+       ( Method(methodName, methodParams, methodVals)
 
          -- * Construction
        , method
 
          -- * Predefined methods
-       , idM, composeM, concatM
+       , idM, composeM
        ) where
 
 import Prelude hiding ((.), id)
@@ -15,6 +15,8 @@ import Control.Monad
 
 import Remote.KRPC.Protocol
 
+
+
 -- | The
 --
 --   * argument: type of method parameter
@@ -23,30 +25,35 @@ import Remote.KRPC.Protocol
 --
 --   * result: type of return value of the method.
 --
-data Method remote param result = Method {
+data Method param result = Method {
     -- | Name used in query and
     methodName   :: [MethodName]
 
-    -- | Description of each method parameter in right to left order.
+    -- | Description of each parameter in /right to left/ order.
   , methodParams :: [ParamName]
 
-    -- | Description of each method return value in right to left order.
+    -- | Description of each return value in /right to left/ order.
   , methodVals   :: [ValName]
-
-    -- | Description of method body.
-  , methodBody   :: param -> remote result
   }
 
-instance Monad remote => Category (Method remote) where
+instance Category Method where
+  {-# SPECIALIZE instance Category Method #-}
   id  = idM
+  {-# INLINE id #-}
+
   (.) = composeM
+  {-# INLINE (.) #-}
+
+
+-- TODO ppMethod
 
 -- | Remote identity function. Could be used for echo servers for example.
 --
 --   idM = method "id" ["x"] ["y"] return
 --
-idM :: Monad m => Method m a a
-idM = method "id" ["x"] ["y"] return
+idM :: Method a a
+idM = method "id" ["x"] ["y"]
+{-# INLINE idM #-}
 
 -- | Pipelining of two or more methods.
 --
@@ -54,23 +61,13 @@ idM = method "id" ["x"] ["y"] return
 --   KRPC, so both server and client should use this implementation,
 --   otherwise you more likely get the 'ProtocolError'.
 --
-composeM :: Monad m => Method m b c -> Method m a b -> Method m a c
+composeM :: Method b c -> Method a b -> Method a c
 composeM g h = Method (methodName g ++ methodName h)
                       (methodParams h)
                       (methodVals g)
-                      (methodBody h >=> methodBody g)
-
--- | Concat list of list. Could be used for performance tests.
---
---   concatM = method "concat" ["xxs"] ["xs"] $ return . Prelude.concat
---
-concatM :: Monad m => Method m [[a]] [a]
-concatM = method "concat" ["xxs"] ["xs"] $ return . Prelude.concat
+{-# INLINE composeM #-}
 
 
-method :: MethodName
-       -> [ParamName]
-       -> [ValName]
-       -> (param -> remote result)
-       -> Method remote param result
+method :: MethodName -> [ParamName] -> [ValName] -> Method param result
 method name = Method [name]
+{-# INLINE method #-}
\ No newline at end of file