Commit 3c9f88a5 authored by Steffen Michels's avatar Steffen Michels

introduce >-| as abbreviation for '>>- \_ ->'

parent e78e2b49
Pipeline #19606 passed with stage
in 4 minutes and 43 seconds
......@@ -806,7 +806,7 @@ where
importJSONDocument doc
>>- \actions ->
set actions userActionCatalog
>>- \_ -> viewInformation () [] "Succesfully imported action catalog" @! ()
>-| viewInformation () [] "Succesfully imported action catalog" @! ()
) (\e -> viewInformation "Failed import action catalog" [] e @! ())
) <<@ Title "Import actions"
where
......
......@@ -496,19 +496,19 @@ addContactPhoto contactNo original
= withTemporaryDirectory
\tmp ->
exportDocument (tmp</>"orig.jpg") original
>>- \_ ->
>-|
callProcess "Creating thumbnail..." [] CONVERT_BIN
["-define","jpeg:size=400x400",(tmp</>"orig.jpg"),"-thumbnail","200x200^","-gravity","center","-extent","200x200",(tmp</>"thumb.png")] Nothing Nothing
>>- \_ ->
>-|
importDocument (tmp</>"thumb.png")
>>- \thumb ->
callProcess "Creating avatar..." [] CONVERT_BIN
["-define","jpeg:size=100x100",(tmp</>"orig.jpg"),"-thumbnail","50x50^","-gravity","center","-extent","50x50",(tmp</>"avatar.png")] Nothing Nothing
>>- \_ ->
>-|
importDocument (tmp</>"avatar.png")
>>- \avatar -> let photo = {ContactPhoto|original = original, thumb = thumb, avatar = avatar} in
upd (\photos -> 'DM'.put contactNo [photo:fromMaybe [] ('DM'.get contactNo photos)] photos) allContactPhotos
>>- \_ ->
>-|
logContactPhotoAdded contactNo photo
@! photo
......@@ -526,7 +526,7 @@ createCommunicationMean contactNo mean=:{NewCommunicationMean|type,phoneNo,callS
sqlExecute db ["allCommunicationMeans"] (execInsert "INSERT INTO CommunicationMean (type) VALUES (?)" (toSQL type))
>>- \id ->
sqlExecute db [] (execInsert "INSERT INTO communicationMeans1_communicationMeans2 (communicationMeans1,communicationMeans2) VALUES (?,?)" (toSQL id ++ toSQL contactNo))
>>- \_ -> case type of
>-| case type of
CMPhone = sqlExecute db [] (execInsert "INSERT INTO Telephone (id,phoneNo) VALUES (?,?)" (toSQL id ++ mbToSQL phoneNo))
CMVHF = sqlExecute db [] (execInsert "INSERT INTO VHFRadio (id,callSign,mmsi) VALUES (?,?,?)" (toSQL id ++ mbToSQL callSign ++ mbToSQL mmsi))
CMEmail = sqlExecute db [] (execInsert "INSERT INTO EmailAccount (id,emailAddress) VALUES (?,?)" (toSQL id ++ mbToSQL emailAddress))
......@@ -537,7 +537,7 @@ deleteCommunicationMean id
= get databaseDef
>>- \db ->
sqlExecute db ["allCommunicationMeans"] (execDelete "DELETE FROM communicationMeans1_communicationMeans2 WHERE communicationMeans1 = ? " (toSQL id))
>>- \_ ->
>-|
allTasks [sqlExecute db [] (execDelete ("DELETE FROM " +++ table +++" WHERE id = ? ") (toSQL id)) \\ table <-
["CommunicationMean","Telephone","VHFRadio","EmailAccount","P2000Receiver"]]
@! ()
......
......@@ -18,10 +18,10 @@ generateTestIncident closed
get (sdsFocus "Watch officers" contactsWithGroupShort) >>- randomChoice
>>- \wo ->
linkContactsToIncident [vesselNo,wo.ContactShort.contactNo] incidentNo
>>- \_ ->
>-|
//Create first call
createFirstCall vesselNo wo incidentNo
>>- \_ ->
>-|
if closed (closeIncident incidentNo @! incidentNo) (return incidentNo)
where
makeupTroubleVessel :: IncidentType -> Task NewContact
......@@ -50,7 +50,7 @@ where
= createCommunication RadioCall In (Just caller)
>>- \communicationNo ->
upd update (sdsFocus communicationNo communicationDetailsByNo)
>>- \_ ->
>-|
logCommunicationResponded communicationNo
@! communicationNo
where
......
......@@ -153,7 +153,7 @@ where
importUsers = doOrClose (
enterInformation instructions []
>>= \doc -> catchAll (
importContactsFromCSVFile doc >>- \_ -> viewInformation () [] "Succesfully imported contacts" >>| return ()
importContactsFromCSVFile doc >-| viewInformation () [] "Succesfully imported contacts" >>| return ()
) (\_ -> viewInformation "Failed to import contacts" [] ())
) <<@ Title "Import contacts"
where
......@@ -254,7 +254,7 @@ where
importJSONDocument doc
>>- \config ->
set config webLinksConfig
>>- \_ -> viewInformation () [] "Succesfully imported web links" @! ()
>-| viewInformation () [] "Succesfully imported web links" @! ()
) (\e -> viewInformation "Failed import of web links" [] e @! ())
) <<@ Title "Import web links"
where
......
......@@ -39,7 +39,7 @@ where
/*
>>- \now -> let updateTime = nextUpdate now in
waitForTime updateTime
>>- \_ -> let fileName = (contentDir </> updatesFile updateTime) in
>-| let fileName = (contentDir </> updatesFile updateTime) in
importTextFile fileName
>>- \content ->
injectAISUpdates fileName (split "\n" content)
......
......@@ -71,8 +71,8 @@ where
= [{users = [], date = date} \\ date <- dates]
askAll table
= allTasks[(user, purpose) @: checkOptions (toString user) \\ user <- others]
>>- \_ -> enterChoiceWithShared "Select the date for the meeting:" [ChooseFromGrid id] 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
......
......@@ -19,7 +19,7 @@ derive gEq EndEvent, FailReason, FailedAssertion, CounterExample, Relation
compileTestModule :: CleanModuleName -> Task EndEvent
compileTestModule (path,name)
= copyFile prjDefaultPath prjPath
>>- \_ -> get cpmExecutable
>-| get cpmExecutable
>>- \cpm -> runWithOutput cpm [prjPath] Nothing //Build the test
@ \(c,o) -> if (passed c o)
{name = testName, event = Passed, message = join "" o}
......
......@@ -205,7 +205,7 @@ where
= get tonicServerShare
>>- \ts -> get currentDateTime
>>- \cdt -> upd ('DM'.put cdt ts.ts_recordingBuffer) recordingsShare
>>- \_ -> upd (\ts -> {ts & ts_recording = False}) tonicServerShare @! ()
>-| upd (\ts -> {ts & ts_recording = False}) tonicServerShare @! ()
refreshAction :: TaskCont a (Task ())
refreshAction = OnAction (Action "Refresh") (always startViewer)
......
......@@ -54,6 +54,16 @@ tbind :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
*/
(>>-) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
/**
* Combines two tasks sequentially but continues only when the first task has a stable value.
*
* @param First: The first task to be executed
* @param Second: The second task
* @return The combined task
* @type (Task a) (Task b) -> Task b | iTask a & iTask b
*/
(>-|) infixl 1
(>-|) x y :== x >>- \_ -> y
/**
* Combines two tasks sequentially but continues only when the first task has a value.
*
* @param First: The first task to be executed
......
......@@ -104,7 +104,7 @@ sequence tasks = foreverStIf
foreverStIf :: (a -> Bool) a !(a -> Task a) -> Task a | iTask a
foreverStIf pred st t = parallel [(Embedded, par st Nothing)] [] @? fromParValue
where
par st (Just tid) tlist = removeTask tid tlist >>- \_->par st Nothing tlist
par st (Just tid) tlist = removeTask tid tlist >-| par st Nothing tlist
par st Nothing tlist
| not (pred st) = treturn st
= step
......
......@@ -217,13 +217,13 @@ where
get state @ (\{InspectState|moduleName,lines} -> (moduleName,join OS_NEWLINE lines))
>>- \(moduleName,sourceCode) ->
prepareBuildFiles temporaryDirectory moduleName sourceCode
>>- \_ -> runBuildTool temporaryDirectory moduleName
>>- \_ -> setExecutable temporaryDirectory moduleName state
>-| runBuildTool temporaryDirectory moduleName
>-| setExecutable temporaryDirectory moduleName state
@! ()
where
prepareBuildFiles directory moduleName sourceCode
= exportTextFile (directory </> addExtension moduleName "icl") sourceCode
>>- \_ -> exportTextFile (directory </> addExtension moduleName "prj") (projectTemplate moduleName)
= exportTextFile (directory </> addExtension moduleName "icl") sourceCode
>-| exportTextFile (directory </> addExtension moduleName "prj") (projectTemplate moduleName)
runBuildTool directory moduleName
= get cpmExecutable
......@@ -239,7 +239,7 @@ where
>>- maybe (throw "Cannot run the program. There is no executable yet")
(\executable ->
makeExecutable executable
>>- \_ -> callProcess () [ViewAs view] executable ["-port","8084"] (Just temporaryDirectory) Nothing
>-| callProcess () [ViewAs view] executable ["-port","8084"] (Just temporaryDirectory) Nothing
>>* [OnAction ActionClose (always (return ()))] //Pause after command...
)
) @! ()
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment