implementation module Types import StdInt, StdBool, StdClass, StdArray, StdTuple, StdMisc, StdList import GenVisualize, GenUpdate, GenLexOrd, JSON import Html import Text, Base64, Util import dynamic_string, graph_to_string_with_descriptors, graph_to_sapl_string derive gVisualize EmailAddress, Session derive gUpdate EmailAddress, Session derive gVerify EmailAddress, Session derive gMerge EmailAddress, Currency, FormButton, ButtonState, User, Session, VisualizationHint, UserDetails, Password, Note, Date, Time, DateTime derive JSONEncode EmailAddress, Currency, FormButton, ButtonState, UserDetails, Session, TaskResult, Document, Hidden, Display, Editable, VisualizationHint, Password, Note derive JSONDecode EmailAddress, Currency, FormButton, ButtonState, UserDetails, Session, TaskResult, Document, Hidden, Display, Editable, VisualizationHint, Password, Note derive bimap Maybe, (,) derive gLexOrd Currency initManagerProperties :: ManagerProperties initManagerProperties = { worker = AnyUser , subject = "" , description = "" , context = Nothing , priority = NormalPriority , deadline = Nothing , tags = [] } initGroupedProperties :: GroupedProperties initGroupedProperties = { groupedBehaviour = Fixed , groupActionsBehaviour = IncludeGroupActions } // ****************************************************************************************************** // Document // ****************************************************************************************************** instance == Document where (==) doc0 doc1 = doc0.documentId == doc1.documentId // ****************************************************************************************************** // Password // ****************************************************************************************************** instance == Password where (==) (Password a) (Password b) = a == b // ****************************************************************************************************** // Note // ****************************************************************************************************** instance toString Note where toString (Note s) = s instance toString Password where toString (Password p) = p instance == Note where (==) (Note x) (Note y) = x == y // ****************************************************************************************************** // Date // ****************************************************************************************************** instance < Date where (<) x y | x.Date.year < y.Date.year = True | x.Date.year == y.Date.year && x.Date.mon < y.Date.mon = True | x.Date.year == y.Date.year && x.Date.mon == y.Date.mon && x.Date.day < y.Date.day = True | otherwise = False instance + Date where (+) x y = {Date|year = x.Date.year + y.Date.year, mon = x.Date.mon + y.Date.mon, day = x.Date.day + y.Date.day} instance - Date where (-) x y = {Date|year = x.Date.year - y.Date.year, mon = x.Date.mon - y.Date.mon, day = x.Date.day - y.Date.day} instance toString Date where toString {Date|year,mon,day} = (pad 4 year) +++ "-" +++ (pad 2 mon) +++ "-" +++ (pad 2 day) instance fromString Date where fromString s = {Date|day = toInt (s %(8,9)), mon = toInt (s %(5,6)), year = toInt (s %(0,3))} // ****************************************************************************************************** // Time // ****************************************************************************************************** instance < Time where (<) x y | x.Time.hour < y.Time.hour = True | x.Time.hour == y.Time.hour && x.Time.min < y.Time.min = True | x.Time.hour == y.Time.hour && x.Time.min == y.Time.min && x.Time.sec < y.Time.sec = True | otherwise = False instance + Time where (+) x y = {Time|hour = x.Time.hour + y.Time.hour, min = x.Time.min + y.Time.min, sec = x.Time.sec + y.Time.sec} instance - Time where (-) x y = {Time|hour = x.Time.hour - y.Time.hour, min = x.Time.min - y.Time.min, sec = x.Time.sec - y.Time.sec} instance toString Time where toString {Time|hour,min,sec} = (pad 2 hour) +++ ":" +++ (pad 2 min) +++ ":" +++ (pad 2 sec) instance fromString Time where fromString s = {Time|hour = toInt (s %(0,1)), min = toInt (s %(3,4)), sec = toInt (s %(6,7)) } // ****************************************************************************************************** // DateTime // ****************************************************************************************************** instance + DateTime where (+) (DateTime dx tx) (DateTime dy ty) = DateTime (dx + dy) (tx + ty) instance - DateTime where (-) (DateTime dx tx) (DateTime dy ty) = DateTime (dx - dy) (tx - ty) instance toString DateTime where toString (DateTime d t) = toString d +++ " " +++ toString t instance fromString DateTime where fromString s = DateTime {Date|day = toInt (s %(8,9)), mon = toInt (s %(5,6)), year = toInt (s %(0,3))} {Time|hour = toInt (s %(11,12)), min = toInt (s %(14,15)), sec = toInt (s %(17,18)) } // ****************************************************************************************************** // Currency // ****************************************************************************************************** instance toString Currency where toString (EUR x) = "EUR " +++ decFormat x toString (GBP x) = "GBP " +++ decFormat x toString (USD x) = "USD " +++ decFormat x toString (JPY x) = "JPY " +++ decFormat x instance toInt Currency where toInt (EUR val) = val toInt (GBP val) = val toInt (USD val) = val toInt (JPY val) = val instance < Currency where (<) x y = case x =?= y of LT = True _ = False instance zero Currency where zero = EUR 0 instance + Currency where (+) (EUR x) (EUR y) = EUR (x + y) (+) (GBP x) (GBP y) = GBP (x + y) (+) (USD x) (USD y) = USD (x + y) (+) (JPY x) (JPY y) = JPY (x + y) (+) _ _ = abort "Trying to add money of different currencies!" instance - Currency where (-) (EUR x) (EUR y) = EUR (x - y) (-) (GBP x) (GBP y) = GBP (x - y) (-) (USD x) (USD y) = USD (x - y) (-) (JPY x) (JPY y) = JPY (x - y) (-) _ _ = abort "Trying to subtract money of different currencies!" // ****************************************************************************************************** // User // ****************************************************************************************************** instance toString User where toString user | dname == "" = uname = dname +++ " <" +++ uname +++ ">" where dname = displayName user uname = userName user instance == User where (==) AnyUser AnyUser = True (==) RootUser RootUser = True (==) (NamedUser a) (NamedUser b) = userName (NamedUser a) == userName (NamedUser b) (==) (RegisteredUser a) (RegisteredUser b) = a.userName == b.userName (==) (NamedUser a) (RegisteredUser b) = userName (NamedUser a) == b.userName (==) (RegisteredUser a) (NamedUser b) = a.userName == userName (NamedUser b) (==) (SessionUser a) (SessionUser b) = a == b (==) _ _ = False instance < User where (<) (AnyUser) _ = True (<) (RootUser) (AnyUser) = False (<) (RootUser) _ = True (<) (NamedUser a) (NamedUser b) = a < b (<) (NamedUser a) (RegisteredUser b) = a < b.userName (<) (NamedUser _) (SessionUser _) = True (<) (NamedUser _) _ = False (<) (RegisteredUser a) (NamedUser b) = a.userName < b (<) (RegisteredUser a) (RegisteredUser b) = a.userName < b.userName (<) (RegisteredUser _) (SessionUser _) = True (<) (RegisteredUser _) _ = False (<) _ _ = False JSONEncode{|User|} AnyUser = [JSONString "Any User <>"] JSONEncode{|User|} RootUser = [JSONString "Root User "] JSONEncode{|User|} (RegisteredUser details) = [JSONString (details.displayName+++"<"+++details.userName+++">")] JSONEncode{|User|} (NamedUser username) = [JSONString username] JSONEncode{|User|} (SessionUser session) = [JSONString ("Anonymous User <#"+++session+++">")] JSONDecode{|User|} [JSONString user:json] # uname = extractUserName user | uname == "root" = (Just RootUser, json) | uname == "" = (Just AnyUser, json) | startsWith "#" uname = (Just (SessionUser (uname%(1,size uname))),json) | otherwise = (Just (NamedUser user), json) where extractUserName user | end > start && start > -1 = trim (user % (start + 1, end - 1)) | otherwise = user where start = indexOf "<" user end = indexOf ">" user JSONDecode{|User|} json = (Nothing,json) userName :: !User -> String userName RootUser = "root" userName (NamedUser name) | end > start && start > -1 = name % (start + 1,end - 1) //Named user of form "Joe Smith " (with display name) | otherwise = name //Other named users (without display name) where start = indexOf "<" name end = indexOf ">" name userName (RegisteredUser details) = details.UserDetails.userName userName _ = "" displayName :: !User -> String displayName RootUser = "Root User" displayName (RegisteredUser details) = details.UserDetails.displayName displayName (NamedUser name) | end > start && start > -1 = trim (name % (0,start - 1)) //Named user of form "Joe Smith " (with display name) | otherwise = "" //Other named users (without display name) where start = indexOf "<" name end = indexOf ">" name displayName _ = "" getRoles :: !User -> [Role] getRoles (RegisteredUser details) = mb2list details.roles getRoles _ = [] // ****************************************************************************************************** // Task specialization // ****************************************************************************************************** instance toString TaskPriority where toString LowPriority = "LowPriority" toString NormalPriority = "NormalPriority" toString HighPriority = "HighPriority" instance toString TaskStatus where toString Active = "Active" toString Suspended = "Suspended" toString Finished = "Finished" toString Excepted = "Excepted" toString Deleted = "Deleted" instance == TaskStatus where (==) Active Active = True (==) Suspended Suspended = True (==) Finished Finished = True (==) Excepted Excepted = True (==) Deleted Deleted = True (==) _ _ = False JSONEncode{|Task|} _ t = [JSONString (base64Encode (copy_to_string t))] JSONDecode{|Task|} _ [JSONString string:c] = (Just (fst(copy_from_string {s` \\ s` <-: base64Decode string})) ,c) JSONDecode{|Task|} _ c = (Nothing,c) JSONEncode{|Time|} t = [JSONString (toString t)] JSONEncode{|Date|} d = [JSONString (toString d)] JSONEncode{|DateTime|} dt = [JSONString (toString dt)] JSONDecode{|Time|} [JSONString s:c] = (Just (fromString s), c) JSONDecode{|Time|} c = (Nothing, c) JSONDecode{|Date|} [JSONString s:c] = (Just (fromString s), c) JSONDecode{|Date|} c = (Nothing, c) JSONDecode{|DateTime|} [JSONString s:c] = (Just (fromString s), c) JSONDecode{|DateTime|} c = (Nothing, c) JSONEncode{|(->)|} _ _ f = [JSONString (base64Encode (copy_to_string f))] JSONDecode{|(->)|} _ _ [JSONString string:c] = (Just (fst(copy_from_string {s` \\ s` <-: base64Decode string})) ,c) JSONDecode{|(->)|} _ _ c = (Nothing,c) taskSubject :: !(Task a) -> String taskSubject task = task.taskProperties.subject taskDescription :: !(Task a) -> String taskDescription task = task.taskProperties.description taskUser :: !(Task a) -> User taskUser task = task.taskProperties.worker taskProperties :: !(Task a) -> ManagerProperties taskProperties task = task.taskProperties