module newsGroups

// In this example newsgroups are created and maintained

// User 0 is the manager of the newsgroup who can create new newgroups

// All other users can subscribe to such a newsgroup, commit a message or read news

// (c) mjp 2007

import StdEnv, iTasks, iDataTrivial, iDataFormlib

import iTaskUtil

derive gForm []

derive gUpd []

:: NewsGroups :== [GroupName] // list of newsgroup names

:: GroupName :== String // Name of the newsgroup

:: NewsGroup :== [News] // News stored in a news group

:: News :== (Subscriber,Name,Message) // id, name, and message of the publisher

:: Subscriber :== Int // the id of the publisher

:: Name :== String // the login name of the publisher

:: Message :== String // the message

:: Subscriptions :== [Subscription] // newsgroup subscriptions of user

:: Subscription :== (GroupName,Index) // last message read in corresponding group

:: Index :== Int // 0 <= index < length newsgroup

nmessage = 5

Start world = doHtmlServer (singleUserTask -1 True (assignWork True welcome account myWork)) world

welcome

= [ Txt "This is an iTask demo showing how newsgroups can be created and maintained.",Br,Br

, Txt "Only the site manager can add newsgroups.",Br

, Txt "Any member can subscribe to a newsgroup, and read or commit news",Br,Br

, Txt "Now please login if you are a member or make an account and become a member...",Br,Br]

?>> OK

account v = return_V Void

myWork acc=:(name,unid,_)

| unid == 0 = foreverTask (newsManager acc) // for the root

| otherwise = foreverTask (newsReader acc) // all others

newsManager acc

= chooseTask [("newGroup", addNewsGroup -||- editTask "Cancel" Void)

,("showGroup", showGroup)

,("readNews", newsReader acc)

]

where

addNewsGroup

= [Txt "Define name of new news group:",Br,Br]

?>> editTask "Define" ""

=>> \newName -> readNewsGroups

=>> \oldNames -> writeNewsGroups (removeDup (sort [newName:oldNames]))

#>> return_V Void

showGroup

= (readNewsGroups =>> PDMenu) #>> return_V Void

PDMenu list

= []

?>> editTask "OK" (PullDown (1,100) (0,list))

=>> \value -> return_V (toInt value,toString value)

newsReader acc=:(name,unid,_)

= chooseTask [("subscribe", subscribeNewsGroup unid -||- editTask "Cancel" Void)

,("showNews", readNews unid)

]

where

subscribeNewsGroup :: Subscriber -> Task Void

subscribeNewsGroup me

= readNewsGroups

=>> \groups -> PDMenu groups

=>> \(_,group) -> addSubscription me (group,0)

#>> [Txt "You have subscribed to news group ", B [] group,Br,Br]

?>> OK

readNews :: Subscriber -> Task Void

readNews me

= readSubscriptions me

=>> \mygroups -> PDMenu ([group \\ (group,_) <- mygroups] ++ ["Cancel"])

=>> \(_,group) -> readNews` group

where

readNews` "Cancel" = [Txt "You have not selected a newgroup you are subscribed on!",Br,Br]

?>> OK

readNews` group = [Txt "You are looking at news group ", B [] group, Br, Br]

?>> foreverTask

( readIndex me group

=>> \index -> readNewsGroup group

=>> \news -> showNews index (news%(index,index+nmessage-1)) (length news)

?>> chooseTask

[("<<",readNextNewsItems me (group,index) (~nmessage) (length news))

,("update", return_V Void)

,(">>", readNextNewsItems me (group,index) nmessage (length news))

,("commitNews",commitItem group me)

]

)

-||-

editTask "leaveGroup" Void

readNextNewsItems :: Subscriber Subscription Int Int -> Task Void

readNextNewsItems me (group,index) offset length

# nix = index + offset

# nix = if (nix < 0) 0 (if (length <= nix) index nix)

= addSubscription me (group,nix) #>> return_V Void

commitItem :: GroupName Subscriber -> Task Void

commitItem group me

= [Txt "Type your message ..."]

?>> editTask "Commit" (TextArea 4 80 "") <<@ Submit

=>> \(TextArea _ _ val) -> readNewsGroup group

=>> \news -> writeNewsGroup group (news ++ [(unid,name,val)])

#>> [Txt "Message commited to news group ",B [] group, Br,Br]

?>> OK

OK :: Task Void

OK = editTask "OK" Void

// displaying news groups

showNews ix news nrItems = [STable [Tbl_Border 1, Tbl_Bgcolor (`Colorname Blue)]

[ [B [] "Message nr:", B [] "By:", B [] "Contents:"]

: [ [Txt (showIndex nr),Txt name,Txt (toString info)]

\\ nr <- [ix..] & (who,name,info) <- news

]

]

]

where

showIndex i = ((i+1) +++> " of ") <+++ nrItems

// reading and writing of storages

newsGroupsId :: (DBid NewsGroups)

newsGroupsId = mkDBid "newsGroups"

readerId :: Int -> (DBid Subscriptions)

readerId I = mkDBid ("reader" <+++ i)

groupNameId :: String -> (DBid NewsGroup)

groupNameId name = mkDBid ("NewsGroup-" +++ name)

readNewsGroups :: Task NewsGroups

readNewsGroups = readDB newsGroupsId

writeNewsGroups :: NewsGroups -> Task NewsGroups

writeNewsGroups newgroups = writeDB newsGroupsId newgroups

readSubscriptions :: Subscriber -> Task Subscriptions

readSubscriptions me = readDB (readerId me)

writeSubscriptions :: Subscriber Subscriptions -> Task Subscriptions

writeSubscriptions me subscriptions = writeDB (readerId me) subscriptions

addSubscription :: Subscriber Subscription -> Task Subscriptions

addSubscription me (groupname,index)

# index = if (index < 0) 0 index

= readSubscriptions me

=>> \subscriptions -> writeSubscriptions me [(groupname,index):[(group,index) \\ (group,index) <- subscriptions | group <> groupname]]

readIndex :: Subscriber GroupName -> Task Index

readIndex me groupname

= readSubscriptions me

=>> \subscriptions -> return_V (hds [index \\ (group,index) <- subscriptions | group == groupname])

where

hds [x:xs] = x

hds [] = 0

readNewsGroup :: GroupName -> Task NewsGroup

readNewsGroup groupname = readDB (groupNameId groupname)

writeNewsGroup :: GroupName NewsGroup -> Task NewsGroup

writeNewsGroup groupname news = writeDB (groupNameId groupname) news