Cleanup and some haddock docs.

Ilya V. Portnov [2010-04-22 09:56:56]
Cleanup and some haddock docs.
Filename
Makefile
Network/YAML/Base.hs
Network/YAML/Caller.hs
Network/YAML/Derive.hs
Network/YAML/Dispatcher.hs
diff --git a/Makefile b/Makefile
index ff050fd..b675c60 100644
--- a/Makefile
+++ b/Makefile
@@ -7,7 +7,7 @@ TestCall: *.hs Network/YAML/*.hs
 	ghc -i. --make TestCall.hs

 clean:
-	find . -name *.hi -delete
-	find . -name *.o -delete
+	find . -name \*.hi -delete
+	find . -name \*.o -delete


diff --git a/Network/YAML/Base.hs b/Network/YAML/Base.hs
index 5edef72..87c2716 100644
--- a/Network/YAML/Base.hs
+++ b/Network/YAML/Base.hs
@@ -67,14 +67,3 @@ unserialize x =
   in  case d of
         Just y -> Just $ cs y
         Nothing -> Nothing
-
--- p = Point 3.0 2.0
---
--- main = do
---   let s = serialize p
---   BS.putStrLn s
---   let c :: YamlObject
---       c = cs p
---       p' :: Point
---       p' = cs c
---   print p'
diff --git a/Network/YAML/Caller.hs b/Network/YAML/Caller.hs
index 34dabfd..00c39b8 100644
--- a/Network/YAML/Caller.hs
+++ b/Network/YAML/Caller.hs
@@ -13,12 +13,12 @@ import Network.YAML.Base
 import Network.YAML.Instances
 import Network.YAML.Server

-callDynamic :: (IsYamlObject a, IsYamlObject b) => (BS.ByteString -> IO (BS.ByteString,Int)) -> BS.ByteString -> BS.ByteString -> a -> IO b
-callDynamic getServer service name args = do
-  srv <- getServer service
-  call srv name args
-
-call :: (IsYamlObject a, IsYamlObject b) => (BS.ByteString, Int) -> BS.ByteString -> a -> IO b
+-- | Call remote method
+call :: (IsYamlObject a, IsYamlObject b)
+     => (BS.ByteString, Int)            -- ^ (Host name, port number)
+     -> BS.ByteString                   -- ^ Name of method
+     -> a                               -- ^ Argument for method
+     -> IO b
 call (host,port) name args = withSocketsDo $ do
   h <- connectTo (BS.unpack host) (PortNumber $ fromIntegral port)
   let c = mkCall name (cs args)
@@ -31,3 +31,15 @@ call (host,port) name args = withSocketsDo $ do
   case unserialize text of
     Nothing -> fail "No answer"
     Just x -> return x
+
+-- | Similar, but select server on each call
+callDynamic :: (IsYamlObject a, IsYamlObject b)
+            => (BS.ByteString -> IO (BS.ByteString,Int)) -- ^ Get (Host name, port number) from service name
+            -> BS.ByteString                             -- ^ Name of the service
+            -> BS.ByteString                             -- ^ Name of method
+            -> a                                         -- ^ Argument for method
+            -> IO b
+callDynamic getServer service name args = do
+  srv <- getServer service
+  call srv name args
+
diff --git a/Network/YAML/Derive.hs b/Network/YAML/Derive.hs
index d496a30..6b9857b 100644
--- a/Network/YAML/Derive.hs
+++ b/Network/YAML/Derive.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE TemplateHaskell, TypeSynonymInstances, MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Network.YAML.Derive where
+module Network.YAML.Derive
+  (deriveDefault, deriveIsYamlObject)
+  where

 import Language.Haskell.TH
 import Control.Monad
@@ -13,8 +15,6 @@ import qualified Data.ByteString.Char8 as BS
 import Network.YAML.Base
 import Network.YAML.Instances

-data T1 = T1
-
 mkList :: [Name] -> Q Exp
 mkList []       = [| [] |]
 mkList (v:vars) = [| (toYamlScalar $(stringOfName v), Scalar $ toYamlScalar $(varE v)): $(mkList vars) |]
@@ -69,6 +69,7 @@ fromClause (NormalC name fields) = do
     (_,names) <- genPE (length fields)
     genFromClause constructorName names

+-- | Derive `instance ConvertSuccess t YamlObject ...'
 deriveToYamlObject :: Name -> Q [Dec]
 deriveToYamlObject t = do
   -- Get list of constructors for type t
@@ -76,12 +77,14 @@ deriveToYamlObject t = do
   convbody <- mapM consClause constructors
   return [InstanceD [] (ConT ''ConvertSuccess `AppT` ConT t `AppT` ConT ''YamlObject) [FunD 'convertSuccess convbody]]

+-- | Derive `instance ConvertSuccess YamlObject t ...'
 deriveFromYamlObject :: Name -> Q [Dec]
 deriveFromYamlObject t = do
   TyConI (DataD _ _ _ constructors _)  <-  reify t
   body <- mapM fromClause constructors
   return [InstanceD [] (ConT ''ConvertSuccess `AppT` ConT ''YamlObject `AppT` ConT t) [FunD 'convertSuccess body]]

+-- | Derive `instance IsYamlObject t where ...'
 deriveIsYamlObject :: Name -> Q [Dec]
 deriveIsYamlObject t = do
   [i1] <- deriveToYamlObject t
@@ -99,6 +102,7 @@ defaultClause (NormalC name fields) = do
       body = foldl appE (conE name) defs
   clause [] (normalB body) []

+-- | Derive `instance Default t where def = ...'
 deriveDefault :: Name -> Q [Dec]
 deriveDefault t = do
   TyConI (DataD _ _ _ constructors _)  <-  reify t
diff --git a/Network/YAML/Dispatcher.hs b/Network/YAML/Dispatcher.hs
index 4becbb5..4ed9dff 100644
--- a/Network/YAML/Dispatcher.hs
+++ b/Network/YAML/Dispatcher.hs
@@ -13,9 +13,11 @@ import Network.YAML.Server
 type Worker = YamlObject -> IO YamlObject
 type Rules = M.Map BS.ByteString Worker

+-- | Build dispatching rules
 mkRules :: [(BS.ByteString,Worker)] -> Rules
 mkRules pairs = M.fromList pairs

+-- | Select worker from dispatching rules
 dispatch :: Rules -> Worker
 dispatch rules = \obj ->
   let call :: Call
@@ -24,5 +26,6 @@ dispatch rules = \obj ->
       Nothing -> fail $ "Unknown method: " ++ (BS.unpack $ methodName call)
       Just fn -> fn (args call)

+-- | Listens given port and dispatches requests
 dispatcher :: Int -> Rules -> IO ()
 dispatcher port rules = server port (dispatch rules)
ViewGit