From: Mart Lubbers Date: Fri, 5 Oct 2018 11:40:08 +0000 (+0200) Subject: afp X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=9e76dc6627279fc2a754ef4a0482fe5b4da209ec;p=clean-tests.git afp --- diff --git a/afp/a1/a.icl b/afp/a1/a.icl new file mode 100644 index 0000000..6912af5 --- /dev/null +++ b/afp/a1/a.icl @@ -0,0 +1,105 @@ +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 diff --git a/afp/a2/a2.icl b/afp/a2/a2.icl new file mode 100644 index 0000000..19a9973 --- /dev/null +++ b/afp/a2/a2.icl @@ -0,0 +1,86 @@ +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]) []) diff --git a/afp/a2/a2a.icl b/afp/a2/a2a.icl new file mode 100644 index 0000000..436c05d --- /dev/null +++ b/afp/a2/a2a.icl @@ -0,0 +1,97 @@ +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]] + diff --git a/afp/a3/genericMap.icl b/afp/a3/genericMap.icl new file mode 100644 index 0000000..b574f0d --- /dev/null +++ b/afp/a3/genericMap.icl @@ -0,0 +1,39 @@ +module genericMap + +/* + Genric map definition for assignment 3 in AFP 2018 + Pieter Koopman, pieter@cs.ru.nl + September 2018 + + Use StdEnv or iTask environment. +*/ + +import StdEnv, StdGeneric +import Data.GenEq + +generic gMap a b :: a -> b +gMap{|c|} x = x +gMap{|UNIT|} x = x +gMap{|PAIR|} f g (PAIR x y) = PAIR (f x) (g y) +gMap{|EITHER|} f g (LEFT x) = LEFT (f x) +gMap{|EITHER|} f g (RIGHT x) = RIGHT (g x) +gMap{|CONS|} f (CONS x) = CONS (f x) +gMap{|OBJECT|} f (OBJECT x) = OBJECT (f x) + +:: Bin a = Leaf | Bin (Bin a) a (Bin a) +t = Bin (Bin Leaf 1 Leaf) 2 (Bin (Bin Leaf 3 Leaf) 4 Leaf) +l = [1..7] + +fac 0 = 1 +fac n = n * fac (dec n) + +derive gMap Bin, [], (,) + +Start = + ( gMap{|*->*|} fac t + , gMap{|*->*|} (\i->(i, fac i)) l + , gMap{|*->*->*|} (gMap{|*->*|} fac) (gMap{|*->*|} fac) (l, t) + , gEq{|*|} [1,2] [1,2] + , gEq{|*|} [1,2] [2,3] + , gEq{|*->*|} (<) [1,2] [2,3] + ) diff --git a/afp/a3/serialize3Start.icl b/afp/a3/serialize3Start.icl new file mode 100644 index 0000000..de82ffb --- /dev/null +++ b/afp/a3/serialize3Start.icl @@ -0,0 +1,213 @@ +module serialize3Start + +/* + Definitions for assignment 3 in AFP 2018 + Kind indexed gennerics + Pieter Koopman, pieter@cs.ru.nl + September 2018 + + Use StdEnv or iTask environment. + Use Basic Values Only as conclose option for a nicer output. +*/ + +import StdEnv, StdMaybe + +// use this as serialize for kind * +class serialize a where + write :: a [String] -> [String] + read :: [String] -> Maybe (a, [String]) + +class serialize1 t where + write1 :: (a [String] -> [String]) (t a) [String] -> [String] + read1 :: ([String] -> Maybe (a, [String])) [String] -> Maybe (t a, [String]) + +class serialize2 t where + write2 :: (a [String] -> [String]) (b [String] -> [String]) (t a b) [String] -> [String] + read2 :: ([String] -> Maybe (a, [String])) ([String] -> Maybe (b, [String])) [String] -> Maybe (t a b, [String]) + +// --- + +instance serialize Bool where + write b c = [toString b:c] + read ["True":c] = Just (True, c) + read ["False":c] = Just (False, c) + read _ = Nothing + +instance serialize Int where + write i c = [toString i:c] + read [i:c] = Just (toInt i, c) + read _ = Nothing + +// --- + +:: UNIT = UNIT +:: EITHER a b = LEFT a | RIGHT b +:: PAIR a b = PAIR a b +:: CONS a = CONS String a + +instance serialize UNIT +where + write UNIT c = c + read c = Just (UNIT, c) + +instance serialize2 EITHER +where + write2 wl _ (LEFT a) c = wl a c + write2 _ wr (RIGHT a) c = wr a c + read2 rl rr c = case rl c of + Just (a, c) = Just (LEFT a, c) + Nothing = case rr c of + Just (a, c) = Just (RIGHT a, c) + Nothing = Nothing + +instance serialize2 PAIR +where + write2 wl wr (PAIR l r) c = wl l (wr r c) + read2 rl rr c = case rl c of + Just (a, c) = case rr c of + Just (b, c) = Just (PAIR a b, c) + Nothing = Nothing + Nothing = Nothing + +instance serialize1 CONS +where + write1 wa (CONS n a) c = ["(",n:wa a [")":c]] + read1 ra ["(",n:c] = case ra c of + Just (a, [")":c]) = Just (CONS n a, c) + _ = Nothing + read1 _ _ = Nothing + +// --- + +:: ListG a :== EITHER (CONS UNIT) (CONS (PAIR a [a])) + +fromList :: [a] -> ListG a +fromList [] = LEFT (CONS "Nil" UNIT) +fromList [a:x] = RIGHT (CONS "Cons" (PAIR a x)) + +toList :: (ListG a) -> [a] +toList (LEFT (CONS "Nil" UNIT)) = [] +toList (RIGHT (CONS "Cons" (PAIR a x))) = [a:x] + +instance serialize1 [] +where + write1 wa a c = write2 (write1 write) (write1 (write2 wa (write1 wa))) (fromList a) c + read1 ra c = case read2 (read1 read) (read1 (read2 ra (read1 ra))) c of + Just (a, c) = Just (toList a, c) + Nothing = Nothing + +// --- + +:: Bin a = Leaf | Bin (Bin a) a (Bin a) + +:: BinG a :== EITHER (CONS UNIT) (CONS (PAIR (Bin a) (PAIR a (Bin a)))) + +fromBin :: (Bin a) -> BinG a +fromBin Leaf = LEFT (CONS "Leaf" UNIT) +fromBin (Bin l a r) = RIGHT (CONS "Bin" (PAIR l (PAIR a r))) + +toBin :: (BinG a) -> Bin a +toBin (LEFT (CONS _ UNIT)) = Leaf +toBin (RIGHT (CONS _ (PAIR l (PAIR a r)))) = Bin l a r + +instance == (Bin a) | == a where + (==) Leaf Leaf = True + (==) (Bin l a r) (Bin k b s) = l == k && a == b && r == s + (==) _ _ = False + +instance serialize1 Bin +where + write1 wa a c = write2 (write1 write) (write1 (write2 (write1 wa) (write2 wa (write1 wa)))) (fromBin a) c + read1 ra c = case read2 (read1 read) (read1 (read2 (read1 ra) (read2 ra (read1 ra)))) c of + Just (a, c) = Just (toBin a, c) + Nothing = Nothing + +// --- + +:: Coin = Head | Tail +:: CoinG :== EITHER (CONS UNIT) (CONS UNIT) + +fromCoin :: Coin -> CoinG +fromCoin Head = LEFT (CONS "Head" UNIT) +fromCoin Tail = RIGHT (CONS "Tail" UNIT) + +toCoin :: CoinG -> Coin +toCoin (LEFT (CONS _ UNIT)) = Head +toCoin (RIGHT (CONS _ UNIT)) = Tail + +instance == Coin where + (==) Head Head = True + (==) Tail Tail = True + (==) _ _ = False + +instance serialize Coin where + write s c = write2 (write1 write) (write1 write) (fromCoin s) c + read c = case read2 (read1 read) (read1 read) c of + Just (a, c) = Just (toCoin a, c) + Nothing = Nothing + +/* + Define a special purpose version for this type that writes and reads + the value (7,True) as ["(","7",",","True",")"] +*/ +instance serialize2 (,) +where + write2 wa wb (a, b) c = ["(":wa a [",":wb b [")":c]]] + read2 ra rb ["(":c] = case ra c of + Just (a, [",":c]) = case rb c of + Just (b, [")":c]) = Just ((a, b), c) + _ = Nothing + _ = Nothing + read2 _ _ _ = Nothing + +instance serialize [a] | serialize a +where + write a c = write1 write a c + read c = read1 read c + +instance serialize (Bin a) | serialize a +where + write a c = write1 write a c + read c = read1 read c + +instance serialize (a, b) | serialize a & serialize b +where + write a c = write2 write write a c + read c = read2 read read c + +// --- +// output looks nice if compiled with "Basic Values Only" for console in project options +Start = + [test True + ,test False + ,test 0 + ,test 123 + ,test -36 + ,test [42] + ,test [0..4] + ,test [[True],[]] + ,test [[[1]],[[2],[3,4]],[[]]] + ,test (Bin Leaf True Leaf) + ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin Leaf [4,5] Leaf))] + ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin (Bin Leaf [4,5] Leaf) [6,7] (Bin Leaf [8,9] Leaf)))] + ,test Head + ,test Tail + ,test (7,True) + ,test (Head,(7,[Tail])) + ,["End of the tests.\n"] + ] + +test :: a -> [String] | serialize, == a +test a = + (if (isJust r) + (if (fst jr == a) + (if (isEmpty (tl (snd jr))) + ["Oke"] + ["Not all input is consumed! ":snd jr]) + ["Wrong result: ":write (fst jr) []]) + ["read result is Nothing"] + ) ++ [", write produces: ": s] + where + s = write a ["\n"] + r = read s + jr = fromJust r diff --git a/afp/a3/serializenative.icl b/afp/a3/serializenative.icl new file mode 100644 index 0000000..3671da3 --- /dev/null +++ b/afp/a3/serializenative.icl @@ -0,0 +1,98 @@ +module serializenative + +import StdEnv, StdMaybe, StdGeneric + +class serialize a | read{|*|}, write{|*|} a + +generic write a :: a [String] -> [String] +generic read a :: [String] -> Maybe (a, [String]) + +write{|Bool|} b c = [toString b:c] +read{|Bool|} ["True":c] = Just (True, c) +read{|Bool|} ["False":c] = Just (False, c) +read{|Bool|} _ = Nothing + +write{|Int|} i c = [toString i:c] +read{|Int|} [i:c] = Just (toInt i, c) +read{|Int|} _ = Nothing + +write{|UNIT|} UNIT c = c +read{|UNIT|} c = Just (UNIT, c) + +write{|EITHER|} wl _ (LEFT a) c = wl a c +write{|EITHER|} _ wr (RIGHT a) c = wr a c +read{|EITHER|} rl rr c = case rl c of + Just (a, c) = Just (LEFT a, c) + Nothing = case rr c of + Just (a, c) = Just (RIGHT a, c) + Nothing = Nothing + +write{|PAIR|} wl wr (PAIR l r) c = wl l (wr r c) +read{|PAIR|} rl rr c = case rl c of + Just (a, c) = case rr c of + Just (b, c) = Just (PAIR a b, c) + Nothing = Nothing + Nothing = Nothing + +write{|CONS of {gcd_name}|} wa (CONS a) c = ["(",gcd_name:wa a [")":c]] +read{|CONS|} ra ["(",n:c] = case ra c of + Just (a, [")":c]) = Just (CONS a, c) + _ = Nothing +read{|CONS|} _ _ = Nothing + +write{|OBJECT|} wa (OBJECT a) c = wa a c +read{|OBJECT|} ra c = case ra c of + Just (a, c) = Just (OBJECT a, c) + _ = Nothing + +:: Bin a = Leaf | Bin (Bin a) a (Bin a) + +instance == (Bin a) | == a where + (==) Leaf Leaf = True + (==) (Bin l a r) (Bin k b s) = l == k && a == b && r == s + (==) _ _ = False + +:: Coin = Head | Tail + +instance == Coin where + (==) Head Head = True + (==) Tail Tail = True + (==) _ _ = False + +derive class serialize Coin, Bin, (,), [] + +// output looks nice if compiled with "Basic Values Only" for console in project options +Start = + [test True + ,test False + ,test 0 + ,test 123 + ,test -36 + ,test [42] + ,test [0..4] + ,test [[True],[]] + ,test [[[1]],[[2],[3,4]],[[]]] + ,test (Bin Leaf True Leaf) + ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin Leaf [4,5] Leaf))] + ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin (Bin Leaf [4,5] Leaf) [6,7] (Bin Leaf [8,9] Leaf)))] + ,test Head + ,test Tail + ,test (7,True) + ,test (Head,(7,[Tail])) + ,["End of the tests.\n"] + ] + +test :: a -> [String] | serialize, == a +test a = + (if (isJust r) + (if (fst jr == a) + (if (isEmpty (tl (snd jr))) + ["Oke"] + ["Not all input is consumed! ":snd jr]) + ["Wrong result: ":write{|*|} (fst jr) []]) + ["read result is Nothing"] + ) ++ [", write produces: ": s] + where + s = write{|*|} a ["\n"] + r = read{|*|} s + jr = fromJust r diff --git a/afp/a4/skeleton4.icl b/afp/a4/skeleton4.icl new file mode 100644 index 0000000..af496b7 --- /dev/null +++ b/afp/a4/skeleton4.icl @@ -0,0 +1,119 @@ +module skeleton4 + +import iTasks + +/* + Pieter Koopman, pieter@cs.ru.nl + Advanced Programming. Skeleton for assignment 4 in 2018 + - use this a project with environment iTasks + - executable must be in Examples/iTasks or a subdirectory + You can also use the -sdk commandline flag to set the path +*/ + +:: Student = + { name :: String + , snum :: Int + , bama :: BaMa + , year :: Int + } + +:: BaMa = Bachelor | Master + +students :: [Student] +students = + [{name = "Alice" + ,snum = 1000 + ,bama = Master + ,year = 1 + } + ,{name = "Bob" + ,snum = 1003 + ,bama = Master + ,year = 1 + } + ,{name = "Carol" + ,snum = 1024 + ,bama = Master + ,year = 2 + } + ,{name = "Dave" + ,snum = 2048 + ,bama = Master + ,year = 1 + } + ,{name = "Eve" + ,snum = 4096 + ,bama = Master + ,year = 1 + } + ,{name = "Frank" + ,snum = 1023 + ,bama = Master + ,year = 1 + } + ] + +student :: Student +student = students !! 0 + +derive class iTask Student, BaMa +derive gToString Student, BaMa + +generic gToString a :: a -> String +gToString{|Int|} i = toString i +gToString{|String|} s = s +gToString{|UNIT|} _ = "" +gToString{|RECORD|} fx (RECORD x) = "{" + fx x + "}" +gToString{|FIELD of {gfd_name}|} fx (FIELD x) = gfd_name + "=" + fx x + " " +gToString{|PAIR|} fx fy (PAIR x y) = fx x + fy y +gToString{|EITHER|} fx fy (LEFT x) = fx x +gToString{|EITHER|} fx fy (RIGHT y) = fy y +gToString{|CONS of {gcd_name}|} fx (CONS x) = gcd_name + fx x +gToString{|OBJECT|} fx (OBJECT x) = fx x + +instance + String where + s t = s +++ t + +Start w = doTasks (changeName student) w + +enterStudent :: Task Student +enterStudent = enterInformation "Enter a student" [] + +enterStudentList :: Task [Student] +enterStudentList = enterInformation "Enter a student" [] + +updateStudent :: (Student -> Task Student) +updateStudent = updateInformation "Update a student" [] + +selectStudent :: ([Student] -> Task Student) +selectStudent = enterChoice "Pick a student" [] + +selectStudentOnlyName :: ([Student] -> Task Student) +selectStudentOnlyName = enterChoice "Pick a student" [ChooseFromDropdown \s->s.Student.name] + +selectStudentFormat :: ([Student] -> Task Student) +selectStudentFormat = enterChoice "Pick a student" [ChooseFromDropdown gToString{|*|}] + +selectPartner :: ([Student] -> Task [Student]) +selectPartner = enterMultipleChoice "Pick a partner" [ChooseFromDropdown \s->s.Student.name + "(" + gToString{|*|} s.Student.bama + ")"] + +changeName :: Student -> Task Student +changeName s + = viewInformation "Student to change" [] s + ||- updateInformation "New name" [UpdateAs (\s->s.Student.name) (\s n->{Student | s & name=n})] s + +changeNameEdcomb :: Student -> Task Student +changeNameEdcomb s + = updateInformation "New name" [UpdateUsing id (\_ v->v) studed] s +where + studed :: Editor Student + studed = bijectEditorValue + (\s->(s.Student.name, s.snum, s.bama, s.year)) + (\(n,s,b,y)->{name=n,snum=s,bama=b,year=y}) + (container4 + gEditor{|*|} + (withChangedEditMode toView gEditor{|*|}) + (withChangedEditMode toView gEditor{|*|}) + (withChangedEditMode toView gEditor{|*|}) + ) + toView (Update a) = View a + toView v = v