diff --git a/Network/YAML.hs b/Network/YAML.hs index a1fcb8d..0da4ead 100644 --- a/Network/YAML.hs +++ b/Network/YAML.hs @@ -1,17 +1,17 @@ module Network.YAML ( + module Network.YAML.Types, module Network.YAML.Caller, module Network.YAML.Instances, module Network.YAML.Derive, module Network.YAML.Dispatcher, module Network.YAML.Balancer, module Network.YAML.WrapMethods, - HostAndPort, forkA ) where -import Network.YAML.Base (HostAndPort) +import Network.YAML.Types import Network.YAML.Caller import Network.YAML.Instances import Network.YAML.Derive diff --git a/Network/YAML/Balancer.hs b/Network/YAML/Balancer.hs index bcef59a..38a010f 100644 --- a/Network/YAML/Balancer.hs +++ b/Network/YAML/Balancer.hs @@ -4,7 +4,7 @@ module Network.YAML.Balancer where import System.Random import qualified Data.ByteString.Char8 as BS -import Network.YAML.Base (HostAndPort) +import Network.YAML.Types -- | Select random server selectRandom :: [(BS.ByteString, HostAndPort, Int)] -- ^ [(Service name, (hostname, port number), priority)] diff --git a/Network/YAML/Base.hs b/Network/YAML/Base.hs index ed9b812..025bfb1 100644 --- a/Network/YAML/Base.hs +++ b/Network/YAML/Base.hs @@ -10,11 +10,7 @@ import Data.Object.Yaml import qualified Data.ByteString.Char8 as BS import Text.Libyaml hiding (encode, decode) -type HostAndPort = (BS.ByteString, Int) - -class (Default a) => IsYamlObject a where - toYaml :: a -> YamlObject - fromYaml :: YamlObject -> a +import Network.YAML.Types getAttr :: BS.ByteString -> YamlObject -> Maybe YamlObject getAttr key (Mapping pairs) = lookup (toYamlScalar key) pairs diff --git a/Network/YAML/Caller.hs b/Network/YAML/Caller.hs index 16b91f0..d280b37 100644 --- a/Network/YAML/Caller.hs +++ b/Network/YAML/Caller.hs @@ -1,6 +1,11 @@ {-# LANGUAGE OverloadedStrings, FlexibleInstances, TypeSynonymInstances #-} -module Network.YAML.Caller where +module Network.YAML.Caller + (callDynamic, + callF, + callP + ) + where import qualified Data.Map as M import Data.Object.Yaml @@ -10,20 +15,11 @@ import System.IO import Control.Monad import Control.Concurrent -import Network.YAML.Base +import Network.YAML.Types +import Network.YAML.Base (serialize, unserialize) import Network.YAML.Instances import Network.YAML.Server -class Connection c where - newConnection :: (BS.ByteString, Int) -> IO c - closeConnection :: c -> IO () - -- | Call remote method - call :: (IsYamlObject a, IsYamlObject b) - => c - -> BS.ByteString -- ^ Name of method - -> a -- ^ Argument for method - -> IO b - -- | Send any YAML text and return an answer sendYAML :: (BS.ByteString, Int) -- ^ (Hostname, port) -> BS.ByteString -- ^ YAML text @@ -66,8 +62,6 @@ instance Connection HostAndPort where newConnection pair = return pair closeConnection _ = return () -newtype PersistentConnection = PC Handle - instance Connection PersistentConnection where newConnection (host, port) = do h <- connectTo (BS.unpack host) (PortNumber $ fromIntegral port) diff --git a/Network/YAML/Derive.hs b/Network/YAML/Derive.hs index 641c1c6..70fe711 100644 --- a/Network/YAML/Derive.hs +++ b/Network/YAML/Derive.hs @@ -13,6 +13,7 @@ import Data.Object import Data.Object.Yaml import qualified Data.ByteString.Char8 as BS +import Network.YAML.Types import Network.YAML.Base mkList :: [Name] -> ExpQ diff --git a/Network/YAML/Dispatcher.hs b/Network/YAML/Dispatcher.hs index 7cc8e13..0dea885 100644 --- a/Network/YAML/Dispatcher.hs +++ b/Network/YAML/Dispatcher.hs @@ -5,15 +5,12 @@ import qualified Data.Map as M import Data.Object.Yaml import qualified Data.ByteString.Char8 as BS -import Network.YAML.Base +import Network.YAML.Types import Network.YAML.Instances 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 :: [(BS.ByteString, Worker)] -> Rules mkRules pairs = M.fromList pairs -- | Select worker from dispatching rules diff --git a/Network/YAML/Instances.hs b/Network/YAML/Instances.hs index d71b5e8..6a68729 100644 --- a/Network/YAML/Instances.hs +++ b/Network/YAML/Instances.hs @@ -8,6 +8,7 @@ import Data.Object import Data.Object.Yaml import qualified Data.ByteString.Char8 as BS +import Network.YAML.Types import Network.YAML.Base -- | Build YamlObject from (key,value) pairs @@ -122,9 +123,6 @@ instance IsYamlObject String where fromYaml x = fromMaybe def $ getScalar x toYaml x = Scalar $ toYamlScalar x -data Call = Call { methodName :: BS.ByteString, args :: YamlObject } - deriving (Show) - mkCall :: BS.ByteString -> YamlObject -> YamlObject mkCall name args = toYaml $ Call name args diff --git a/Network/YAML/Server.hs b/Network/YAML/Server.hs index 2b9bb84..3b16686 100644 --- a/Network/YAML/Server.hs +++ b/Network/YAML/Server.hs @@ -11,6 +11,7 @@ import System.IO import qualified Data.ByteString.Char8 as BS import Data.Object.Yaml +import Network.YAML.Types import Network.YAML.Base import Network.YAML.Instances @@ -51,7 +52,7 @@ readHandle h acc = do -- So, each call is processed in another thread. server :: Int -- ^ Port number - -> (YamlObject -> IO YamlObject) -- ^ Worker + -> Worker -> IO () server port callOut = do -- installHandler sigPIPE Ignore Nothing @@ -79,7 +80,7 @@ server port callOut = do -- So, new thread is created only per-client, not per-query. persistentServer :: Int - -> (YamlObject -> IO YamlObject) + -> Worker -> IO () persistentServer port callOut = do -- installHandler sigPIPE Ignore Nothing diff --git a/Network/YAML/Types.hs b/Network/YAML/Types.hs new file mode 100644 index 0000000..c4e955c --- /dev/null +++ b/Network/YAML/Types.hs @@ -0,0 +1,36 @@ +module Network.YAML.Types where + +import System.IO +import qualified Data.ByteString.Char8 as BS +import Data.Object.Yaml +import Data.Default +import qualified Data.Map as M + +-- | This class guaranties that type can be converted to YamlObject and vice versa. +class (Default a) => IsYamlObject a where + toYaml :: a -> YamlObject + fromYaml :: YamlObject -> a + +-- | Class for different types of connection to RPC servers +class Connection c where + newConnection :: HostAndPort -> IO c + closeConnection :: c -> IO () + -- | Call remote method + call :: (IsYamlObject a, IsYamlObject b) + => c + -> BS.ByteString -- ^ Name of method + -> a -- ^ Argument for method + -> IO b + +-- | (Host name, port number) +type HostAndPort = (BS.ByteString, Int) +type Worker = YamlObject -> IO YamlObject +-- | Service name -> Worker +type Rules = M.Map BS.ByteString Worker + +-- | RPC call +data Call = Call { methodName :: BS.ByteString, args :: YamlObject } + deriving (Show) + +newtype PersistentConnection = PC Handle + diff --git a/Network/YAML/WrapMethods.hs b/Network/YAML/WrapMethods.hs index 5129597..7a12f5f 100644 --- a/Network/YAML/WrapMethods.hs +++ b/Network/YAML/WrapMethods.hs @@ -10,7 +10,7 @@ import Data.Char (toUpper) import Data.Object.Yaml import qualified Data.ByteString.Char8 as BS -import Network.YAML.Base +import Network.YAML.Types import Network.YAML.Caller import Network.YAML.Derive import Network.YAML.Instances