First working test.
diff --git a/Server.hs b/Server.hs
new file mode 100644
index 0000000..01780ef
--- /dev/null
+++ b/Server.hs
@@ -0,0 +1,52 @@
+
+module Server where
+
+import Control.Monad
+import Control.Monad.State
+import Control.Concurrent
+import Control.Exception
+import Network
+import System.IO
+import qualified Data.ByteString.Char8 as BS
+import Data.Object.Yaml
+
+import YAML
+import YAMLInstances
+
+(<+>) = BS.append
+
+read' :: Handle -> [BS.ByteString] -> IO [BS.ByteString]
+read' h acc = do
+ line <- BS.hGetLine h
+ let line' = if (BS.last line)=='\r'
+ then BS.init line
+ else line
+-- print $ "read line:"++line'
+ if BS.null line'
+ then return acc
+ else read' h (acc ++ [line'])
+
+server ::
+ Int
+ -> (YamlObject -> IO YamlObject)
+ -> IO ()
+server port callOut = do
+-- installHandler sigPIPE Ignore Nothing
+ sock <- listenOn (PortNumber $ fromIntegral port)
+ (forever $ loop sock) `finally` sClose sock
+ where
+ loop :: Socket -> IO ThreadId
+ loop sock =
+ do (h,_nm,_port) <- accept sock
+ forkIO
+ (do
+ lns <- read' h []
+ let text = BS.unlines lns
+ case unserialize text of
+ Nothing -> hClose h
+ Just ob -> do
+ print ob
+ res <- callOut ob
+ BS.hPutStr h $ serialize res
+ hClose h)
+
diff --git a/Test.hs b/Test.hs
new file mode 100644
index 0000000..aeab1e3
--- /dev/null
+++ b/Test.hs
@@ -0,0 +1,17 @@
+
+import Data.Object.Yaml
+import Data.Convertible.Base
+
+import Server
+import YAML
+import YAMLInstances
+
+worker :: YamlObject -> IO YamlObject
+worker obj = do
+ let (Point x y) = cs obj
+ return $ cs $ Point (x*2) (y*2)
+
+main = do
+ print "Listening..."
+ server 5000 worker
+ return ()
diff --git a/YAML.hs b/YAML.hs
index a89e064..e7c75be 100644
--- a/YAML.hs
+++ b/YAML.hs
@@ -4,11 +4,11 @@ module YAML where
import Control.Monad
import Data.Maybe
-import Data.Convertible
+-- import Data.Convertible
import Data.Object
import Data.Object.Yaml
import qualified Data.ByteString.Char8 as BS
-import Text.Libyaml hiding (encode)
+import Text.Libyaml hiding (encode, decode)
class (ConvertSuccess YamlObject a, ConvertSuccess a YamlObject) => IsYamlObject a where
@@ -37,13 +37,21 @@ serialize x =
c = cs x
in encode c
-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'
+unserialize :: IsYamlObject a => BS.ByteString -> Maybe a
+unserialize x =
+ let d :: Maybe YamlObject
+ d = decode 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/YAMLInstances.hs b/YAMLInstances.hs
index a513bd6..6b8be4f 100644
--- a/YAMLInstances.hs
+++ b/YAMLInstances.hs
@@ -1,6 +1,12 @@
+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}
module YAMLInstances where
+import Data.Maybe
+-- import Data.Convertible
+import Data.Object
+import Data.Object.Yaml
+
import YAML
data Point = Point { x :: Double, y :: Double }
@@ -18,3 +24,5 @@ instance ConvertSuccess YamlObject Point where
instance IsYamlObject Point where
+instance IsYamlObject YamlObject where
+