diff --git a/Network/YAML/Base.hs b/Network/YAML/Base.hs
index dd762ae..ed9b812 100644
--- a/Network/YAML/Base.hs
+++ b/Network/YAML/Base.hs
@@ -12,7 +12,9 @@ import Text.Libyaml hiding (encode, decode)
type HostAndPort = (BS.ByteString, Int)
-class (ConvertSuccess YamlObject a, ConvertSuccess a YamlObject, Default a) => IsYamlObject a where
+class (Default a) => IsYamlObject a where
+ toYaml :: a -> YamlObject
+ fromYaml :: YamlObject -> a
getAttr :: BS.ByteString -> YamlObject -> Maybe YamlObject
getAttr key (Mapping pairs) = lookup (toYamlScalar key) pairs
@@ -69,12 +71,12 @@ instance IsYamlScalar Integer where
serialize :: IsYamlObject a => a -> BS.ByteString
serialize x =
let c :: YamlObject
- c = cs x
+ c = toYaml x
in encode c
unserialize :: IsYamlObject a => BS.ByteString -> Maybe a
unserialize x =
let d :: Maybe YamlObject
d = decode x
- in cs `fmap` d
+ in fromYaml `fmap` d
diff --git a/Network/YAML/Caller.hs b/Network/YAML/Caller.hs
index dcaad0c..16b91f0 100644
--- a/Network/YAML/Caller.hs
+++ b/Network/YAML/Caller.hs
@@ -4,7 +4,6 @@ module Network.YAML.Caller where
import qualified Data.Map as M
import Data.Object.Yaml
-import Data.Convertible.Base
import qualified Data.ByteString.Char8 as BS
import Network
import System.IO
@@ -57,7 +56,7 @@ instance Connection HostAndPort where
-- -> a -- ^ Argument for method
-- -> IO b
call (host,port) name args = do
- let c = mkCall name (cs args)
+ let c = mkCall name (toYaml args)
s = serialize c
text <- sendYAML (host,port) s
case unserialize text of
@@ -77,7 +76,7 @@ instance Connection PersistentConnection where
closeConnection (PC h) = hClose h
call (PC h) name args = do
- let c = mkCall name (cs args)
+ let c = mkCall name (toYaml args)
s = serialize c
text <- hSendYAML h s
case unserialize text of
diff --git a/Network/YAML/Derive.hs b/Network/YAML/Derive.hs
index 948005c..641c1c6 100644
--- a/Network/YAML/Derive.hs
+++ b/Network/YAML/Derive.hs
@@ -21,7 +21,7 @@ mkList (v:vars) = [| (toYamlScalar $(stringOfName v), Scalar $ toYamlScalar $(va
mkSeq :: [Name] -> ExpQ
mkSeq [] = [| [] |]
-mkSeq (v:vars) = [| cs $(varE v): $(mkSeq vars) |]
+mkSeq (v:vars) = [| toYaml $(varE v): $(mkSeq vars) |]
getNameBase :: Name -> Name
getNameBase name = mkName $ nameBase name
@@ -75,32 +75,30 @@ fromClause (NormalC name fields) = do
body = foldl appE (conE $ mkName cName) $ map (getAttr' cName obj) $ map fst (zip [0..] names)
clause [varP obj] (guardedB [normalGE guard body]) []
where
- getAttr' c obj k = [| cs $ getItem (BS.pack c) k $(varE obj) |]
+ getAttr' c obj k = [| fromYaml $ getItem (BS.pack c) k $(varE obj) |]
getName (n,x) = (n, getNameBase x)
--- | Derive `instance ConvertSuccess t YamlObject ...'
deriveToYamlObject :: Name -> Q [Dec]
deriveToYamlObject t = do
-- Get list of constructors for type t
TyConI (DataD _ _ _ constructors _) <- reify t
convbody <- mapM consClause constructors
- return [InstanceD [] (ConT ''ConvertSuccess `AppT` ConT t `AppT` ConT ''YamlObject) [FunD 'convertSuccess convbody]]
+ return [FunD 'toYaml 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]]
+ return [FunD 'fromYaml body]
-- | Derive `instance IsYamlObject t where ...'
deriveIsYamlObject :: Name -> Q [Dec]
deriveIsYamlObject t = do
[i1] <- deriveToYamlObject t
[i2] <- deriveFromYamlObject t
- let i3 = InstanceD [] (ConT ''IsYamlObject `AppT` ConT t) []
- return [i1,i2,i3]
+ let res = InstanceD [] (ConT ''IsYamlObject `AppT` ConT t) [i1, i2]
+ return [res]
defaultClause :: Con -> ClauseQ
defaultClause (RecC name fields) = do
diff --git a/Network/YAML/Dispatcher.hs b/Network/YAML/Dispatcher.hs
index 4af6763..7cc8e13 100644
--- a/Network/YAML/Dispatcher.hs
+++ b/Network/YAML/Dispatcher.hs
@@ -3,7 +3,6 @@ module Network.YAML.Dispatcher where
import qualified Data.Map as M
import Data.Object.Yaml
-import Data.Convertible.Base
import qualified Data.ByteString.Char8 as BS
import Network.YAML.Base
@@ -21,7 +20,7 @@ mkRules pairs = M.fromList pairs
dispatch :: Rules -> Worker
dispatch rules = \obj ->
let call :: Call
- call = cs obj
+ call = fromYaml obj
in case M.lookup (methodName call) rules of
Nothing -> fail $ "Unknown method: " ++ (BS.unpack $ methodName call)
Just fn -> fn (args call)
diff --git a/Network/YAML/Instances.hs b/Network/YAML/Instances.hs
index 2b654b3..d71b5e8 100644
--- a/Network/YAML/Instances.hs
+++ b/Network/YAML/Instances.hs
@@ -21,46 +21,37 @@ field name val = Mapping [(toYamlScalar name, Scalar $ toYamlScalar val)]
instance Default BS.ByteString where
def = BS.empty
-instance (IsYamlObject a) => ConvertSuccess [a] YamlObject where
- convertSuccess lst = Sequence $ map cs lst
-
-instance (IsYamlObject a) => ConvertSuccess YamlObject [a] where
- convertSuccess (Mapping pairs) = map cs $ map snd pairs
- convertSuccess (Sequence lst) = map cs lst
- convertSuccess s@(Scalar _) = [cs s]
-
instance (IsYamlObject a) => IsYamlObject [a] where
+ toYaml lst = Sequence $ map toYaml lst
+
+ fromYaml (Mapping pairs) = map fromYaml $ map snd pairs
+ fromYaml (Sequence lst) = map fromYaml lst
+ fromYaml s@(Scalar _) = [fromYaml s]
tryGet lst k =
if k >= length lst
then def
else lst !! k
-instance (IsYamlObject a, IsYamlObject b) => ConvertSuccess (a,b) YamlObject where
- convertSuccess (x,y) = Sequence [cs x, cs y]
+instance (IsYamlObject a, IsYamlObject b) => IsYamlObject (a,b) where
+ toYaml (x,y) = Sequence [toYaml x, toYaml y]
-instance (IsYamlObject a, IsYamlObject b) => ConvertSuccess YamlObject (a,b) where
- convertSuccess obj = (cs x, cs y)
+ fromYaml obj = (fromYaml x, fromYaml y)
where
list = getList obj
x = tryGet list 0
y = tryGet list 1
-instance (IsYamlObject a, IsYamlObject b) => IsYamlObject (a,b) where
-
-instance (IsYamlObject a, IsYamlObject b, IsYamlObject c) => ConvertSuccess (a,b,c) YamlObject where
- convertSuccess (x,y,z) = Sequence [cs x, cs y, cs z]
+instance (IsYamlObject a, IsYamlObject b, IsYamlObject c) => IsYamlObject (a,b,c) where
+ toYaml (x,y,z) = Sequence [toYaml x, toYaml y, toYaml z]
-instance (IsYamlObject a, IsYamlObject b, IsYamlObject c) => ConvertSuccess YamlObject (a,b,c) where
- convertSuccess obj = (cs x, cs y, cs z)
+ fromYaml obj = (fromYaml x, fromYaml y, fromYaml z)
where
list = getList obj
x = tryGet list 0
y = tryGet list 1
z = tryGet list 2
-instance (IsYamlObject a, IsYamlObject b, IsYamlObject c) => IsYamlObject (a,b,c) where
-
instance (Default a, Default b) => Default (a,b) where
def = (def, def)
@@ -73,52 +64,39 @@ _right = "Right"
_left :: BS.ByteString
_left = "Left"
-instance (IsYamlObject a, IsYamlObject b) => ConvertSuccess (Either a b) YamlObject where
- convertSuccess (Right a) = Mapping [(toYamlScalar _right, cs a)]
- convertSuccess (Left b) = Mapping [(toYamlScalar _left, cs b)]
-
-instance (IsYamlObject a, IsYamlObject b) => ConvertSuccess YamlObject (Either a b) where
- convertSuccess (Mapping [(name, val)]) =
- if fromYamlScalar name == _right
- then Right (cs val)
- else if fromYamlScalar name == _left
- then Left (cs val)
- else def
- convertSuccess _ = def
-
instance (Default a) => Default (Either a b) where
def = Left def
instance (IsYamlObject a, IsYamlObject b) => IsYamlObject (Either a b) where
+ toYaml (Right a) = Mapping [(toYamlScalar _right, toYaml a)]
+ toYaml (Left b) = Mapping [(toYamlScalar _left, toYaml b)]
+
+ fromYaml (Mapping [(name, val)]) =
+ if fromYamlScalar name == _right
+ then Right (fromYaml val)
+ else if fromYamlScalar name == _left
+ then Left (fromYaml val)
+ else def
+ fromYaml _ = def
instance Default YamlObject where
def = Sequence []
instance IsYamlObject YamlObject where
-
-instance ConvertSuccess YamlObject Double where
- convertSuccess x = fromMaybe def $ getScalar x
-
-instance ConvertSuccess Double YamlObject where
- convertSuccess x = Scalar $ toYamlScalar x
+ toYaml = id
+ fromYaml = id
instance IsYamlObject Double where
-
-instance ConvertSuccess YamlObject Int where
- convertSuccess x = fromMaybe def $ getScalar x
-
-instance ConvertSuccess Int YamlObject where
- convertSuccess x = Scalar $ toYamlScalar x
+ fromYaml x = fromMaybe def $ getScalar x
+ toYaml x = Scalar $ toYamlScalar x
instance IsYamlObject Int where
-
-instance ConvertSuccess YamlObject Integer where
- convertSuccess x = fromMaybe def $ getScalar x
-
-instance ConvertSuccess Integer YamlObject where
- convertSuccess x = Scalar $ toYamlScalar x
+ fromYaml x = fromMaybe def $ getScalar x
+ toYaml x = Scalar $ toYamlScalar x
instance IsYamlObject Integer where
+ fromYaml x = fromMaybe def $ getScalar x
+ toYaml x = Scalar $ toYamlScalar x
instance IsYamlScalar Bool where
toYamlScalar True = stringScalar "True"
@@ -132,58 +110,42 @@ instance IsYamlScalar Bool where
instance Default Bool where
def = False
-instance ConvertSuccess Bool YamlObject where
- convertSuccess x = Scalar $ toYamlScalar x
-
-instance ConvertSuccess YamlObject Bool where
- convertSuccess x = fromMaybe def $ getScalar x
-
instance IsYamlObject Bool where
-
-instance ConvertSuccess YamlObject BS.ByteString where
- convertSuccess x = fromMaybe def $ getScalar x
-
-instance ConvertSuccess BS.ByteString YamlObject where
- convertSuccess x = Scalar $ toYamlScalar x
+ toYaml x = Scalar $ toYamlScalar x
+ fromYaml x = fromMaybe def $ getScalar x
instance IsYamlObject BS.ByteString where
-
-instance ConvertSuccess YamlObject String where
- convertSuccess x = fromMaybe def $ getScalar x
-
-instance ConvertSuccess String YamlObject where
- convertSuccess x = Scalar $ toYamlScalar x
+ fromYaml x = fromMaybe def $ getScalar x
+ toYaml x = Scalar $ toYamlScalar x
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 = cs $ Call name args
+mkCall name args = toYaml $ Call name args
stringScalar :: String -> YamlScalar
stringScalar = toYamlScalar
-instance ConvertSuccess Call YamlObject where
- 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 "defaultMethod" $ getScalarAttr "call" obj
- args = fromMaybe (Sequence []) $ getAttr "args" obj
-
instance Default Call where
def = Call "defaultMethod" def
instance IsYamlObject Call where
+ toYaml (Call name args) = Mapping [(stringScalar "call", Scalar $ toYamlScalar name),
+ (stringScalar "args", args)]
+ fromYaml obj = Call name args
+ where
+ name = fromMaybe "defaultMethod" $ getScalarAttr "call" obj
+ args = fromMaybe (Sequence []) $ getAttr "args" obj
-- | Convert any (a -> IO b) action to YAML RPC method
yamlMethod :: (IsYamlObject a, IsYamlObject b) => (a -> IO b) -> YamlObject -> IO YamlObject
yamlMethod fn = \obj -> do
- let x = cs obj
+ let x = fromYaml obj
y <- fn x
- return $ cs y
+ return $ toYaml y
diff --git a/Test.hs b/Test.hs
index 7434266..3f4e6bd 100644
--- a/Test.hs
+++ b/Test.hs
@@ -3,7 +3,6 @@
module Main where
import Data.Object.Yaml
-import Data.Convertible.Base
import qualified Data.Map as M
import Network.YAML
diff --git a/TestCall.hs b/TestCall.hs
index efbcbb9..f78260c 100644
--- a/TestCall.hs
+++ b/TestCall.hs
@@ -6,7 +6,6 @@ import Control.Monad
import System.Environment (getArgs)
import qualified Data.ByteString.Char8 as BS
import Data.Object.Yaml
-import Data.Convertible.Base
import Network.YAML
diff --git a/TestDerive.hs b/TestDerive.hs
index 08578f2..ac427a0 100644
--- a/TestDerive.hs
+++ b/TestDerive.hs
@@ -2,7 +2,6 @@
{-# LANGUAGE OverloadedStrings #-}
import Data.Default
-import Data.Convertible.Base
import Data.Object.Yaml
import qualified Data.ByteString.Char8 as BS
diff --git a/yaml-rpc.cabal b/yaml-rpc.cabal
index d382692..68af2f4 100644
--- a/yaml-rpc.cabal
+++ b/yaml-rpc.cabal
@@ -57,7 +57,7 @@ Library
-- Packages needed in order to build this package.
Build-depends: yaml, data-object-yaml, network, template-haskell, bytestring,
- data-object, data-default, base >= 3 && <= 5, mtl, convertible-text,
+ data-object, data-default, base >= 3 && <= 5, mtl,
containers, random
-- Modules not exported by this package.