--- /dev/null
+module a
+
+import StdFunc
+import StdEnv
+import Data.Maybe
+import Data.Func
+import Data.List
+
+import Gast
+
+:: Bin a = Leaf | Bin (Bin a) a (Bin a)
+:: Rose a = Rose a [Rose a]
+
+class serialize a where
+ write :: a [String] -> [String]
+ read :: [String] -> Maybe (a, [String])
+
+instance serialize Bool where
+ write b c = [toString b:c]
+ read ["True":r] = Just (True, r)
+ read ["False":r] = Just (False, r)
+ read _ = Nothing
+
+instance serialize Int where
+ write i c = [toString i:c]
+ read [c:r] = Just (toInt c, r)
+ read _ = Nothing
+
+instance serialize [a] | serialize a where
+ write l c = ["[":foldr write ["]"] l]
+ read ["[":t] = read` t
+ where
+ read` ["]":t] = Just ([], t)
+ read` t = case read t of
+ Nothing = Nothing
+ Just (e, t) = case read` t of
+ Nothing = Nothing
+ Just (es, t) = Just ([e:es], t)
+ read _ = Nothing
+
+instance serialize (Bin a) | serialize a where
+ write Leaf c = ["Leaf":c]
+ write (Bin l a r) c = ["Bin":write l (write a (write r c))]
+ read ["Leaf":t] = Just (Leaf, t)
+ read ["Bin":t] = case read t of
+ Nothing = Nothing
+ Just (l, t) = case read t of
+ Nothing = Nothing
+ Just (a, t) = case read t of
+ Nothing = Nothing
+ Just (r, t) = Just (Bin l a r, t)
+ read _ = Nothing
+
+instance serialize (Rose a) | serialize a where
+ write (Rose a l) c = ["Rose":write a (write l c)]
+ read ["Rose":t] = case read t of
+ Nothing = Nothing
+ Just (a, t) = case read t of
+ Nothing = Nothing
+ Just (l, t) = Just (Rose a l, t)
+ read _ = Nothing
+
+test :: a -> (Bool, [String]) | serialize, ==a
+test a = (isJust r && fst jr == a && isEmpty (tl (snd jr)) , s)
+where
+ s = write a [" \n"]
+ r = read s
+ jr = fromJust r
+
+//Bool , Bin , Rose , Bin Int , Tree , T1 , T2 , T3 , and T4
+//Bool : *
+//Bin : * -> *
+//Rose : * -> *
+//Bin Int : *
+//Tree : * -> * -> *
+//T1 : (* -> *) -> * -> *
+//T2 : (* -> *) -> (* -> *) -> * -> *
+//T3 : (* -> * -> *) -> * -> * -> *
+//T4 : (* -> *) -> (* -> *) -> * -> *
+
+class Container t where
+ Cinsert :: a (t a) -> t a | < a
+ Ccontains :: a (t a) -> Bool | <, Eq a
+ Cshow :: (t a) -> [String] | toString a
+ Cnew :: t a
+
+instance Container [] where
+ Cinsert a l = [a:l]
+ Ccontains a l = isMember a l
+ Cshow l = ["[":intersperse "," (map toString l)] ++ ["]"]
+ Cnew = []
+
+instance Container Bin where
+ Cinsert a Leaf = Bin Leaf a Leaf
+ Cinsert a (Bin l e r)
+ | a <= e = Bin (Cinsert a l) e r
+ = Bin l e (Cinsert a r)
+ Ccontains a Leaf = False
+ Ccontains a (Bin l e r)
+ | a == e = True
+ | a < e = Ccontains a l
+ = Ccontains a r
+ Cshow Leaf = ["Leaf"]
+ Cshow (Bin l a r) = ["Bin (":Cshow l] ++ [") ",toString a," (":Cshow r] ++ [")"]
+ Cnew = Leaf
--- /dev/null
+module a2
+
+import StdEnv
+import StdMaybe
+
+class serialize a where
+ write :: a [String] -> [String]
+ read :: [String] -> Maybe (a, [String])
+
+:: UNIT = UNIT
+:: EITHER a b = LEFT a | RIGHT b
+:: PAIR a b = PAIR a b
+:: CONS a = CONS String a
+
+:: ListG a :== EITHER (CONS UNIT) (CONS (PAIR a [a]))
+
+fromList :: [a] -> ListG a
+fromList [] = LEFT (CONS "Nil" UNIT)
+fromList [x:xs] = RIGHT (CONS "Cons" (PAIR x xs))
+
+toList :: (ListG a) -> [a]
+toList (LEFT (CONS "Nil" UNIT)) = []
+toList (RIGHT (CONS "Cons" (PAIR x xs))) = [x:xs]
+
+:: BinG a :== EITHER (CONS UNIT) (CONS (PAIR (Bin a) (PAIR a (Bin a))))
+:: Bin a = Leaf | Bin (Bin a) a (Bin a)
+
+fromBin :: (Bin a) -> BinG a
+fromBin Leaf = LEFT (CONS "Leaf" UNIT)
+fromBin (Bin l a b) = RIGHT (CONS "Bin" (PAIR l (PAIR a b)))
+
+toBin :: (BinG a) -> Bin a
+toBin (LEFT (CONS "Leaf" UNIT)) = Leaf
+toBin (RIGHT (CONS "Bin" (PAIR l (PAIR a b)))) = Bin l a b
+
+instance serialize Int
+where
+ write i c = [toString i:c]
+ read [i:c] = Just (toInt i, c)
+ read _ = Nothing
+
+instance serialize [a] | serialize a
+where
+ write a c = write (fromList a) c
+ read c = case read c of
+ Just (l, c) = Just (toList l, c)
+ Nothing = Nothing
+
+instance serialize UNIT
+where
+ write UNIT c = ["UNIT":c]
+ read ["UNIT":c] = Just (UNIT, c)
+ read _ = Nothing
+
+instance serialize (EITHER a b) | serialize a & serialize b
+where
+ write (LEFT a) c = ["LEFT":write a c]
+ write (RIGHT a) c = ["RIGHT":write a c]
+ read ["LEFT":c] = case read c of
+ Just (a, c) = Just (LEFT a, c)
+ Nothing = Nothing
+ read ["RIGHT":c] = case read c of
+ Just (a, c) = Just (RIGHT a, c)
+ Nothing = Nothing
+ read _ = Nothing
+
+instance serialize (PAIR a b) | serialize a & serialize b
+where
+ write (PAIR a b) c = ["PAIR":write a (write b c)]
+ read ["PAIR":c] = case read c of
+ Just (a, c) = case read c of
+ Just (b, c) = Just (PAIR a b, c)
+ Nothing = Nothing
+ Nothing = Nothing
+ read _ = Nothing
+
+instance serialize (CONS a) | serialize a
+where
+ write (CONS n a) c = ["CONS",n:write a c]
+ read ["CONS",n:c] = case read c of
+ Just (a, c) = Just (CONS n a, c)
+ Nothing = Nothing
+ read _ = Nothing
+
+Start :: Maybe ([Int], [String])
+Start = read (write (fromList [1,2]) [])
--- /dev/null
+module a2a
+
+import StdEnv
+import StdMaybe
+
+class serialize a where
+ write :: a [String] -> [String]
+ read :: [String] -> Maybe (a, [String])
+
+:: UNIT = UNIT
+:: EITHER a b = LEFT a | RIGHT b
+:: PAIR a b = PAIR a b
+:: CONS a = CONS String a
+
+:: ListG a :== EITHER (CONS UNIT) (CONS (PAIR a [a]))
+
+fromList :: [a] -> ListG a
+fromList [] = LEFT (CONS "Nil" UNIT)
+fromList [x:xs] = RIGHT (CONS "Cons" (PAIR x xs))
+
+toList :: (ListG a) -> [a]
+toList (LEFT (CONS "Nil" UNIT)) = []
+toList (RIGHT (CONS "Cons" (PAIR x xs))) = [x:xs]
+
+:: BinG a :== EITHER (CONS UNIT) (CONS (PAIR (Bin a) (PAIR a (Bin a))))
+:: Bin a = Leaf | Bin (Bin a) a (Bin a)
+
+fromBin :: (Bin a) -> BinG a
+fromBin Leaf = LEFT (CONS "Leaf" UNIT)
+fromBin (Bin l a b) = RIGHT (CONS "Bin" (PAIR l (PAIR a b)))
+
+toBin :: (BinG a) -> Bin a
+toBin (LEFT (CONS "Leaf" UNIT)) = Leaf
+toBin (RIGHT (CONS "Bin" (PAIR l (PAIR a b)))) = Bin l a b
+
+instance serialize Int
+where
+ write i c = [toString i:c]
+ read [i:c] = Just (toInt i, c)
+ read _ = Nothing
+
+instance serialize [a] | serialize a
+where
+ write a c = write (fromList a) c
+ read c = case read c of
+ Just (l, c) = Just (toList l, c)
+ Nothing = Nothing
+
+instance serialize UNIT
+where
+ write UNIT c = c
+ read c = Just (UNIT, c)
+
+instance serialize (EITHER a b) | serialize a & serialize b
+where
+ write (LEFT a) c = write a c
+ write (RIGHT a) c = write a c
+ read c = case read c of
+ Just (a, c) = Just (LEFT a, c)
+ Nothing = case read c of
+ Just (a, c) = Just (RIGHT a, c)
+ Nothing = Nothing
+
+instance serialize (PAIR a b) | serialize a & serialize b
+where
+ write (PAIR a b) c = write a (write b c)
+ read c = case read c of
+ Just (a, c) = case read c of
+ Just (b, c) = Just (PAIR a b, c)
+ Nothing = Nothing
+ Nothing = Nothing
+
+instance serialize (CONS UNIT)
+where
+ write (CONS n UNIT) c = [n:c]
+ read [n:c] = Just (CONS n a, c)
+ read _ = Nothing
+
+instance serialize (CONS a) | serialize a
+where
+ write (CONS n a) c
+ | write a [] == [] = [n:c]
+ = ["(",n:write a [")":c]]
+ read ["(",n:c] = case read c of
+ Just (a, [")":c]) = Just (CONS n a, c)
+ _ = Nothing
+ read [n:c] = case read c of
+ Just (a, c) = Just (CONS n a, c)
+ Nothing = Nothing
+ read _ = Nothing
+
+Start :: (Maybe ([[Int]], [String]), [String])
+Start = (read (write (fromList what) []), write (fromList what) [])
+where
+ what :: [[Int]]
+ what = [[1,2],[1,2,3]]
+
--- /dev/null
+module genericMap\r
+\r
+/*\r
+ Genric map definition for assignment 3 in AFP 2018\r
+ Pieter Koopman, pieter@cs.ru.nl\r
+ September 2018\r
+ \r
+ Use StdEnv or iTask environment.\r
+*/\r
+\r
+import StdEnv, StdGeneric\r
+import Data.GenEq\r
+\r
+generic gMap a b :: a -> b\r
+gMap{|c|} x = x\r
+gMap{|UNIT|} x = x\r
+gMap{|PAIR|} f g (PAIR x y) = PAIR (f x) (g y) \r
+gMap{|EITHER|} f g (LEFT x) = LEFT (f x)\r
+gMap{|EITHER|} f g (RIGHT x) = RIGHT (g x)\r
+gMap{|CONS|} f (CONS x) = CONS (f x)\r
+gMap{|OBJECT|} f (OBJECT x) = OBJECT (f x)\r
+\r
+:: Bin a = Leaf | Bin (Bin a) a (Bin a)\r
+t = Bin (Bin Leaf 1 Leaf) 2 (Bin (Bin Leaf 3 Leaf) 4 Leaf)\r
+l = [1..7]\r
+\r
+fac 0 = 1\r
+fac n = n * fac (dec n)\r
+\r
+derive gMap Bin, [], (,)\r
+\r
+Start =\r
+ ( gMap{|*->*|} fac t\r
+ , gMap{|*->*|} (\i->(i, fac i)) l\r
+ , gMap{|*->*->*|} (gMap{|*->*|} fac) (gMap{|*->*|} fac) (l, t)\r
+ , gEq{|*|} [1,2] [1,2]\r
+ , gEq{|*|} [1,2] [2,3]\r
+ , gEq{|*->*|} (<) [1,2] [2,3]\r
+ )\r
--- /dev/null
+module serialize3Start\r
+\r
+/*\r
+ Definitions for assignment 3 in AFP 2018\r
+ Kind indexed gennerics\r
+ Pieter Koopman, pieter@cs.ru.nl\r
+ September 2018\r
+ \r
+ Use StdEnv or iTask environment.\r
+ Use Basic Values Only as conclose option for a nicer output.\r
+*/\r
+\r
+import StdEnv, StdMaybe\r
+\r
+// use this as serialize for kind *\r
+class serialize a where\r
+ write :: a [String] -> [String]\r
+ read :: [String] -> Maybe (a, [String])\r
+\r
+class serialize1 t where\r
+ write1 :: (a [String] -> [String]) (t a) [String] -> [String]\r
+ read1 :: ([String] -> Maybe (a, [String])) [String] -> Maybe (t a, [String])\r
+\r
+class serialize2 t where\r
+ write2 :: (a [String] -> [String]) (b [String] -> [String]) (t a b) [String] -> [String]\r
+ read2 :: ([String] -> Maybe (a, [String])) ([String] -> Maybe (b, [String])) [String] -> Maybe (t a b, [String])\r
+\r
+// ---\r
+\r
+instance serialize Bool where\r
+ write b c = [toString b:c]\r
+ read ["True":c] = Just (True, c)\r
+ read ["False":c] = Just (False, c)\r
+ read _ = Nothing\r
+\r
+instance serialize Int where\r
+ write i c = [toString i:c]\r
+ read [i:c] = Just (toInt i, c)\r
+ read _ = Nothing\r
+\r
+// ---\r
+\r
+:: UNIT = UNIT\r
+:: EITHER a b = LEFT a | RIGHT b\r
+:: PAIR a b = PAIR a b\r
+:: CONS a = CONS String a\r
+\r
+instance serialize UNIT\r
+where\r
+ write UNIT c = c\r
+ read c = Just (UNIT, c)\r
+\r
+instance serialize2 EITHER\r
+where\r
+ write2 wl _ (LEFT a) c = wl a c\r
+ write2 _ wr (RIGHT a) c = wr a c\r
+ read2 rl rr c = case rl c of\r
+ Just (a, c) = Just (LEFT a, c)\r
+ Nothing = case rr c of\r
+ Just (a, c) = Just (RIGHT a, c)\r
+ Nothing = Nothing\r
+\r
+instance serialize2 PAIR\r
+where\r
+ write2 wl wr (PAIR l r) c = wl l (wr r c)\r
+ read2 rl rr c = case rl c of\r
+ Just (a, c) = case rr c of\r
+ Just (b, c) = Just (PAIR a b, c)\r
+ Nothing = Nothing\r
+ Nothing = Nothing\r
+\r
+instance serialize1 CONS\r
+where\r
+ write1 wa (CONS n a) c = ["(",n:wa a [")":c]]\r
+ read1 ra ["(",n:c] = case ra c of\r
+ Just (a, [")":c]) = Just (CONS n a, c)\r
+ _ = Nothing\r
+ read1 _ _ = Nothing\r
+\r
+// ---\r
+\r
+:: ListG a :== EITHER (CONS UNIT) (CONS (PAIR a [a]))\r
+\r
+fromList :: [a] -> ListG a\r
+fromList [] = LEFT (CONS "Nil" UNIT)\r
+fromList [a:x] = RIGHT (CONS "Cons" (PAIR a x))\r
+\r
+toList :: (ListG a) -> [a]\r
+toList (LEFT (CONS "Nil" UNIT)) = []\r
+toList (RIGHT (CONS "Cons" (PAIR a x))) = [a:x]\r
+\r
+instance serialize1 []\r
+where\r
+ write1 wa a c = write2 (write1 write) (write1 (write2 wa (write1 wa))) (fromList a) c\r
+ read1 ra c = case read2 (read1 read) (read1 (read2 ra (read1 ra))) c of\r
+ Just (a, c) = Just (toList a, c)\r
+ Nothing = Nothing\r
+\r
+// ---\r
+\r
+:: Bin a = Leaf | Bin (Bin a) a (Bin a)\r
+\r
+:: BinG a :== EITHER (CONS UNIT) (CONS (PAIR (Bin a) (PAIR a (Bin a))))\r
+\r
+fromBin :: (Bin a) -> BinG a\r
+fromBin Leaf = LEFT (CONS "Leaf" UNIT)\r
+fromBin (Bin l a r) = RIGHT (CONS "Bin" (PAIR l (PAIR a r)))\r
+\r
+toBin :: (BinG a) -> Bin a\r
+toBin (LEFT (CONS _ UNIT)) = Leaf\r
+toBin (RIGHT (CONS _ (PAIR l (PAIR a r)))) = Bin l a r\r
+\r
+instance == (Bin a) | == a where\r
+ (==) Leaf Leaf = True\r
+ (==) (Bin l a r) (Bin k b s) = l == k && a == b && r == s\r
+ (==) _ _ = False\r
+\r
+instance serialize1 Bin\r
+where\r
+ write1 wa a c = write2 (write1 write) (write1 (write2 (write1 wa) (write2 wa (write1 wa)))) (fromBin a) c\r
+ read1 ra c = case read2 (read1 read) (read1 (read2 (read1 ra) (read2 ra (read1 ra)))) c of\r
+ Just (a, c) = Just (toBin a, c)\r
+ Nothing = Nothing\r
+\r
+// ---\r
+\r
+:: Coin = Head | Tail\r
+:: CoinG :== EITHER (CONS UNIT) (CONS UNIT)\r
+\r
+fromCoin :: Coin -> CoinG\r
+fromCoin Head = LEFT (CONS "Head" UNIT)\r
+fromCoin Tail = RIGHT (CONS "Tail" UNIT)\r
+\r
+toCoin :: CoinG -> Coin\r
+toCoin (LEFT (CONS _ UNIT)) = Head\r
+toCoin (RIGHT (CONS _ UNIT)) = Tail\r
+\r
+instance == Coin where\r
+ (==) Head Head = True\r
+ (==) Tail Tail = True\r
+ (==) _ _ = False\r
+\r
+instance serialize Coin where\r
+ write s c = write2 (write1 write) (write1 write) (fromCoin s) c\r
+ read c = case read2 (read1 read) (read1 read) c of\r
+ Just (a, c) = Just (toCoin a, c)\r
+ Nothing = Nothing\r
+\r
+/*\r
+ Define a special purpose version for this type that writes and reads\r
+ the value (7,True) as ["(","7",",","True",")"]\r
+*/\r
+instance serialize2 (,)\r
+where\r
+ write2 wa wb (a, b) c = ["(":wa a [",":wb b [")":c]]]\r
+ read2 ra rb ["(":c] = case ra c of\r
+ Just (a, [",":c]) = case rb c of\r
+ Just (b, [")":c]) = Just ((a, b), c)\r
+ _ = Nothing\r
+ _ = Nothing\r
+ read2 _ _ _ = Nothing\r
+\r
+instance serialize [a] | serialize a\r
+where\r
+ write a c = write1 write a c\r
+ read c = read1 read c\r
+\r
+instance serialize (Bin a) | serialize a\r
+where\r
+ write a c = write1 write a c\r
+ read c = read1 read c\r
+\r
+instance serialize (a, b) | serialize a & serialize b\r
+where\r
+ write a c = write2 write write a c\r
+ read c = read2 read read c\r
+\r
+// ---\r
+// output looks nice if compiled with "Basic Values Only" for console in project options\r
+Start = \r
+ [test True\r
+ ,test False\r
+ ,test 0\r
+ ,test 123\r
+ ,test -36\r
+ ,test [42]\r
+ ,test [0..4]\r
+ ,test [[True],[]]\r
+ ,test [[[1]],[[2],[3,4]],[[]]]\r
+ ,test (Bin Leaf True Leaf)\r
+ ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin Leaf [4,5] Leaf))]\r
+ ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin (Bin Leaf [4,5] Leaf) [6,7] (Bin Leaf [8,9] Leaf)))]\r
+ ,test Head\r
+ ,test Tail\r
+ ,test (7,True)\r
+ ,test (Head,(7,[Tail]))\r
+ ,["End of the tests.\n"]\r
+ ]\r
+\r
+test :: a -> [String] | serialize, == a\r
+test a = \r
+ (if (isJust r)\r
+ (if (fst jr == a)\r
+ (if (isEmpty (tl (snd jr)))\r
+ ["Oke"]\r
+ ["Not all input is consumed! ":snd jr])\r
+ ["Wrong result: ":write (fst jr) []])\r
+ ["read result is Nothing"]\r
+ ) ++ [", write produces: ": s]\r
+ where\r
+ s = write a ["\n"]\r
+ r = read s\r
+ jr = fromJust r\r
--- /dev/null
+module serializenative\r
+\r
+import StdEnv, StdMaybe, StdGeneric\r
+\r
+class serialize a | read{|*|}, write{|*|} a\r
+\r
+generic write a :: a [String] -> [String]\r
+generic read a :: [String] -> Maybe (a, [String])\r
+\r
+write{|Bool|} b c = [toString b:c]\r
+read{|Bool|} ["True":c] = Just (True, c)\r
+read{|Bool|} ["False":c] = Just (False, c)\r
+read{|Bool|} _ = Nothing\r
+\r
+write{|Int|} i c = [toString i:c]\r
+read{|Int|} [i:c] = Just (toInt i, c)\r
+read{|Int|} _ = Nothing\r
+\r
+write{|UNIT|} UNIT c = c\r
+read{|UNIT|} c = Just (UNIT, c)\r
+\r
+write{|EITHER|} wl _ (LEFT a) c = wl a c\r
+write{|EITHER|} _ wr (RIGHT a) c = wr a c\r
+read{|EITHER|} rl rr c = case rl c of\r
+ Just (a, c) = Just (LEFT a, c)\r
+ Nothing = case rr c of\r
+ Just (a, c) = Just (RIGHT a, c)\r
+ Nothing = Nothing\r
+\r
+write{|PAIR|} wl wr (PAIR l r) c = wl l (wr r c)\r
+read{|PAIR|} rl rr c = case rl c of\r
+ Just (a, c) = case rr c of\r
+ Just (b, c) = Just (PAIR a b, c)\r
+ Nothing = Nothing\r
+ Nothing = Nothing\r
+\r
+write{|CONS of {gcd_name}|} wa (CONS a) c = ["(",gcd_name:wa a [")":c]]\r
+read{|CONS|} ra ["(",n:c] = case ra c of\r
+ Just (a, [")":c]) = Just (CONS a, c)\r
+ _ = Nothing\r
+read{|CONS|} _ _ = Nothing\r
+\r
+write{|OBJECT|} wa (OBJECT a) c = wa a c\r
+read{|OBJECT|} ra c = case ra c of\r
+ Just (a, c) = Just (OBJECT a, c)\r
+ _ = Nothing\r
+\r
+:: Bin a = Leaf | Bin (Bin a) a (Bin a)\r
+\r
+instance == (Bin a) | == a where\r
+ (==) Leaf Leaf = True\r
+ (==) (Bin l a r) (Bin k b s) = l == k && a == b && r == s\r
+ (==) _ _ = False\r
+\r
+:: Coin = Head | Tail\r
+\r
+instance == Coin where\r
+ (==) Head Head = True\r
+ (==) Tail Tail = True\r
+ (==) _ _ = False\r
+\r
+derive class serialize Coin, Bin, (,), []\r
+\r
+// output looks nice if compiled with "Basic Values Only" for console in project options\r
+Start = \r
+ [test True\r
+ ,test False\r
+ ,test 0\r
+ ,test 123\r
+ ,test -36\r
+ ,test [42]\r
+ ,test [0..4]\r
+ ,test [[True],[]]\r
+ ,test [[[1]],[[2],[3,4]],[[]]]\r
+ ,test (Bin Leaf True Leaf)\r
+ ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin Leaf [4,5] Leaf))]\r
+ ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin (Bin Leaf [4,5] Leaf) [6,7] (Bin Leaf [8,9] Leaf)))]\r
+ ,test Head\r
+ ,test Tail\r
+ ,test (7,True)\r
+ ,test (Head,(7,[Tail]))\r
+ ,["End of the tests.\n"]\r
+ ]\r
+\r
+test :: a -> [String] | serialize, == a\r
+test a = \r
+ (if (isJust r)\r
+ (if (fst jr == a)\r
+ (if (isEmpty (tl (snd jr)))\r
+ ["Oke"]\r
+ ["Not all input is consumed! ":snd jr])\r
+ ["Wrong result: ":write{|*|} (fst jr) []])\r
+ ["read result is Nothing"]\r
+ ) ++ [", write produces: ": s]\r
+ where\r
+ s = write{|*|} a ["\n"]\r
+ r = read{|*|} s\r
+ jr = fromJust r\r
--- /dev/null
+module skeleton4\r
+\r
+import iTasks\r
+\r
+/*\r
+ Pieter Koopman, pieter@cs.ru.nl\r
+ Advanced Programming. Skeleton for assignment 4 in 2018\r
+ - use this a project with environment iTasks\r
+ - executable must be in Examples/iTasks or a subdirectory\r
+ You can also use the -sdk commandline flag to set the path\r
+*/\r
+\r
+:: Student =\r
+ { name :: String\r
+ , snum :: Int\r
+ , bama :: BaMa\r
+ , year :: Int\r
+ }\r
+\r
+:: BaMa = Bachelor | Master\r
+\r
+students :: [Student]\r
+students =\r
+ [{name = "Alice"\r
+ ,snum = 1000\r
+ ,bama = Master\r
+ ,year = 1\r
+ }\r
+ ,{name = "Bob"\r
+ ,snum = 1003\r
+ ,bama = Master\r
+ ,year = 1\r
+ }\r
+ ,{name = "Carol"\r
+ ,snum = 1024\r
+ ,bama = Master\r
+ ,year = 2\r
+ }\r
+ ,{name = "Dave"\r
+ ,snum = 2048\r
+ ,bama = Master\r
+ ,year = 1\r
+ }\r
+ ,{name = "Eve"\r
+ ,snum = 4096\r
+ ,bama = Master\r
+ ,year = 1\r
+ }\r
+ ,{name = "Frank"\r
+ ,snum = 1023\r
+ ,bama = Master\r
+ ,year = 1\r
+ }\r
+ ]\r
+\r
+student :: Student\r
+student = students !! 0\r
+\r
+derive class iTask Student, BaMa\r
+derive gToString Student, BaMa\r
+\r
+generic gToString a :: a -> String\r
+gToString{|Int|} i = toString i\r
+gToString{|String|} s = s\r
+gToString{|UNIT|} _ = ""\r
+gToString{|RECORD|} fx (RECORD x) = "{" + fx x + "}"\r
+gToString{|FIELD of {gfd_name}|} fx (FIELD x) = gfd_name + "=" + fx x + " "\r
+gToString{|PAIR|} fx fy (PAIR x y) = fx x + fy y\r
+gToString{|EITHER|} fx fy (LEFT x) = fx x\r
+gToString{|EITHER|} fx fy (RIGHT y) = fy y\r
+gToString{|CONS of {gcd_name}|} fx (CONS x) = gcd_name + fx x\r
+gToString{|OBJECT|} fx (OBJECT x) = fx x\r
+\r
+instance + String where + s t = s +++ t\r
+\r
+Start w = doTasks (changeName student) w\r
+\r
+enterStudent :: Task Student\r
+enterStudent = enterInformation "Enter a student" []\r
+\r
+enterStudentList :: Task [Student]\r
+enterStudentList = enterInformation "Enter a student" []\r
+\r
+updateStudent :: (Student -> Task Student)\r
+updateStudent = updateInformation "Update a student" []\r
+\r
+selectStudent :: ([Student] -> Task Student)\r
+selectStudent = enterChoice "Pick a student" []\r
+\r
+selectStudentOnlyName :: ([Student] -> Task Student)\r
+selectStudentOnlyName = enterChoice "Pick a student" [ChooseFromDropdown \s->s.Student.name]\r
+\r
+selectStudentFormat :: ([Student] -> Task Student)\r
+selectStudentFormat = enterChoice "Pick a student" [ChooseFromDropdown gToString{|*|}]\r
+\r
+selectPartner :: ([Student] -> Task [Student])\r
+selectPartner = enterMultipleChoice "Pick a partner" [ChooseFromDropdown \s->s.Student.name + "(" + gToString{|*|} s.Student.bama + ")"]\r
+\r
+changeName :: Student -> Task Student\r
+changeName s\r
+ = viewInformation "Student to change" [] s\r
+ ||- updateInformation "New name" [UpdateAs (\s->s.Student.name) (\s n->{Student | s & name=n})] s\r
+\r
+changeNameEdcomb :: Student -> Task Student\r
+changeNameEdcomb s\r
+ = updateInformation "New name" [UpdateUsing id (\_ v->v) studed] s\r
+where\r
+ studed :: Editor Student\r
+ studed = bijectEditorValue\r
+ (\s->(s.Student.name, s.snum, s.bama, s.year))\r
+ (\(n,s,b,y)->{name=n,snum=s,bama=b,year=y})\r
+ (container4\r
+ gEditor{|*|}\r
+ (withChangedEditMode toView gEditor{|*|})\r
+ (withChangedEditMode toView gEditor{|*|})\r
+ (withChangedEditMode toView gEditor{|*|})\r
+ )\r
+ toView (Update a) = View a\r
+ toView v = v\r
repositories / clean-tests.git / commitdiff