Commit 6be8ff74 authored by Mart Lubbers's avatar Mart Lubbers

import examples

parent f3926d01
Pipeline #12475 passed with stage
in 3 minutes and 12 seconds
module EnterListOfInt
// Enter a list of Integer numbers
import iTasks
Start :: *World -> *World
Start world
= startEngine enterListOfInt world
enterListOfInt :: Task [Int]
enterListOfInt
= enterInformation "Enter a list of Integer numbers:" []
>>= viewInformation "You Entered:" []
>>= return
\ No newline at end of file
module EnterDateAndTime
// Enter a list of dates and a times
import iTasks
import iTasks.Extensions.DateTime
Start :: *World -> *World
Start world
= startEngine enterDateTime world
enterDateTime :: Task [(Date, Time)]
enterDateTime
= enterInformation "Enter a date and time" []
>>= viewInformation "You Entered:" []
>>= return
module GoogleMap
// Enter a Google Map position
import iTasks
import iTasks.Extensions.GIS.GoogleMap
Start :: *World -> *World
Start world
= startEngine googleMap world
googleMap :: Task GoogleMap
googleMap
= enterInformation "Enter a Google map:" []
>>= viewInformation "You entered:" [ViewAs (gText{|*|} AsMultiLine o Just)]
>>= return
\ No newline at end of file
module Enter_Text
// Enter a text string in a text area
import iTasks
Start :: *World -> *World
Start world
= startEngine enterText world
enterText :: Task String
enterText
= enterInformation "Enter a text:" [EnterUsing id textArea]
>>= viewInformation "You entered:" [ViewUsing id textArea]
>>= return
module Enter_Integer
// Enter an Integer Number
import iTasks
Start :: *World -> *World
Start world
= startEngine enterInt world
enterInt :: Task Int
enterInt
= enterInformation "Enter an Integer number:" []
>>= viewInformation "You entered:" []
>>= return
module Hello_World
// Just displaying a message to welcome you.
import iTasks
Start :: *World -> *World
Start world
= startEngine helloWorld world
helloWorld :: Task String
helloWorld
= viewInformation "You have a message from iTasks:" [] "Hello world!"
module EnterFamily
// Enter a family tree using a record type
import iTasks
import iTasks.Extensions.DateTime
:: Family = { person :: Person
, married :: Maybe Person
, children :: [Family]
}
:: Person = { firstName :: String
, surName :: String
, gender :: Gender
, dateOfBirth :: Date
}
:: Gender = Male
| Female
derive class iTask Family, Person, Gender
Start :: *World -> *World
Start world
= startEngine enterFamily world
enterFamily :: Task Family
enterFamily
= enterInformation "Enter a family tree:" []
>>= viewInformation "You Entered:" []
>>= return
module EnterPerson
// Enter a family tree using a record type
import iTasks
import iTasks.Extensions.DateTime
:: Person = { name :: String
, gender :: Gender
, dateOfBirth :: Date
}
:: Gender = Male
| Female
derive class iTask Person, Gender
Start :: *World -> *World
Start world
= startEngine enterPerson world
enterPerson :: Task Person
enterPerson
= enterInformation "Enter a person:" []
>>= viewInformation "You Entered:" []
>>= return
module BrowseAndViewGoogleMap
// Browse a Google map while viewing it
import iTasks
import iTasks.Extensions.GIS.GoogleMap
Start :: *World -> *World
Start world
= startEngine browseAndViewGoogleMap world
browseAndViewGoogleMap :: Task GoogleMap
browseAndViewGoogleMap
= withShared defaultValue // create shared default value for the map
(\smap -> updateSharedInformation "Browse Map" [] smap // update it here
-||
viewSharedInformation "View Browsing Map" [] smap ) // while viewing it here
>>= viewInformation "Resulting map looks as follows" [] // show final result
>>= return // and return
\ No newline at end of file
module CurrentDateAndTime
// Just show the current date and time which are offered in a share
// Next the current time is displayed in the view of an analog clock
import iTasks
import iTasks.Extensions.DateTime
import iTasks.Extensions.Clock
Start :: *World -> *World
Start world
= startEngine showDateAndTime world
showDateAndTime :: Task Time
showDateAndTime
= viewSharedInformation "The current Date and Time is:" [] currentDateTime
>>| viewSharedInformation "The current time is:" [ViewAs AnalogClock] currentTime
>>= return
module UpdateSharedPersonsAndView
import iTasks
Start :: *World -> *World
Start world
= startEngine enterSharedPersons world
// Update a shared list of persons while viewing its content
:: Person =
{ name :: String
, gender :: Gender
, dateOfBirth :: Date
}
:: Gender = Male | Female
derive class iTask Person, Gender
enterSharedPersons :: Task [Person]
enterSharedPersons
= withShared [] // create an empty shared list
\sharedList -> updateSharedInformation "Modify the Shared List of Persons:" [] sharedList // update that list
-||
viewSharedInformation "Current Content of this Shared List:" [] sharedList // while showing that list
<<@ ApplyLayout horizontal // show both list next to each other (default is below)
>>= viewInformation "The List contains the following:" [] // show the final result
>>= return // done
where
horizontal = setUIAttributes (directionAttr Horizontal)
\ No newline at end of file
module SharedNoteAsList
// Update a shared note in a text area and as list
import iTasks
import Text
Start :: *World -> *World
Start world
= startEngine sharedNoteAsList world
sharedNoteAsList :: Task String
sharedNoteAsList
= withShared "" doEditor
where
doEditor state
= updateSharedInformation ("Text","Edit text") [noteEditor] state
-||-
updateSharedInformation ("Lines","Edit lines") [listEditor] state
<<@ ApplyLayout horizontal
>>= viewInformation "Result:" []
>>= return
noteEditor = UpdateUsing id (const id) textArea
listEditor = UpdateAs (split "\n") (\_ l -> join "\n" l)
horizontal = setUIAttributes (directionAttr Horizontal)
\ No newline at end of file
module SharedNotes
// Two updates on shared string and one view on it
import iTasks
Start :: *World -> *World
Start world
= startEngine SharedNotes world
// Update and view shared notifications
SharedNotes :: Task String
SharedNotes
= withShared "" // create an initial empty shared string
(\note -> viewSharedInformation "View on note" [ViewUsing id textArea] note // one to view the resulting string
-||-
( updateSharedInformation "Update shared note 1" [UpdateUsing id (const id) textArea] note // an editor to update the shared string
-||-
updateSharedInformation "Update shared note 2" [UpdateUsing id (const id) textArea] note // and an other updating editor
<<@ ApplyLayout horizontal
)
)
>>= viewInformation "Resulting string is:" [ViewUsing id textArea]
>>= return
where
horizontal = setUIAttributes (directionAttr Horizontal)
\ No newline at end of file
module optionsChat
import iTasks
import iTasks.UI.Definition
import iTasks.Extensions.Admin.UserAdmin
import iTasks.Extensions.DateTime
import iTasks.Extensions.Document
adminTask :== "Admin/"
Start :: *World -> *World
Start world
= startEngine multiUserExample world
multiUserExample
= set (map mkUserAccount logins) userAccounts
>>| viewInformation "Login under one of the following names (password = login name)" []
(foldl (+++) "" (map (\n -> n +++ ", ") logins))
-||-
viewInformation "and then Select \"new\" to create a new Task..." [] ""
>>| loginAndManageWorkList "Chat_4_2 Example" [workflow "chat with options" "chat with options" genChat]
where
mkUserAccount name
= { credentials = { username = Username name, password = Password name}, title = Nothing, roles = ["manager"] }
// -------------------------------------------------------------------------
// List of users administrated:
logins = ["bob","alice","carol","dave"]
// ---------------------
:: ChatOptions
= Text String
| DocWithText (Document, String)
| Chats [ChatMsg ChatOptions]
:: ChatMsg a
= { time :: Time
, user :: String
, message :: a
}
derive class iTask ChatOptions, ChatMsg
genChat :: Task [ChatMsg ChatOptions]
genChat = createChatSession myChat updateChat
createChatSession :: (Task a) (User a -> Task b) -> Task [b] | iTask a & iTask b
createChatSession enter update
= get currentUser
>>= \me -> enterMultipleChoiceWithShared ("select chatters") [ChooseFromCheckGroup id] users
>>= \others -> withShared [] (startChats enter update [me:others])
where
startChats :: (Task a) (User a -> Task b) [User] (Shared [b]) -> Task [b] | iTask a & iTask b
startChats enter update chatters chatStore
= allTasks[(user,foldl (+++) "" (map toString chatters)) @: chatWith user enter update chatStore \\ user <- chatters]
>>| get chatStore
chatWith :: User (Task a) (User a -> Task b) (Shared [b]) -> Task () | iTask a & iTask b
chatWith me enter update chatStore
= viewSharedInformation ("Chat History:") [] chatStore
||-
oneChat
where
oneChat
= enter
>>* [ OnAction (Action "Send") (hasValue send)
, OnAction (Action "Quit") (always (return ()))
]
send nchat
= update me nchat
>>= \new -> upd (\chats -> chats ++ [new]) chatStore
>>| oneChat
myChat
= enterChoice "select message kind" [] ["Text","Doc + Text","NewChat"]
>>= \sel -> case sel of
"Text" -> oneChat @ Text o ((+++) "\t")
"Doc + Text" -> oneChat @ DocWithText
"NewChat" -> genChat @ Chats
where
oneChat :: Task a | iTask a
oneChat = enterInformation "Type in a message: " []
updateChat :: User a -> Task (ChatMsg a) | iTask a
updateChat user chat
= get currentTime
>>= \time -> return {time = time, user = toString user, message = chat}
module Chat
import iTasks
import iTasks.Extensions.Admin.UserAdmin
import iTasks.Extensions.Admin.WorkflowAdmin
Start :: *World -> *World
Start world
= startEngine multiUserExample world
multiUserExample
= set (map mkUserAccount players) userAccounts
>>| viewInformation "Login under one of the following names (password = login name)" []
(foldl (+++) "" (map (\n -> n +++ ", ") players))
-||-
viewInformation "and then Select \"new\" to create a new Task..." [] ""
>>| loginAndManageWorkList "Chat_4_2 Example" [workflow "chat" "chat" myExample]
where
mkUserAccount name
= { credentials = { username = Username name, password = Password name}, title = Nothing, roles = ["manager"] }
// -------------------------------------------------------------------------
// Simple MultiUser Chat Application for 2 users
players = ["bob","alice","carol","dave"]
myExample
= createChatSession enter update
where
enter :: Task String
enter = enterInformation "Type in a message" []
update :: User String -> Task String
update user chat = return (toString user +++ " says : " +++ chat)
createChatSession :: (Task a) (User a -> Task b) -> Task [b] | iTask a & iTask b
createChatSession enter update
= get currentUser
>>= \me -> enterMultipleChoiceWithShared ("select chatters") [ChooseFromCheckGroup id] users
>>= \others -> withShared [] (startChats enter update [me:others])
startChats :: (Task a) (User a -> Task b) [User] (Shared [b]) -> Task [b] | iTask a & iTask b
startChats enter update chatters chatStore
= allTasks[(user, "chat") @: chatWith user enter update chatStore \\ user <- chatters]
>>| get chatStore
chatWith :: User (Task a) (User a -> Task b) (Shared [b]) -> Task () | iTask a & iTask b
chatWith me enter update chatStore
= viewSharedInformation ("Chat History:") [] chatStore
||-
oneChat
where
oneChat
= enter
>>* [ OnAction (Action "Send") (hasValue send)
, OnAction (Action "Quit") (always (return ()))
]
send nchat
= update me nchat
>>= \new -> upd (\chats -> chats ++ [new]) chatStore
>>| oneChat
module MeetingDate
import iTasks
import iTasks.Extensions.Admin.UserAdmin
import iTasks.Extensions.Admin.WorkflowAdmin
import iTasks.Extensions.DateTime
import iTasks.UI.Editor.Common
Start :: *World -> *World
Start world
= startEngine multiUserExample world
multiUserExample
= set (map mkUserAccount players) userAccounts
>>| viewInformation "Login under one of the following names (password = login name)" []
(foldl (+++) "" (map (\n -> n +++ ", ") players))
-||-
viewInformation "and then Select \"new\" to create a new Task..." [] ""
>>| loginAndManageWorkList "Meeting_4_3 Example" [workflow "Meeting date" "Determine meeting date" myExample]
where
mkUserAccount name
= { credentials = { username = Username name, password = Password name}, title = Nothing, roles = ["manager"] }
// -------------------------------------------------------------------------
// Enquire what a suitable a meeting date would be
players = ["bob","alice","carol","dave"]
myExample
= DefineMeetingPurpose
>>= \purpose -> SelectDatesToPropose
>>= \dates -> SelectAttendencees
>>= \others -> AskOthers purpose others dates
:: DateOption
= { date :: Date
, hour :: Int
, minute :: Int
}
:: MeetingOption
= { users :: [String]
, date :: DateOption
}
derive class iTask DateOption, MeetingOption
DefineMeetingPurpose :: Task String
DefineMeetingPurpose
= enterInformation "What is the purpose of the meeting?" []
SelectDatesToPropose :: Task [DateOption]
SelectDatesToPropose
= enterInformation "Select the date(s) and time you propose to meet..." []
SelectAttendencees :: Task [User]
SelectAttendencees
= enterMultipleChoiceWithShared ("Who do you want to invite for the meeting?") [ChooseFromCheckGroup id] users
AskOthers :: String [User] [DateOption] -> Task MeetingOption
AskOthers purpose others dates
= withShared makeTable askAll
where
makeTable :: [MeetingOption]
makeTable
= [{users = [], date = date} \\ date <- dates]
askAll :: (Shared [MeetingOption]) -> Task MeetingOption
askAll table
= allTasks[(user, purpose) @: checkOptions (toString user) \\ user <- others]
>>- \_ -> enterChoiceWithShared "Select the date for the meeting:" [ChooseFromGrid id] table
>>= viewInformation "Date chosen:" []
where
checkOptions user
= viewSharedInformation "Current Responses:" [] table
||-
enterMultipleChoice "Select the date(s) you can attend the meeting (ctrl alt):" [ChooseFromGrid (\i -> dates!!i)] [0..length dates - 1]
>>= \ids -> upd (\table -> [{t & users = if (isMember j ids) [user:t.users] t.users} \\ j <- [0..] & t <- table]) table
\ No newline at end of file
module tinyTextEditor
// A tiny editor with two windows, one to replace test, one to show statistical information
import iTasks
import Text, Data.Maybe
Start :: *World -> *World
Start world
= startEngine editWithStatistics world
:: Statistics = { lineCount :: Int
, wordCount :: Int
}
:: Replace = { search :: String
, replaceBy :: Maybe String
}
initReplace = { search = "", replaceBy = Nothing}
derive class iTask Statistics, Replace
editWithStatistics :: Task ()
editWithStatistics
= enterInformation "Give name of text file you want to edit..." []
>>= \fileName -> let file = sharedStore fileName ""
in editFile fileName file
-||-