a5/mart/a5.icl

   1 module a5
   2 // Mart Lubbers s4109503
   3 // Charlie Gerhardus s3050009
   4
   5 import iTasks
   6
   7 :: ProtoIdea = {idea :: String, details :: Maybe Note}
   8 :: Idea = {number :: Int, idea :: String, details :: Maybe Note, user :: Name,
   9         likes :: Int}
  10 :: Name:== String
  11
  12 derive class iTask Idea, ProtoIdea
  13
  14 instance == Idea where
  15         (==) x y = x.Idea.number == y.Idea.number
  16
  17 ideas :: Shared [Idea]
  18 ideas = sharedStore "Ideas" []
  19
  20 storeIdea :: Name ProtoIdea -> Idea
  21 storeIdea n x=:{ProtoIdea | idea,details} =
  22         {Idea | user=n, idea=idea, details=details, likes=0, number=0}
  23
  24 addNewIdea :: Name -> Task [Idea]
  25 addNewIdea name = enterInformation "Add new idea" [EnterWith (storeIdea name)]
  26         >>* [OnAction ActionOk (hasValue (\v.return v))]
  27         >>= \n.upd (\is.is ++ [{n & number=length is}]) ideas
  28
  29 likeIdea :: Idea [Idea] -> [Idea]
  30 likeIdea i x = let (ind, y) = removeIndex i x in
  31         insertAt ind {i & likes=i.likes+1} y
  32
  33 deleteIdea :: Idea [Idea] -> [Idea]
  34 deleteIdea i x = let (ind, y) = removeIndex i x in
  35         let (b, g) = splitAt ind y in b ++ (map (\z.{z & number=z.number-1}) g)
  36
  37 viewList :: Name -> Task [Idea]
  38 viewList name = (enterChoiceWithShared "Idea collection" [] ideas)
  39         >&^ viewSharedInformation "Selected idea" []
  40         >>* [OnAction ActionOk (hasValue (\_.get ideas)),
  41                 OnAction (Action "Delete All" [ActionIcon "delete"])
  42                         (always (upd (\_.[]) ideas)),
  43                 OnAction ActionDelete (hasValue (\v.upd (deleteIdea v) ideas)),
  44                 OnAction (Action "Like" [])
  45                         (ifValue (\x=:{user}.user <> name) (\v.upd (likeIdea v) ideas))]
  46
  47 mainTask = enterInformation "What is your username?" []
  48         >>= \name.forever ((addNewIdea name -|| forever (viewList name)))
  49
  50 Start :: *World -> *World
  51 Start world = startEngine mainTask world