3 import StdTuple, StdList, StdInt, StdChar, StdMisc, StdClass, StdString, StdFile, StdArray, Data.Maybe, Data.Map, Control.Monad, Data.Tuple, Data.Void
5 from Text import class Text, instance Text String
7 class print a :: a -> String
9 instance print Void where print _ = "Void"
10 instance print String where print s = s
11 instance print Int where print i = toString i
12 instance print [a] | print a where print l = 'Text'.join ", " (map print l)
14 class parse a :: String -> Maybe a
16 instance parse Void where parse _ = Just Void
18 instance parse String where
19 parse s = let len = size s
20 in Just (if (select s (len-1) == '\n') (s % (0, len - 2)) s) // remove newline
21 instance parse Int where
25 # s = if (select s (len-1) == '\n') (s % (0, len - 2)) s // remove newline
31 instance parse [a] | parse a where parse s = foldr (\xs list -> maybe Nothing (\e -> fmap (\l -> [e:l]) list) (parse xs)) (Just []) ('Text'.split "," s)
33 class iTasksLite a | print a & parse a & TC a
35 :: Description :== String
36 :: StoreID a :== String
37 :: *TaskResult a :== (a, TaskState)
38 :: *TaskState = { console :: !*File
39 , store :: Map String Dynamic
42 store_ :: a (StoreID a) (Map String Dynamic) -> Map String Dynamic | TC a
43 store_ v sid store = put sid (dynamic v) store
45 retrieve_ :: (StoreID a) (Map String Dynamic) -> a | TC a
46 retrieve_ sid store = case get sid store of
48 Just _ = abort "type error\n"
49 Nothing = abort "empty store\n"
51 viewInformation :: Description a TaskState -> TaskResult a | iTasksLite a
52 viewInformation d a ts=:{console} =
53 (a, {ts & console=console <<< d <<< ": " <<< print a <<< ".\n"})
55 enterInformation :: Description TaskState -> TaskResult a | iTasksLite a
56 enterInformation d ts=:{console}
57 # (a, console) = freadline (console <<< d <<< ": ")
59 Just x = (x, {ts & console=console})
60 Nothing = enterInformation d {ts & console=console <<< "Wrong format, try again.\n"}
62 store :: a (StoreID a) TaskState -> TaskResult a | iTasksLite a
63 store v s ts=:{store} = (v, {ts & store=store_ v s store})
65 retrieve :: (StoreID a) TaskState -> TaskResult a | iTasksLite a
66 retrieve s ts=:{store} = (retrieve_ s store, ts)
68 eval :: (TaskState -> TaskResult a) *File -> (a, *File) | iTasksLite a
70 # (r, st) = taskFunc ({store = newMap, console = console})
73 task0 :: TaskState -> TaskResult Int
76 // The type is surrounded by parenthesis because its a constant that happens to
78 task1 :: (TaskState -> TaskResult Int)
79 task1 = viewInformation "The answer is" 42
81 task2 :: TaskState -> TaskResult Int
83 # (x, st) = enterInformation "Enter the answer" st
84 = viewInformation "The answer is" x st
86 task3 :: TaskState -> TaskResult Int
88 # (_, st) = store 1 intStore st
89 = retrieve intStore st
91 intStore :: StoreID Int
94 task3Fail :: TaskState -> TaskResult Int
95 task3Fail st = retrieve intStore st
97 intStore :: StoreID Int
100 task3TypeFail :: TaskState -> TaskResult Int
101 task3TypeFail st = retrieve intStore (snd (store "1" stringStore st))
103 intStore :: StoreID Int
104 intStore = "intStore"
105 stringStore :: StoreID String
106 stringStore = "intStore"
108 // This gives a heap full error, because the console is never queried it just
109 // continues. The strictness enforced the immediate query of the console.
110 task4 :: TaskState -> TaskResult Void
112 # (_, st) = store [] ideaStore st
116 # (ideas, st) = retrieve ideaStore st
117 (_, st) = viewInformation "All ideas" ideas st
118 (idea, st) = enterInformation "Enter new idea" st
119 (_, st) = store (ideas ++ [toString (length ideas+1) +++ ". " +++ idea]) ideaStore st
122 ideaStore :: StoreID [String]
126 # (console, world) = stdio world
127 console = console <<< "Welcome to iTasksLite\n\n"
128 (r, console) = eval task3 console
129 console = console <<< "\nThe result of the task is " <<< print r <<< ".\n"
130 (_, world) = fclose console world