old/booking/Booking.icl

   1 module Booking
   2
   3 import iTasks
   4 import Data.List
   5
   6 :: List a :== [a]
   7
   8 view label value :== viewInformation label [] value
   9 edit label value :== updateInformation label [] value
  10 fill label       :== enterInformation label []
  11
  12 share label value :== sharedStore label value
  13 watch label store :== viewSharedInformation label [] store
  14
  15 ok :== const True
  16
  17 // (>>+) :: Task a -> List ( a -> Bool, a -> Task b ) -> Task b
  18 (>>+) infixl 1
  19 (>>+) task options :== task >>* map trans options
  20 where
  21     trans ( p, t ) = OnValue (ifValue p t)
  22
  23 // (>>-) :: Task a -> (a -> Task b) -> Task b
  24 (>>-) infixl 1
  25 (>>-) task cont = task >>+ [ ( ok, cont ) ]
  26
  27 // (>>|) :: Task a -> Task b -> Task b
  28 (>>|) infixl 1
  29 (>>|) task next = task >>- \_ -> next
  30
  31 // (>>?) :: Task a -> List ( String, a -> Bool, a -> Task b ) -> Task b
  32 (>>?) infixl 1
  33 (>>?) task options :== task >>* map trans options
  34 where
  35     trans ( a, p, t ) = OnAction (Action a) (ifValue p t)
  36
  37
  38 // Data ////////////////////////////////////////////////////////////////////////
  39
  40 :: Seat = Seat Row Pos
  41 :: Row :== Int
  42 :: Pos :== Char
  43
  44 :: Person =
  45     { first_name :: String
  46     , last_name :: String
  47     , age :: Int
  48     }
  49
  50 :: Booking =
  51     { passengers :: List Person
  52     , flight_no :: String
  53     , seats :: List Seat
  54     }
  55
  56
  57 // Stores //////////////////////////////////////////////////////////////////////
  58
  59 free_seat_store :: Shared (List Seat)
  60 free_seat_store = share "Free seats" [ Seat r p \\ r <- [1..6], p <- ['A'..'D'] ]
  61
  62
  63 // Checks //////////////////////////////////////////////////////////////////////
  64
  65 // Tasks ///////////////////////////////////////////////////////////////////////
  66
  67 removeElems :: (List a) (List a) -> List a | iTask a
  68 removeElems xs ys =
  69     []
  70     // [ y \\ y <- ys, x <- xs | y =!= x ]
  71     // filter (\x -> not (elem x ys)) ys
  72
  73 choose_seats :: Int -> Task (List Seat)
  74 choose_seats n =
  75     enterMultipleChoiceWithShared "Pick a seat" [] free_seat_store >>?
  76         [ ( "Continue"
  77           , \seats -> True//length seats == n
  78           , \seats -> upd (removeElems seats) free_seat_store >>| return seats
  79           )
  80         ]
  81
  82 main :: Task (List Seat)
  83 main =
  84     (forever (watch "Free seats" free_seat_store >>* [OnAction (Action "Refresh") (always (treturn ()))]))
  85         ||-
  86     (choose_seats 2 >>- view "Chosen seats")
  87
  88
  89 // Boilerplate /////////////////////////////////////////////////////////////////
  90
  91 derive class iTask Seat, Person, Booking
  92
  93 Start :: *World -> *World
  94 Start world = startEngine main world