Commit 11e97ff5 authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'master' into 202-malfunctioning-dropdowns

parents 8e4cf248 bb9d4d00
......@@ -72,6 +72,18 @@ where
choices = ["string" +++ toString i\\i<-[0..20]]
```
## Panels
In some cases, such as when you apply a title, the user interface is automatically lifted to a panel.
However, this can also be done manually with the option of making the panel fullscreenable.
```clean
toPanel :: Bool -> Layout
:: InPanel = InPanel Bool
```
If the boolean flag is set to true, the panel includes a small icon (![](Libraries/iTasks/UI/WebPublic/css/icons/fullscreen.png)) on the bottom right that, when clicked, makes the panel full screen.
If the small icon is clicked again, the panel shrinks back to the original size again.
## Conclusion
In this guide we have shown how you how to decorate tasks with layout combinators so that you can change the way they appear in the client.
......
......@@ -32,14 +32,14 @@ actionStatusesByIncident :: ROShared IncidentNo [(InstanceNo,InstanceNo,ActionSt
actionStatusesByIncident = sdsSplit "actionStatusesByIncident" (\p -> ((),p)) read write actionStatuses
where
read instanceNo is = filter (filterFun instanceNo) is
write _ _ _ = ((),const False)
write _ _ _ = ((),const (const False))
filterFun instanceNo (_,_,{ActionStatus|incidents}) = isMember instanceNo incidents
actionStatusesByContact :: ROShared ContactNo [(InstanceNo,InstanceNo,ActionStatus)]
actionStatusesByContact = sdsSplit "actionStatusesByContact" (\p -> ((),p)) read write actionStatuses
where
read contactNo is = filter (filterFun contactNo) is
write _ _ _ = ((),const False)
write _ _ _ = ((),const (const False))
filterFun contactNo (_,_,{ActionStatus|contacts}) = isMember contactNo contacts
actionStatusesOfCurrentContact :: ROShared () [(InstanceNo,InstanceNo,ActionStatus)]
......
......@@ -571,7 +571,7 @@ where
ReadWriteShared ([(Bool,ContactGeo)], Maybe (Either ContactNo MMSI), ContactMapPerspective) (Maybe (Either ContactNo MMSI), ContactMapPerspective) | iTask w
mapState local contacts sel = sdsSequence "mapState" id (\_ r -> r) (\_ _ -> Right read) writel writer (local >+< sel) mapContacts
where
mapContacts = sdsSelect "mapContacts" choose (SDSNotifyConst (\_ _ _ -> False)) (SDSNotifyConst (\_ _ _ -> False)) withoutAISContacts withAISContacts
mapContacts = sdsSelect "mapContacts" choose (SDSNotifyConst (\_ _ _ _-> False)) (SDSNotifyConst (\_ _ _ _-> False)) withoutAISContacts withAISContacts
where
choose ((withAIS,{ContactMapPerspective|bounds=Just bounds}),_) = (if withAIS (Right bounds) (Left bounds))
choose _ = (Left defaultValue)
......
......@@ -842,7 +842,7 @@ contactPhotos = sdsSplit "contactPhotos" param read write allContactPhotos
where
param p = ((),p)
read p all = fromMaybe [] ('DM'.get p all)
write p all photos = ('DM'.put p photos all, (==) p)
write p all photos = ('DM'.put p photos all, const ((==) p))
contactAccess :: RWShared ContactNo ContactAccess ContactAccess
contactAccess = mapReadWrite (read,write) contactByNoBase
......
......@@ -232,7 +232,7 @@ ungroupByFst :: (Map a [b]) -> [(a,b)]
ungroupByFst index = flatten [[(a,b) \\ b <- bs] \\ (a,bs) <- 'DM'.toList index]
roMaybe :: (RWShared p (Maybe r) ()) -> RWShared (Maybe p) (Maybe r) () | iTask p & TC r
roMaybe sds = sdsSelect "roMaybe" choose (SDSNotifyConst (\_ _ _ -> False)) (SDSNotifyConst (\_ _ _ -> False)) (constShare Nothing) sds
roMaybe sds = sdsSelect "roMaybe" choose (SDSNotifyConst (\_ _ _ _ -> False)) (SDSNotifyConst (\_ _ _ _-> False)) (constShare Nothing) sds
where
choose Nothing = Left ()
choose (Just p) = Right p
......
......@@ -33,7 +33,7 @@ indexedStore :: String v -> RWShared k v v | Eq k & Ord k & iTask k & iTask v
indexedStore name def = sdsSplit "indexedStore" (\p -> ((),p)) read write (sharedStore name 'DM'.newMap)
where
read p mapping = fromMaybe def ('DM'.get p mapping)
write p mapping v = ('DM'.put p v mapping,(==) p)
write p mapping v = ('DM'.put p v mapping,const ((==) p))
sdsDeref :: (RWShared p [a] [a]) (a -> Int) (RWShared [Int] [b] x) ([a] [b] -> [c]) -> (RWShared p [c] [a]) | iTask p & TC a & TC b & TC c & TC x
sdsDeref sds1 toRef sds2 merge = sdsSequence "sdsDeref" paraml paramr (\_ _ -> Right read) writel writer sds1 sds2
......@@ -56,7 +56,7 @@ where
writer = SDSWriteConst (\_ _ -> Ok Nothing)
valueShare :: (RWShared i c c) -> RWShared (Maybe i) (Maybe c) () | iTask i & iTask c
valueShare target = sdsSelect "viewDetailsValue" param (SDSNotifyConst (\_ _ _ -> False)) (SDSNotifyConst (\_ _ _ -> False))
valueShare target = sdsSelect "viewDetailsValue" param (SDSNotifyConst (\_ _ _ _-> False)) (SDSNotifyConst (\_ _ _ _-> False))
(constShare Nothing) (mapRead Just (toReadOnly target))
where
param Nothing = Left ()
......
implementation module BasicAPIExamples
import iTasks
import System.Process
import System.Time
import iTasks.Extensions.Admin.UserAdmin
import iTasks.Extensions.Admin.ServerAdmin
import iTasks.Extensions.Admin.StoreAdmin
......@@ -10,7 +12,8 @@ import iTasks.Extensions.Currency
import iTasks.Extensions.Contact
import iTasks.Extensions.DateTime
import iTasks.Extensions.Clock
import Text, Text.HTML, StdArray
import iTasks.Extensions.Terminal, Text.Terminal.VT100
import Text, Text.HTML, StdArray, StdMisc
import iTasks.Internal.Tonic
//import ligrettoTOP
//import iTaskGraphics, editletGraphics, edgehog
......@@ -82,6 +85,7 @@ basicAPIExamples =
,workflow (miscTask +++ "Droste Cacaobus") "Start this application as a task" (manageWorklist basicAPIExamples)
,workflow (miscTask +++ "External process") "Starts an external process" externalProcessExample
,workflow (miscTask +++ "External process using callProcess") "Starts an external process" callProcessExample
,restrictedTransientWorkflow (adminTask +++ "Manage users") "Manage system users..." ["admin"] manageUsers
,restrictedTransientWorkflow (adminTask +++ "Manage server") "Manage itask server..." ["admin"] manageServer
......@@ -102,10 +106,6 @@ Start world
where
title = "iTasks Example Collection"
//* utility functions
undef = undef
//hasValue tf (Value v _) = Just (tf v)
//hasValue _ _ = Nothing
......@@ -282,7 +282,7 @@ editSharedList store
>>* [ OnAction (Action "Append") (hasValue (showAndDo append))
, OnAction (Action "Delete") (hasValue (showAndDo delete))
, OnAction (Action "Edit") (hasValue (showAndDo edit))
, OnAction (Action "Clear") (always (showAndDo append (-1,undef)))
, OnAction (Action "Clear") (always (showAndDo append (-1, undef)))
, OnAction (Action "Quit") (always (return ()))
]
where
......@@ -711,22 +711,14 @@ add_cell new turn board
externalProcessExample =
enterInformation "Enter the path to the external process. To for instance open a shell run '/bin/bash' or 'c:\\Windows\\System32\\cmd.exe'." [] >>= \path ->
withShared
Nothing
( \sds -> ( externalProcess () path [] Nothing sds handlers Nothing gEditor{|*|} <<@ ApplyLayout hideUI >&>
viewSharedInformation "Process output" []
) -&&-
forever (enterInformation "Enter data to send to StdIn" [] >>= \data -> set (Just (data +++ "\n")) sds)
)
where
handlers = { onStartup = \ _ -> (Ok "", Nothing, [], False)
, onOutData = onData
, onErrData = onData
, onShareChange = \ l _ -> (Ok l, Nothing, [], False)
, onExit = \_ l _ -> (Ok l, Nothing)
}
onData data l mbOutput = (Ok (l +++ data +++ "\n"), Just Nothing, maybeToList mbOutput, False)
enterInformation "Enter the path to the external process. To for instance open a shell run '/bin/bash' or 'c:\\Windows\\System32\\cmd.exe'." []
>>= \path->runProcessInteractive zero path [] Nothing
import qualified iTasks.Extensions.Process as P
callProcessExample =
enterInformation "Enter the path to the external process. To for instance open a shell run '/bin/bash' or 'c:\\Windows\\System32\\cmd.exe'." []
>>= \path->'P'.callProcess () [] path [] Nothing Nothing
>>- viewInformation "Process terminated" []
//* Customizing interaction with views
......
......@@ -5,10 +5,10 @@ definition module iTasks.Engine
* environment in which worfklow specifications can be executed.
*/
from StdList import ++, iterate, take
from Data.Maybe import :: Maybe
from System.FilePath import :: FilePath
from Internet.HTTP import :: HTTPRequest
from System.Time import :: Timespec
import iTasks.WF.Definition
......@@ -18,14 +18,15 @@ import iTasks.WF.Definition
, appVersion :: String
, serverPort :: Int
, serverUrl :: String
, keepaliveTime :: Int
, sessionTime :: Int
, keepaliveTime :: Timespec
, sessionTime :: Timespec
, persistTasks :: Bool
, autoLayout :: Bool
, webDirPath :: FilePath // Location of public files that are served by the iTask webserver
, storeDirPath :: FilePath // Location of the application's persistent data files
, tempDirPath :: FilePath // Location for temporary files used in tasks
, saplDirPath :: FilePath // Location of the application's sapl files (client-side code)
, timeout :: Maybe Int // The timeout
, webDirPath :: FilePath // Location of public files that are served by the iTask webserver
, storeDirPath :: FilePath // Location of the application's persistent data files
, tempDirPath :: FilePath // Location for temporary files used in tasks
, saplDirPath :: FilePath // Location of the application's sapl files (client-side code)
}
/**
......
implementation module iTasks.Engine
import StdMisc, StdArray, StdList, StdOrdList, StdTuple, StdChar, StdFile, StdBool, StdEnum
import iTasks.WF.Combinators.Common
import iTasks.WF.Tasks.System
from StdFunc import o, seqList, ::St, const, id
from Data.Map import :: Map
from Data.Queue import :: Queue(..)
......@@ -32,8 +34,8 @@ from Sapl.Linker.SaplLinkerShared import :: SkipSet
from Sapl.Target.Flavour import :: Flavour, toFlavour
from System.OS import IF_POSIX_OR_WINDOWS
MAX_EVENTS :== 5
import System.GetOpt
import Data.Functor
defaultEngineOptions :: !*World -> (!EngineOptions,!*World)
defaultEngineOptions world
......@@ -47,10 +49,11 @@ defaultEngineOptions world
, appVersion = appVersion
, serverPort = IF_POSIX_OR_WINDOWS 8080 80
, serverUrl = "http://localhost/"
, keepaliveTime = 300 // 5 minutes
, sessionTime = 60 // 1 minute, (the client pings every 10 seconds by default)
, keepaliveTime = {tv_sec=300,tv_nsec=0} // 5 minutes
, sessionTime = {tv_sec=60,tv_nsec=0} // 1 minute, (the client pings every 10 seconds by default)
, persistTasks = False
, autoLayout = True
, timeout = Just 500
, webDirPath = appDir </> appName +++ "-www"
, storeDirPath = appDir </> appName +++ "-data" </> "stores"
, tempDirPath = appDir </> appName +++ "-data" </> "tmp"
......@@ -59,64 +62,47 @@ defaultEngineOptions world
= (options,world)
defaultEngineCLIOptions :: [String] EngineOptions -> (!Maybe EngineOptions,![String])
defaultEngineCLIOptions cli defaults
//If -help option is given show help and stop
# help = fromMaybe False (boolOpt "-help" "-no-help" cli)
| help = (Nothing, instructions defaults)
//Check commandline options
# options =
{ defaults
& serverPort = fromMaybe defaults.serverPort (intOpt "-port" cli)
, webDirPath = fromMaybe defaults.webDirPath (stringOpt "-webdir" cli)
, storeDirPath = fromMaybe defaults.storeDirPath (stringOpt "-storedir" cli)
, tempDirPath = fromMaybe defaults.webDirPath (stringOpt "-tempdir" cli)
, saplDirPath = fromMaybe defaults.saplDirPath (stringOpt "-sapldir" cli)
}
= (Just options,running options.appName options.serverPort)
defaultEngineCLIOptions [argv0:argv] defaults
# (settings, positionals, errs) = getOpt Permute opts argv
| not (errs =: []) = (Nothing, errs)
| not (positionals =: []) = (Nothing, ["Positional arguments not allowed"])
= case foldl (o) id settings (Just defaults) of
Nothing = (Nothing, [usageInfo ("Usage " +++ argv0 +++ "[OPTIONS]") opts])
Just settings = (Just settings,
["*** " +++ settings.appName +++ " HTTP server ***"
,""
,"Running at http://localhost" +++ if (settings.serverPort == 80) "/" (":" +++ toString settings.serverPort +++ "/")])
where
instructions :: EngineOptions -> [String]
instructions {serverPort,webDirPath,storeDirPath,tempDirPath,saplDirPath} =
["Available commandline options:"
," -help : Show this message and exit"
," -port <port> : Listen on TCP port number (default " +++ toString serverPort +++ ")"
," -webdir <path> : Use <path> to point to the folder that contain the application's static web content"
," : (default "+++ webDirPath +++ ")"
," -storedir <path> : Use <path> as data store location"
," : (default " +++ storeDirPath +++ ")"
," -tempdir <path> : Use <path> as temporary file location"
," : (default " +++ tempDirPath +++ ")"
," -sapldir <path> : Use <path> to point to the folder that contains the sapl version of the application"
," : (default "+++ saplDirPath +++ ")"
,""
opts :: [OptDescr ((Maybe EngineOptions) -> Maybe EngineOptions)]
opts =
[ Option ['?'] ["help"] (NoArg $ const Nothing)
"Display this message"
, Option ['p'] ["port"] (ReqArg (\p->fmap \o->{o & serverPort=toInt p}) "PORT")
("Specify the HTTP port (default: " +++ toString defaults.serverPort)
, Option [] ["timeout"] (OptArg (\mp->fmap \o->{o & timeout=fmap toInt mp}) "MILLISECONDS")
"Specify the timeout in ms (default: 500)\nIf not given, use an indefinite timeout."
, Option [] ["keepalive"] (ReqArg (\p->fmap \o->{o & keepaliveTime={tv_sec=toInt p,tv_nsec=0}}) "SECONDS")
"Specify the keepalive time in seconds (default: 300)"
, Option [] ["sessiontime"] (ReqArg (\p->fmap \o->{o & sessionTime={tv_sec=toInt p,tv_nsec=0}}) "SECONDS")
"Specify the expiry time for a session in seconds (default: 60)"
, Option [] ["autolayout"] (NoArg (fmap \o->{o & autoLayout=True}))
"Enable autolayouting (default)"
, Option [] ["no-autolayout"] (NoArg (fmap \o->{o & autoLayout=False}))
"Disable autolayouting"
, Option [] ["persist-tasks"] (NoArg (fmap \o->{o & persistTasks=True}))
"Enable the persistence of tasks"
, Option [] ["no-persist-tasks"] (NoArg (fmap \o->{o & persistTasks=False}))
"Disable the persistence of tasks (default)"
, Option [] ["webdir"] (ReqArg (\p->fmap \o->{o & webDirPath=p}) "PATH")
("Specify the folder containing static web content\ndefault: " +++ defaults.webDirPath)
, Option [] ["storedir"] (ReqArg (\p->fmap \o->{o & storeDirPath=p}) "PATH")
("Specify the folder containing the data stores\ndefault: " +++ defaults.storeDirPath)
, Option [] ["tempdir"] (ReqArg (\p->fmap \o->{o & tempDirPath=p}) "PATH")
("Specify the folder containing the temporary files\ndefault: " +++ defaults.tempDirPath)
, Option [] ["sapldir"] (ReqArg (\p->fmap \o->{o & saplDirPath=p}) "PATH")
("Specify the folder containing the sapl files\ndefault: " +++ defaults.saplDirPath)
]
running :: !String !Int -> [String]
running app port = ["*** " +++ app +++ " HTTP server ***"
,""
,"Running at http://localhost" +++ (if (port == 80) "/" (":" +++ toString port +++ "/"))]
boolOpt :: !String !String ![String] -> Maybe Bool
boolOpt trueKey falseKey opts
| isMember trueKey opts = Just True
| isMember falseKey opts = Just False
= Nothing
intOpt :: !String ![String] -> Maybe Int
intOpt key [] = Nothing
intOpt key [_] = Nothing
intOpt key [n,v:r]
| n == key && isInteger v = Just (toInt v)
= intOpt key [v:r]
where
isInteger v = and (map isDigit (fromString v))
stringOpt :: !String [String] -> Maybe String
stringOpt key [] = Nothing
stringOpt key [_] = Nothing
stringOpt key [n,v:r]
| n == key = Just v
= stringOpt key [v:r]
startEngine :: a !*World -> *World | Publishable a
startEngine publishable world = startEngineWithOptions defaultEngineCLIOptions publishable world
......@@ -132,15 +118,10 @@ startEngineWithOptions initFun publishable world
# iworld = createIWorld (fromJust mbOptions) world
# (res,iworld) = initJSCompilerState iworld
| res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
# iworld = serve [] (tcpTasks options.serverPort options.keepaliveTime) engineTasks timeout iworld
# iworld = serve [TaskWrapper removeOutdatedSessions] (tcpTasks options.serverPort options.keepaliveTime) (timeout options.timeout) iworld
= destroyIWorld iworld
where
tcpTasks serverPort keepaliveTime = [(serverPort,httpServer serverPort keepaliveTime (engineWebService publishable) taskOutput)]
engineTasks =
[BackgroundTask updateClock
,BackgroundTask (processEvents MAX_EVENTS)
,BackgroundTask removeOutdatedSessions
,BackgroundTask flushWritesWhenIdle]
runTasks :: a !*World -> *World | Runnable a
runTasks tasks world = runTasksWithOptions (\c o -> (Just o,[])) tasks world
......@@ -152,16 +133,12 @@ runTasksWithOptions initFun runnable world
# (mbOptions,msg) = initFun cli options
# world = show msg world
| mbOptions =: Nothing = world
# iworld = createIWorld (fromJust mbOptions) world
# (Just options) = mbOptions
# iworld = createIWorld options world
# (res,iworld) = initJSCompilerState iworld
| res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
# iworld = serve (toRunnable runnable) [] systemTasks timeout iworld
# iworld = serve (toRunnable runnable) [] (timeout options.timeout) iworld
= destroyIWorld iworld
where
systemTasks =
[BackgroundTask updateClock
,BackgroundTask (processEvents MAX_EVENTS)
,BackgroundTask stopOnStable]
show :: ![String] !*World -> *World
show lines world
......
implementation module iTasks.Extensions.Admin.WorkflowAdmin
import iTasks
import StdMisc, Data.Tuple, Text, Data.Either, Data.Functor
import StdMisc, Data.Tuple, Text, Data.Either, Data.Functor, Data.Func
import iTasks.Internal.SDS
import iTasks.Internal.Serialization
import iTasks.Internal.Store
......@@ -202,9 +202,11 @@ where
layoutManageWork = sequenceLayouts
//Split the screen space
[arrangeWithSideBar 0 TopSide 200 True
//Layout all dynamically added tasks as tabs
,layoutSubUIs (SelectByPath [1]) (arrangeWithTabs False)
[ arrangeWithSideBar 0 TopSide 200 True
//Layout all dynamically added tasks as tabs
, layoutSubUIs (SelectByPath [1]) (arrangeWithTabs False)
, layoutSubUIs (SelectByPath [1]) $
layoutSubUIs (SelectByDepth 1) (setUIAttributes $ 'DM'.put "fullscreenable" (JSONBool True) 'DM'.newMap)
]
addNewTask :: !(SharedTaskList ()) -> Task ()
......
implementation module iTasks.Extensions.Development.Testing
import iTasks
import System.Time
import iTasks.Extensions.Development.Tools
import iTasks.Internal.Test.Definition
import Text, Data.Tuple, Data.Error, System.FilePath, System.OS
derive class iTask ExitCode
TESTS_PATH :== "../Tests/TestPrograms"
//:: CompileError = CompileError !Int
......@@ -14,10 +13,8 @@ compileTestModule :: FilePath -> Task TestResult
compileTestModule path
= get cpmExecutable
>>- \cpm ->
withShared [] ( \io -> (
runWithOutput cpm [prj] Nothing io //Build the test
@ \(ExitCode c,o) -> if (passed c o) Passed (Failed (Just ("Failed to build " +++ prj +++ "\n" +++ join "" o)))
))
runWithOutput cpm [prj] Nothing //Build the test
@ \(c,o) -> if (passed c o) Passed (Failed (Just ("Failed to build " +++ prj +++ "\n" +++ join "" o)))
where
//Cpm still returns exitcode 0 on failure, so we have to check the output
passed 0 o = let lines = split OS_NEWLINE (join "" o) in not (any isErrorLine lines)
......@@ -34,7 +31,7 @@ runTestModule :: FilePath -> Task SuiteResult
runTestModule path
= compileTestModule path
>>- \res -> case res of
Passed = withShared [] (\io -> ( runWithOutput exe [] Nothing io @ (parseSuiteResult o appSnd (join "")))) //Run the test
Passed = runWithOutput exe [] Nothing @ (parseSuiteResult o appSnd (join "")) //Run the test
_ = return {SuiteResult|suiteName=path,testResults=[("build",res)]}
where
baseDir = takeDirectory path
......@@ -42,8 +39,8 @@ where
exe = addExtension base "exe"
prj = addExtension base "prj"
parseSuiteResult :: (ExitCode,String) -> SuiteResult //QUICK AND DIRTY PARSER
parseSuiteResult (ExitCode ecode,output)
parseSuiteResult :: (Int,String) -> SuiteResult //QUICK AND DIRTY PARSER
parseSuiteResult (ecode,output)
# lines = split "\n" output
| length lines < 2 = fallback ecode output
# suiteName = trim ((split ":" (lines !! 0)) !! 1)
......@@ -69,12 +66,7 @@ where
fallback 0 _ = {SuiteResult|suiteName="Unknown",testResults=[("executable",Passed)]}
fallback _ output = {SuiteResult|suiteName="Unknown",testResults=[("executable",Failed (Just output))]}
runWithOutput :: FilePath [String] (Maybe FilePath) (Shared [String]) -> Task (ExitCode,[String])
runWithOutput prog args dir out
= externalProcess () prog args dir out {onStartup=onStartup,onOutData=onOutData,onErrData=onErrData,onShareChange=onShareChange,onExit=onExit} Nothing gEditor{|*|}
where
onStartup r = (Ok (ExitCode 0,[]), Nothing, [], False)
onOutData data (e,o) r = (Ok (e,o ++ [data]), Just (r ++ [data]), [], False)
onErrData data l r = (Ok l, Nothing, [], False)
onShareChange l r = (Ok l, Nothing, [], False)
onExit ecode (_,o) r = (Ok (ecode,o), Nothing)
runWithOutput :: FilePath [String] (Maybe FilePath) -> Task (Int,[String])
runWithOutput prog args dir = withShared ([], []) \out->withShared [] \stdin->
externalProcess {tv_sec=0,tv_nsec=100000000} prog args dir Nothing stdin out
>>- \c->get out @ tuple c o fst
implementation module iTasks.Extensions.Process
import iTasks
import iTasks.WF.Definition
import iTasks.WF.Tasks.Core
import iTasks.WF.Tasks.IO
......@@ -9,6 +10,8 @@ import iTasks.UI.Editor.Modifiers
import StdString, StdList
import Data.Maybe, Data.Error
import System.Time
import Text
import qualified System.Process
derive class iTask ProcessInformation, ProcessStatus, CallException
......@@ -18,21 +21,17 @@ where
toString (CallFailed (_,err)) = "Error calling external process: " +++ err
callProcess :: !d ![ViewOption ProcessInformation] !FilePath ![String] !(Maybe FilePath) (Maybe ProcessPtyOptions) -> Task ProcessInformation | toPrompt d
callProcess prompt [ViewAs tof:_] executable arguments workingDirectory pty
= externalProcess prompt executable arguments workingDirectory unitShare (callProcessHandlers executable arguments) pty (comapEditorValue tof gEditor{|*|})
callProcess prompt [ViewUsing tof editor:_] executable arguments workingDirectory pty
= externalProcess prompt executable arguments workingDirectory unitShare (callProcessHandlers executable arguments) pty (comapEditorValue tof editor)
callProcess prompt _ executable arguments workingDirectory pty
= externalProcess prompt executable arguments workingDirectory unitShare (callProcessHandlers executable arguments) pty gEditor{|*|}
callProcessHandlers executable arguments
= {onStartup = onStartup, onOutData = onOutData, onErrData = onErrData, onShareChange = onShareChange, onExit = onExit}
where
onStartup _ = (Ok {ProcessInformation|executable=executable,arguments=arguments,stdout="",stderr="",status=RunningProcess}, Nothing, [], False)
onOutData data info=:{ProcessInformation|stdout} _ = (Ok {ProcessInformation|info & stdout = stdout +++ data}, Nothing, [], False)
onErrData data info=:{ProcessInformation|stderr} _ = (Ok {ProcessInformation|info & stderr = stderr +++ data}, Nothing, [], False)
onShareChange info _ = (Ok info, Nothing, [], False)
onExit (ExitCode exitCode) info _ = (Ok {ProcessInformation|info & status = CompletedProcess exitCode}, Nothing)
callProcess prompt vopts fp args wd pty
= withShared [] \stdin->withShared ([], []) \out->
let s = (mapRead (\(stdout,stderr)->
{ executable=fp
, arguments=args
, stdout=concat stdout
, stderr=concat stderr
, status=RunningProcess}) out) in
externalProcess {tv_sec=0,tv_nsec=100000000} fp args wd pty stdin out
-|| viewSharedInformation prompt vopts s
>>- \c->get s @ \s->{s & status=CompletedProcess c}
callInstantProcess :: !FilePath ![String] !(Maybe FilePath) -> Task Int
callInstantProcess cmd args dir = accWorldError (\world -> 'System.Process'.callProcess cmd args dir world) CallFailed
callInstantProcess cmd args dir = accWorldError (\world -> 'System.Process'.callProcess cmd args dir world) CallFailed
......@@ -47,7 +47,7 @@ writeFunSQL fun (MySQLDatabase db,p) w iworld
# (res,cur) = fun p w cur
# iworld = cacheResource (MySQLResource db (cur, con, cxt)) iworld
= case res of
(Ok _) = (Ok (const True),iworld)
(Ok _) = (Ok (const (const True)),iworld)
(Error e) = (Error (exception e),iworld)
writeFunSQL fun (SQLiteDatabase path,p) w iworld
......@@ -59,7 +59,7 @@ writeFunSQL fun (SQLiteDatabase path,p) w iworld
# (res,cur) = fun p w cur
# iworld = cacheResource (SQLiteResource path (cur, con, cxt)) iworld
= case res of
(Ok _) = (Ok (const True),iworld)
(Ok _) = (Ok (const (const True)),iworld)
(Error e) = (Error (exception e),iworld)
sqlExecute :: SQLDatabaseDef [String] (A.*cur: *cur -> *(MaybeErrorString a,*cur) | SQLCursor cur) -> Task a | iTask a
......@@ -124,7 +124,7 @@ where
# (err,rows,cur) = fetchAll cur
| isJust err = (Error (toString (fromJust err)),cur)
= (Ok rows,cur)
write _ () iworld = (Ok (const True),iworld)
write _ () iworld = (Ok (const (const True)),iworld)
sqlTables :: ROShared SQLDatabaseDef [SQLTableName]
sqlTables = createReadOnlySDSError read
......
definition module iTasks.Extensions.Terminal
from Data.Maybe import :: Maybe