Migrate all String's to Data.ByteString.Char8.ByteString

Ilya Portnov [2010-04-21 15:56:07]
Migrate all String's to Data.ByteString.Char8.ByteString
Filename
Caller.hs
Dispatcher.hs
Test.hs
TestCall.hs
YAML.hs
YAMLInstances.hs
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
ViewGit