3 import 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 :: Task a = Task (*TaskState -> *(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 instance Functor Task where
52 fmap :: (a -> b) (Task a) -> Task b
53 fmap f (Task g) = Task \st.let (x, st1) = g st in (f x, st1)
55 instance Applicative Task where
57 pure x = Task \st.(x, st)
59 (<*>) infixl 4 :: (Task (a -> b)) (Task a) -> Task b
60 (<*>) (Task f) (Task g) = Task \st.let (x, st1) = g st in let (y, st2) = f st1 in (y x, st2)
62 instance Monad Task where
63 bind :: (Task a) (a -> Task b) -> Task b
64 bind (Task f) g = Task \st.let (x, st1) = f st in let (Task y) = g x in y st1
66 eval :: (Task a) *File -> (a, *File) | iTasksLite a
67 eval (Task taskFunc) console
68 # (r, {console}) = taskFunc {store = newMap, console = console}
71 viewInformation :: Description a -> Task a | iTasksLite a
72 viewInformation d x = Task \st=:{console}.(x, {st & console=console <<< d <<< ": " <<< print x <<< ".\n"})
74 enterInformation :: Description -> Task a | iTasksLite a
75 enterInformation d = Task f
78 # (a, console) = freadline (console <<< d <<< ": ")
80 Just x = (x, {st & console=console})
81 Nothing = f {st & console=console <<< "Wrong format, try again.\n"}
83 store :: a (StoreID a) -> Task a | iTasksLite a
84 store v s = Task \st=:{store}.(v, {st & store=store_ v s store})
86 retrieve :: (StoreID a) -> Task a | iTasksLite a
87 retrieve s = Task \st=:{store}.(retrieve_ s store, st)
93 task1 = viewInformation "The answer is" 42
97 enterInformation "Enter the answer"
98 >>= viewInformation "The answer is"
103 >>| retrieve intStore
105 intStore :: StoreID Int
106 intStore = "intStore"
108 task3Fail :: Task Int
109 task3Fail = retrieve intStore
111 intStore :: StoreID Int
112 intStore = "intStore"
121 >>= \ideas -> viewInformation "All ideas" ideas
122 >>| enterInformation "Enter new idea"
123 >>= \idea -> store (ideas ++ [toString (length ideas+1) +++ ". " +++ idea]) ideaStore
126 ideaStore :: StoreID [String]
130 # (console, world) = stdio world
131 console = console <<< "Welcome to iTasksLite" <<< "\n\n"
132 (r, console) = eval task4 console
133 console = console <<< "\n" <<< "The result of the task is " <<< print r <<< ".\n"
134 (_, world) = fclose console world