diff --git a/Caller.hs b/Caller.hs index 47d1420..cf9924f 100644 --- a/Caller.hs +++ b/Caller.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Caller where @@ -12,14 +13,14 @@ import YAML import YAMLInstances import Server -callDynamic :: (IsYamlObject a, IsYamlObject b) => (String -> IO (String,Int)) -> String -> String -> a -> IO b +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) => (String, Int) -> String -> a -> IO b +call :: (IsYamlObject a, IsYamlObject b) => (BS.ByteString, Int) -> BS.ByteString -> a -> IO b call (host,port) name args = withSocketsDo $ do - h <- connectTo host (PortNumber $ fromIntegral port) + h <- connectTo (BS.unpack host) (PortNumber $ fromIntegral port) let c = mkCall name (cs args) s = serialize c hSetBuffering h NoBuffering diff --git a/Dispatcher.hs b/Dispatcher.hs index 5b49cad..d3710ba 100644 --- a/Dispatcher.hs +++ b/Dispatcher.hs @@ -13,8 +13,8 @@ import Server type Worker = YamlObject -> IO YamlObject type Rules = M.Map BS.ByteString Worker -mkRules :: [(String,Worker)] -> Rules -mkRules pairs = M.fromList [(BS.pack name, worker) | (name,worker) <- pairs] +mkRules :: [(BS.ByteString,Worker)] -> Rules +mkRules pairs = M.fromList pairs dispatch :: Rules -> Worker dispatch rules = \obj -> diff --git a/Test.hs b/Test.hs index 09bc533..1a51a25 100644 --- a/Test.hs +++ b/Test.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} import Data.Object.Yaml import Data.Convertible.Base diff --git a/TestCall.hs b/TestCall.hs index 723d93e..3d98661 100644 --- a/TestCall.hs +++ b/TestCall.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} import Data.Object.Yaml import Data.Convertible.Base diff --git a/YAML.hs b/YAML.hs index 10fbd1b..f157ef1 100644 --- a/YAML.hs +++ b/YAML.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeSynonymInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeSynonymInstances, MultiParamTypeClasses, OverloadedStrings #-} module YAML where @@ -12,7 +12,7 @@ import Text.Libyaml hiding (encode, decode) class (ConvertSuccess YamlObject a, ConvertSuccess a YamlObject) => IsYamlObject a where -getAttr :: String -> YamlObject -> Maybe YamlObject +getAttr :: BS.ByteString -> YamlObject -> Maybe YamlObject getAttr key (Mapping pairs) = lookup (toYamlScalar key) pairs getAttr key (Sequence lst) = case catMaybes $ map (getAttr key) lst of @@ -28,10 +28,10 @@ getList :: YamlObject -> [YamlObject] getList (Sequence lst) = lst getList _ = [] -getScalarAttr :: (IsYamlScalar a) => String -> YamlObject -> Maybe a +getScalarAttr :: (IsYamlScalar a) => BS.ByteString -> YamlObject -> Maybe a getScalarAttr key obj = getScalar =<< getAttr key obj -getListAttr :: String -> YamlObject -> [YamlObject] +getListAttr :: BS.ByteString -> YamlObject -> [YamlObject] getListAttr key obj = case getAttr key obj of Just x -> getList x diff --git a/YAMLInstances.hs b/YAMLInstances.hs index aa1886a..650ea32 100644 --- a/YAMLInstances.hs +++ b/YAMLInstances.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, OverloadedStrings #-} module YAMLInstances where @@ -12,10 +12,10 @@ import YAML data Point = Point { x :: Double, y :: Double } deriving (Show) -object :: [(String, YamlScalar)] -> YamlObject +object :: [(BS.ByteString, YamlScalar)] -> YamlObject object pairs = Mapping [(toYamlScalar name, Scalar val) | (name,val) <- pairs] -field :: (IsYamlScalar a) => String -> a -> YamlObject +field :: (IsYamlScalar a) => BS.ByteString -> a -> YamlObject field name val = Mapping [(toYamlScalar name, Scalar $ toYamlScalar val)] instance (IsYamlObject a) => ConvertSuccess [a] YamlObject where @@ -45,17 +45,20 @@ instance IsYamlObject YamlObject where data Call = Call { methodName :: BS.ByteString, args :: YamlObject } deriving (Show) -mkCall :: String -> YamlObject -> YamlObject -mkCall name args = cs $ Call (BS.pack name) args +mkCall :: BS.ByteString -> YamlObject -> YamlObject +mkCall name args = cs $ Call name args + +stringScalar :: String -> YamlScalar +stringScalar = toYamlScalar instance ConvertSuccess Call YamlObject where - convertSuccess (Call name args) = Mapping [(toYamlScalar "call", Scalar $ toYamlScalar name), - (toYamlScalar "args", args)] + convertSuccess (Call name args) = Mapping [(stringScalar "call", Scalar $ toYamlScalar name), + (stringScalar "args", args)] instance ConvertSuccess YamlObject Call where convertSuccess obj = Call name args where - name = fromMaybe (BS.pack "defaultMethod") $ getScalarAttr "call" obj + name = fromMaybe "defaultMethod" $ getScalarAttr "call" obj args = fromMaybe (Sequence []) $ getAttr "args" obj instance IsYamlObject Call where