generic somewhat working save for isunit

week08/serialize8Start.icl

@@ -10,9 +10,16 @@ module serialize8Start
   Use Basic Values Only as conclose option for a nicer output.
 */
 
-import StdEnv, StdMaybe
+import StdEnv, StdMaybe, StdDebug
 import StdGeneric
 
+generic isUnit a :: a -> Bool
+
+isUnit{|UNIT|} a = True
+isUnit{|c|} a    = False
+
+//derive isUnit [], Coin, (,), Bin
+
 // use this as serialize0 for kind *
 //class serialize a  | isUnit a where
 //  write :: a [String] -> [String]
@@ -21,30 +28,76 @@ import StdGeneric
 generic write a :: a [String] -> [String]
 generic read a :: [String] -> Maybe (a,[String])
 
-class serialize a | read{|*|}, write{|*|} a  
+class serialize a | read{|*|}, write{|*|}, isUnit{|*|} a  
   //write :: a [String] -> [String]
   //write a c = write{|*|} a
 
 //instance serialize Bool where
-derive read Bool
-derive write Bool
 
 
 write{|Bool|} b c = [toString b:c]
-write{|UNIT|} b c = []
-write{|PAIR|} f g b c = []
-write{|EITHER|} f g b c = []
-write{|CONS|} f b c = []
-write{|FIELD|} f b c = []
-write{|OBJECT|} f b c = []
-
-read{|Bool|} r = Nothing
-read{|UNIT|} r = Nothing
-read{|PAIR|} f g r = Nothing
-read{|EITHER|} f g r = Nothing
-read{|CONS|} f r = Nothing
-read{|FIELD|} f r = Nothing
-read{|OBJECT|} f r = Nothing
+write{|Int|} b c = [toString b:c]
+write{|UNIT|} b c = c
+write{|PAIR|} f g (PAIR a b) c = f a (g b c)
+write{|EITHER|} f g (LEFT a) c = f a c
+write{|EITHER|} f g (RIGHT b) c = g b c
+write{|CONS of x|} f (CONS a) c = ["(":(trace x.gcd_type_def.gtd_name x.gcd_name):(f a [")":c])]
+//write{|FIELD|} f b c = []
+write{|OBJECT|} f (OBJECT o) c = f o c 
+write{|(,)|} f g (a,b) c = ["(":(f a [ ",":(g b [")":c])])]
+
+
+           // Don't flip left and right though, that makes reading using the 'unit without parentheses' not work
+
+
+
+read{|Int|} r = foldl (match r) Nothing [True, False]
+  where
+    match [string: rest] r bool
+      # int = toInt string
+      | string == toString int
+        = Just (int, rest)
+        = r
+    match _ r bool = r
+
+read{|Bool|} r = foldl (match r) Nothing [True, False]
+  where
+    match [string: rest] r bool | toString bool == string
+        = Just (bool, rest)
+        = r
+    match _ r bool = r
+
+read{|UNIT|} r = Just (UNIT,r)
+read{|PAIR|} f g r = case f r of
+                    Nothing    -> Nothing
+                    Just (a,r) -> case g r of 
+                      Nothing    -> Nothing
+                      Just (b,r) -> Just (PAIR a b, r)
+read{|EITHER|} f g r = case f r of // try to parse the left side...
+             Just (a,r) -> Just (LEFT a ,r)
+             Nothing    -> case g r of // if that fails, try to parse the right side
+               Just (a,r) -> Just (RIGHT a ,r)
+               Nothing    -> Nothing
+read{|CONS|} f ["(":s:r] = case f r of
+                Just (a,[")":r]) -> Just(CONS a, r)
+                _                -> Nothing
+read{|CONS|} f [s:r] = case f r of
+                Just (a,r) -> Just(CONS a, r)
+                _          -> Nothing
+read{|CONS|} f _ = Nothing 
+//read{|FIELD|} f r = Nothing
+read{|OBJECT|} f r = case f r of
+              Just(a,r) -> Just(OBJECT a, r)
+              _         -> Nothing
+read{|(,)|} f g ["(":r] = case f r of
+                  Just (a,[",":r]) -> case g r of
+                        Just(b,[")":r]) -> Just ((a,b),r)
+                        _ -> Nothing
+                  _ -> Nothing
+
+
+derive write [], Bin, Coin
+derive read [], Bin, Coin
 
 
 //write{|*|} b c = []
@@ -57,9 +110,10 @@ read{|OBJECT|} f r = Nothing
 // ---
 
 //derive serialize Bool
-instance serialize Bool where
-  write b c = []
-
+/*instance serialize Bool where
+  write b c = write{|*|} b c
+  read r = read{|*|} r
+*/
 /*instance serialize Bool where
   write b c = [toString b:c]
   read list = foldl (match list) Nothing [True, False]
@@ -238,12 +292,14 @@ instance serialize (a,b) | serialize a & serialize b where
 */
 // ---
 
-
-Start = write True
-
+/*
+Start = 
+  [test True
+  ]
+*/
 
 // output looks nice if compiled with "Basic Values Only" for console in project options
-/*Start = 
+Start = 
   [test True
   ,test False
   ,test 0
@@ -264,6 +320,7 @@ Start = write True
   ,["End of the tests.\n"]
   ]
 
+
 test :: a -> [String] | serialize, == a
 test a = 
   (if (isJust r)
@@ -271,11 +328,10 @@ test a =
       (if (isEmpty (tl (snd jr)))
         ["Oke"]
         ["Not all input is consumed! ":snd jr])
-      ["Wrong result: ":write (fst jr) []])
+      ["Wrong result: ":write{|*|} (fst jr) []])
     ["read result is Nothing"]
   ) ++ [", write produces: ": s]
   where
-    s = write a ["\n"]
-    r = read s
+    s = write{|*|} a ["\n"]
+    r = read{|*|} s
     jr = fromJust r
-*/
\ No newline at end of file