implementation module GinEditor import StdFile import GenEq import Text import iTasks import GinAbstractSyntax import GinConfig import GinCompiler import GinDomain import GinParser from GinPrinter import ::Doc, prettyPrint, instance Printer Doc import GinStorage import GinSyntax import CleanDocParser import GinDCLImport import FilePath, File from Tuple import appFst /* * NOTE: In order to add compiled tasks to a running server, * check "Enable dynamics" in Project -> Project options, * and replace the readDynamicTask function by the lines below: */ /* from Serialization import qualified serialize, deserialize readDynamicTask :: !String -> Task (Task a) | iTask a readDynamicTask filename = importTextFile filename >>= \dynString -> case 'Serialization'.deserialize dynString of Ok value = return value Error errorString = throw (DynamicIOException errorString) */ readDynamicTask filename = return (showInformation "Error: dynamic linker not enabled" [] Void) ginEditor :: WorkflowContainer Void ginEditor = Workflow initManagerProperties ginEditor` getAndSetupConfig :: Task GinConfig getAndSetupConfig = getConfig >>= \config -> accWorld (ginCheckConfig config) >>= \error = if (isNothing error) (return config) setupDialog getConfig :: Task GinConfig getConfig = accWorld ginLoadConfig >>= \mbConfig -> case mbConfig of Just config = return config Nothing = accWorld ginDefaultConfig >>= \config -> appWorld (ginStoreConfig config) >>| return config setupDialog :: Task GinConfig setupDialog = getConfig >>= dialog >>= \config -> appWorld (ginStoreConfig config) >>|return config where dialog config = updateInformation "GiN editor setup" [] config >>= \config = accWorld (ginCheckConfig config) >>= \error = if (isNothing error) (return config) (dialog config) :: EditorState = { config :: !GinConfig , name :: !Maybe String , gMod :: !GModule , checkSyntax :: !Bool , changed :: !Bool , dirty :: !Bool , errors :: ![ORYXError] , source :: !String , compiled :: !Maybe String } derive class iTask EditorState getInitialState :: Task EditorState getInitialState = getAndSetupConfig >>= \config -> return { EditorState | config = config , name = Nothing , gMod = updateDiagramExtensions newModule , checkSyntax = True , changed = False , dirty = False , errors = [] , source = "" , compiled = Nothing } //----------------------------------------------------------------------------------- ActionCompile :== Action "File/Compile" ActionRun :== Action "File/Run" ActionViewDeclaration :== Action "View/Declaration" ActionViewWorkflow :== Action "View/Workflow" ActionViewImports :== Action "View/Imports" ActionViewTypes :== Action "View/Types" ActionViewSource :== Action "View/Generated source" ActionEnableSC :== Action "Options/Enable syntax checking" ActionDisableSC :== Action "Options/Disable syntax checking" ActionConfiguration :== Action "Options/Configuration" ginEditor` :: Task Void ginEditor` = getAndSetupConfig >>| getInitialState >>= \initialState -> ginParallelLayout @>> parallel "GiN Editor" initialState (\_ _ -> Void) [ (BodyTask, \s -> forever (ginInteractionLayout @>> (updateSharedInformation "Workflow diagram" [UpdateView (GetShared diagramView, PutbackShared diagramUpdate)] (taskListState s) Void) >>+ noActions` )) , (HiddenTask, \s -> (chooseAction (actions s) >>= id) Bool isStop Stop = True isStop _ = False ginParallelLayout :: ParallelLayouter ginParallelLayout = \par=:{TUIParallel|title,instruction,items}-> case items of [(_,Just editor,_),(_,_,actions),activator] = (editor,actions) _ = defaultParallelLayout par ginInteractionLayout :: InteractionLayouter ginInteractionLayout = \interaction = case interaction.editorParts of [{TUIDef | content = TUIEditControl (TUIORYXControl _) _}] = ({TUIDef | hd interaction.editorParts & width = Just (FillParent 1 (FixedMinSize 400))},interaction.TUIInteraction.actions) _ = defaultInteractionLayout interaction diagramView :: EditorState -> ORYXEditor diagramView { EditorState | gMod = { moduleKind = GGraphicalModule defs }, errors } = { ORYXEditor | (ginORYXEditor (hd defs).GDefinition.body) & errors = errors } diagramUpdate :: ORYXEditor Void EditorState -> EditorState diagramUpdate editor _ state = { EditorState | state & gMod = setDiagram state.gMod editor, dirty = True} where setDiagram :: !GModule !ORYXEditor -> GModule setDiagram gMod =:{moduleKind = (GGraphicalModule defs)} editor=:{diagram} = { GModule | gMod & moduleKind = GGraphicalModule ( [ { GDefinition | hd defs & body = diagram } : tl defs ] ) } activator :: (TaskList EditorState) -> Task ParallelControl activator taskList = forever activator` where stateShared = taskListState taskList activator` :: Task ParallelControl activator` = (showSharedInformation "Diagram monitor" [] stateShared Void >? \(state,_) -> state.dirty) //Look for the dirty flag to become True >>= \(state,_) -> return { EditorState | state & dirty = False, changed = True } >>= generateSource >>= \state -> (if state.EditorState.checkSyntax (checkErrors state) (return state)) >>= set stateShared >>| return Continue generateSource :: EditorState -> Task EditorState generateSource state = accWorld (tryRender state.EditorState.gMod state.EditorState.config POICL) >>= \source -> return { EditorState | state & source = source } checkErrors :: EditorState -> Task EditorState checkErrors state=:{ EditorState | gMod = { moduleKind = GGraphicalModule defs } } = accIWorld (syntaxCheck state.EditorState.gMod) >>= transform (\compileResult -> { EditorState | state & errors = makeErrorString compileResult }) where makeErrorString :: (CompileResult a) -> [ORYXError] makeErrorString (CompileSuccess _) = [] makeErrorString (CompileGlobalError error) = [makeORYXError ((hd defs).GDefinition.body) ([], error)] makeErrorString (CompilePathError errors) = map (makeORYXError ((hd defs).GDefinition.body)) errors actions :: (TaskList EditorState) -> [(Action, Task ParallelControl)] actions taskList = [ (ActionNew, actionTask (\s -> askSaveIfChanged s >>| getInitialState)) , (ActionOpen, actionTask open) , (ActionSave, actionTask save) , (ActionSaveAs, actionTask saveAs) , (ActionCompile, actionTask compile) , (ActionQuit, return Stop) , (ActionViewDeclaration, moduleEditor "Declaration" (declarationView, declarationUpdate)) , (ActionViewImports, importsEditor) , (ActionViewTypes, moduleEditor "Types" (typesView, typesUpdate)) , (ActionViewSource, sourceView) , (ActionEnableSC, actionTask (\s -> checkErrors { s & checkSyntax = True })) , (ActionDisableSC, actionTask (\s -> return { s & checkSyntax = False })) , (ActionConfiguration, addTask setupDialog) , (ActionAbout, actionTask showAbout) ] where stateShared = taskListState taskList addTask task = defaultInteractionLayout @>> appendTask (BodyTask, \_ -> task >>| return Continue) taskList >>| return Continue actionTask task = addTask (get stateShared >>= task >>= set stateShared) moduleEditor title v = addTask (updateSharedInformation title [UpdateView (app2 (GetShared,\f -> PutbackShared (\a _ e -> f a e)) (liftModuleView v))] stateShared Void) declarationEditor = moduleEditor "declaration" (declarationView, declarationUpdate) importsEditor = addTask ( get stateShared >>= \state -> accWorld (searchPathModules state.EditorState.config) >>= \modules -> moduleEditor "imports" (importsView modules, importsUpdate) ) sourceView = addTask (showSharedInformation "source view" [ShowView (GetShared (\s -> formatSource s.EditorState.source))] stateShared Void) liftModuleView :: (GModule -> a, a GModule -> GModule) -> (EditorState -> a, a EditorState -> EditorState) liftModuleView (toView, fromView) = ( \model -> toView model.gMod , \view model -> { model & gMod = fromView view model.gMod, changed = True } ) :: DeclarationView = { title :: !Maybe String , description :: !Maybe String , parameters :: !Maybe [FormalParameterView] , returnType :: !TypeExpressionView } :: FormalParameterView = { name :: !String , type :: !TypeExpressionView } derive class iTask DeclarationView, FormalParameterView :: TypeExpressionView = TypeExpressionView String toTypeExpressionView :: GTypeExpression -> TypeExpressionView toTypeExpressionView te = TypeExpressionView (prettyPrint (printGTypeExpression False te)) fromTypeExpressionView :: TypeExpressionView -> GTypeExpression fromTypeExpressionView (TypeExpressionView tev) = case parseTypeUnsafe tev of Nothing = GUndefinedTypeExpression Just te = mapType te gVisualizeText{|TypeExpressionView|} _ (TypeExpressionView v) = [v] gVisualizeHtml{|TypeExpressionView|} _ (TypeExpressionView v) = [RawText v] gVisualizeEditor{|TypeExpressionView|} val vst = visualizeControlSimple TUIStringControl val vst gUpdate{|TypeExpressionView|} mode ust = basicUpdate mode parseUpdate (TypeExpressionView "") ust where parseUpdate update orig = fromMaybe orig (fmap TypeExpressionView update) derive gDefaultMask TypeExpressionView gVerify{|TypeExpressionView|} val vst = wrapperVerify Nothing (\(TypeExpressionView value) -> isJust (parseTypeUnsafe value)) (\_ -> "Invalid type") val vst JSONEncode{|TypeExpressionView|} (TypeExpressionView x) = [JSONString x] JSONDecode{|TypeExpressionView|} [JSONString s:xs] = (Just (TypeExpressionView s), xs) JSONDecode{|TypeExpressionView|} l = (Nothing, l) derive gEq TypeExpressionView declarationView :: !GModule -> DeclarationView declarationView {moduleKind = (GGraphicalModule [{GDefinition | declaration = {GDeclaration | name, title, description, formalParams, returnType = GTypeApplication [GConstructor "Task",rt] }}:_])} = { DeclarationView | title = title , description = description , parameters = if (isEmpty formalParams) Nothing (Just (map formalParameterView formalParams)) , returnType = toTypeExpressionView rt } declarationUpdate :: !DeclarationView !GModule -> GModule declarationUpdate {DeclarationView | title, description, parameters, returnType} gMod=:{moduleKind = (GGraphicalModule [def=:{GDefinition | declaration}:defs])} = { gMod & moduleKind = GGraphicalModule [ { GDefinition | def & declaration = { GDeclaration | declaration & title = title , description = description , formalParams = case parameters of Nothing = [] Just pars = map formalParameterUpdate pars , returnType = GTypeApplication [GConstructor "Task", fromTypeExpressionView returnType] } } : defs ] } formalParameterView :: !GFormalParameter -> FormalParameterView formalParameterView { GFormalParameter | name, type} = { FormalParameterView | name = name , type = TypeExpressionView (prettyPrint (printGTypeExpression False type)) } formalParameterUpdate :: !FormalParameterView -> GFormalParameter formalParameterUpdate { FormalParameterView | name, type = (TypeExpressionView t) } = { GFormalParameter | name = name , title = Just name , description = Nothing , type = case parseTypeUnsafe t of Nothing = GUndefinedTypeExpression Just te = mapType te , defaultValue = Nothing , visible = True } importsView :: ![String] !GModule -> CheckMultiChoice String String importsView allModules gMod = mkCheckMultiChoice [(m,m) \\ m <- allModules] gMod.GModule.imports importsUpdate :: (CheckMultiChoice String String) GModule -> GModule importsUpdate choice gMod = updateDiagramExtensions { GModule | gMod & imports = getSelections choice } typesView :: !GModule -> Maybe [GTypeDefinition] typesView gMod = case gMod.GModule.types of [] = Nothing t = Just t typesUpdate :: !(Maybe [GTypeDefinition]) !GModule -> GModule typesUpdate mbTypes gMod = { GModule | gMod & types = fromMaybe [] mbTypes } getName :: EditorState -> String getName state = case state.EditorState.name of Just n -> n Nothing -> "(unnamed)" setChanged :: EditorState EditorState -> EditorState setChanged old new = if (old.EditorState.gMod =!= new.EditorState.gMod) { new & changed = True } new open :: EditorState -> Task EditorState open state = getInitialState >>= \initialState -> chooseModule state.EditorState.config >>= \mMod = case mMod of Just (name, gMod) = return { EditorState | initialState & name = Just name, gMod = gMod } >>= generateSource Nothing = return state save :: EditorState -> Task EditorState save state = case state.EditorState.name of Just name -> writeModule state.EditorState.config name state.EditorState.gMod >>| return { state & changed = False } Nothing -> saveAs state saveAs :: EditorState -> Task EditorState saveAs state = newModuleName state.EditorState.config >>= \name = save { EditorState | state & name = Just name } askSaveIfChanged :: EditorState -> Task Void askSaveIfChanged state = if state.changed ( showInformation ("File " +++ (getName state) +++ " has changed, save changes?") [] Void >?* [ (ActionNo, Always (return Void)) , (ActionYes, Always (save state >>| return Void)) ] ) (return Void) where requestConfirmation :: !String -> Task Bool requestConfirmation message = showInformation message Void >>+ \_ -> UserActions [(ActionYes, True), (ActionNo, False)] compile :: EditorState -> Task EditorState compile state # state = { state & compiled = Nothing } = accIWorld (batchBuild state.EditorState.gMod) >>= \result = case result of CompileSuccess dynfile -> showInformation ("Compiler output", "Compiled successfully. Click \"Refresh workflows\" to view the task") [] Void >>| readDynamicTask dynfile >>= \task -> addWorkflow (makeWorkflow state task) >>| return { state & compiled = Just dynfile } error -> showInformation "Compiler output" [About error] Void >>| return state where makeWorkflow :: EditorState (Task Void) -> Workflow makeWorkflow {EditorState | gMod = { GModule | moduleKind = GGraphicalModule [def:_]}} dyn # decl = def.GDefinition.declaration = workflow (fromMaybe "(no title)" decl.GDeclaration.title) (fromMaybe "(no description)" decl.GDeclaration.description) dyn :: DynamicIOException = DynamicIOException !String derive class iTask DynamicIOException instance toString DynamicIOException where toString (DynamicIOException errorString) = errorString formatSource :: String -> HtmlDisplay formatSource source = toHtmlDisplay (TextareaTag [ColsAttr "80", RowsAttr "25"] [ Text source ]) tryRender :: GModule GinConfig PrintOption *World -> (String, *World) tryRender gMod config printOption world # (st, world) = gToAModule gMod config world # source = case runParse st of GSuccess aMod -> prettyPrintAModule printOption aMod GError errors -> "Parse error:\n" +++ ((join "\n" (map (\(path,msg) = msg) errors))) = (source, world) showAbout :: EditorState -> Task EditorState showAbout state = showInformation "Gin workflow editor" [] "version 0.2" >>| return state accIWorld :: !(*IWorld -> *(!a,!*IWorld)) -> Task a | iTask a accIWorld fun = mkInstantTask ("Run Iworld function", "Run an IWorld function and get result.") eval where eval taskNr iworld # (res,iworld) = fun iworld = (TaskFinished res,iworld)