a6/mart/skeleton6b.icl

   1 module skeleton6b
   2
   3 import StdList, StdInt, StdChar, StdMisc, StdClass, StdString, StdFile, StdArray, Data.Maybe, Data.Map, Control.Monad, Data.Tuple, Data.Void
   4 import qualified Text
   5 from Text import class Text, instance Text String
   6
   7 class print a :: a -> String
   8
   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)
  13
  14 class parse a :: String -> Maybe a
  15
  16 instance parse Void where parse _ = Just Void
  17
  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
  22         parse s
  23                 # len = size s
  24                 | len > 0
  25                         # s = if (select s (len-1) == '\n') (s % (0, len - 2)) s // remove newline
  26                         # i = toInt s
  27                         | toString i == s
  28                                 = Just i
  29                         = Nothing
  30
  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)
  32
  33 class iTasksLite a | print a & parse a & TC a
  34
  35 :: Description   :== String
  36 :: StoreID a     :== String
  37 :: Task a        = // define type here
  38 :: *TaskState    = { console :: !*File
  39                    , store   :: Map String Dynamic
  40                    }
  41
  42 store_ :: a (StoreID a) (Map String Dynamic) -> Map String Dynamic | TC a
  43 store_ v sid store = put sid (dynamic v) store
  44
  45 retrieve_ :: (StoreID a) (Map String Dynamic) -> a | TC a
  46 retrieve_ sid store = case get sid store of
  47     Just (a :: a^) = a
  48     Just _         = abort "type error\n"
  49     Nothing        = abort "empty store\n"
  50
  51 instance Functor Task where
  52     fmap :: (a -> b) (Task a) -> Task b
  53     fmap _ _ = undef
  54
  55 instance Applicative Task where
  56     pure :: a -> Task a
  57     pure _ = undef
  58
  59     (<*>) infixl 4  :: (Task (a -> b)) (Task a) -> Task b
  60     (<*>) _ _ = undef
  61
  62 instance Monad Task where
  63     bind :: (Task a) (a -> Task b) -> Task b
  64     bind _ _ = undef
  65
  66 eval :: (Task a) *File -> (a, *File) | iTasksLite a
  67 eval (Task taskFunc) console
  68     # (r, {console}) = taskFunc {store = newMap, console = console}
  69     = (r, console)
  70
  71 task0 :: Task Int
  72 task0 = return 42
  73
  74 /*task1 :: Task Int
  75 task1 = viewInformation "The answer is" 42
  76
  77 task2 :: Task Int
  78 task2 =
  79      enterInformation "Enter the answer"
  80  >>= viewInformation "The answer is"
  81
  82 task3 :: Task Int
  83 task3 =
  84         store 1 intStore
  85     >>| retrieve intStore
  86 where
  87     intStore :: StoreID Int
  88     intStore = "intStore"
  89
  90 task3Fail :: Task Int
  91 task3Fail = retrieve intStore
  92 where
  93     intStore :: StoreID Int
  94     intStore = "intStore"
  95
  96 task4 :: Task Void
  97 task4 =
  98         store [] ideaStore
  99     >>| addIdea
 100 where
 101     addIdea =
 102                       retrieve ideaStore
 103         >>= \ideas -> viewInformation "All ideas" ideas
 104         >>|           enterInformation "Enter new idea"
 105         >>= \idea  -> store (ideas ++ [toString (length ideas+1) +++ ". " +++ idea]) ideaStore
 106         >>|           addIdea
 107
 108     ideaStore :: StoreID [String]
 109     ideaStore = "ideas"*/
 110
 111 Start world
 112  #      (console, world) = stdio world
 113         console                  = console <<< "Welcome to iTasksLite" <<< "\n\n"
 114     (r, console)     = eval task0 console
 115     console          = console <<< "\n" <<< "The result of the task is " <<< print r <<< ".\n"
 116         (_, world)           = fclose console world
 117  = world
 118