Cleanup and some haddock docs.
Cleanup and some haddock docs.
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)