From 81e85876188cb2295813fbafd85427e7becb6a51 Mon Sep 17 00:00:00 2001 From: Bas Lijnse Date: Fri, 14 Jun 2019 09:51:15 +0200 Subject: [PATCH] Converted tests to attribute api changes --- .../Extensions/Development/Codebase.icl | 2 +- Libraries/iTasks/Extensions/Files.dcl | 6 +-- Libraries/iTasks/Extensions/Files.icl | 12 +++--- Libraries/iTasks/Util/Testing.icl | 18 ++++---- .../iTasks/Extensions/Process/UnitTests.icl | 12 +++--- .../iTasks/Internal/TaskStore/UnitTests.icl | 2 +- Tests/Unit/iTasks/WF/Tasks/Core/UnitTests.icl | 13 ++---- Tools/CodeQualityMonitor.icl | 41 ++++++++++--------- 8 files changed, 49 insertions(+), 57 deletions(-) diff --git a/Libraries/iTasks/Extensions/Development/Codebase.icl b/Libraries/iTasks/Extensions/Development/Codebase.icl index d926aa546..bf4ae56a2 100644 --- a/Libraries/iTasks/Extensions/Development/Codebase.icl +++ b/Libraries/iTasks/Extensions/Development/Codebase.icl @@ -103,7 +103,7 @@ rescanCodeBase codebase navigateCodebase :: CodeBase -> Task SourceTreeSelection navigateCodebase codebase - = enterChoice () [/* ChooseWith (ChooseFromTree (groupModules (sourceTreeRoots codebase)))*/] (modulesOf codebase) + = enterChoice [/* ChooseWith (ChooseFromTree (groupModules (sourceTreeRoots codebase)))*/] (modulesOf codebase) where modulesOf codebase = flatten [[SelSourceTree name rootPath:[moduleSelection modName modType modPath \\ (modName,modType,modPath) <- modules]] \\ {SourceTree|name,rootPath,modules} <- codebase] diff --git a/Libraries/iTasks/Extensions/Files.dcl b/Libraries/iTasks/Extensions/Files.dcl index 35b8b5fb2..4e5e3fdf8 100644 --- a/Libraries/iTasks/Extensions/Files.dcl +++ b/Libraries/iTasks/Extensions/Files.dcl @@ -56,19 +56,17 @@ copyDirectory :: !FilePath !FilePath -> Task () * If your file structure is big or contains cyclic links, choose {{`selectFileLazyTree`}} * * @param Start with all directories expanded - * @param Prompt * @param Flag for multiple selection * @param Root directory to select from * @param Initial selection */ -selectFileTree :: !Bool !d !Bool !FilePath [FilePath]-> Task [FilePath] | toPrompt d +selectFileTree :: !Bool !Bool !FilePath [FilePath]-> Task [FilePath] /** * Browse for a file in a lazy tree structure. * - * @param Prompt * @param Multiple selection allowed * @param Path to start in * @result Filepaths picked */ -selectFileTreeLazy :: !d !Bool !FilePath -> Task [FilePath] | toPrompt d +selectFileTreeLazy :: !Bool !FilePath -> Task [FilePath] diff --git a/Libraries/iTasks/Extensions/Files.icl b/Libraries/iTasks/Extensions/Files.icl index 06e78339c..1b5484f04 100644 --- a/Libraries/iTasks/Extensions/Files.icl +++ b/Libraries/iTasks/Extensions/Files.icl @@ -101,21 +101,21 @@ where //Why is this necessary?!?!?!? derive class iTask RTree, FileInfo, Tm -selectFileTree :: !Bool !d !Bool !FilePath [FilePath]-> Task [FilePath] | toPrompt d -selectFileTree exp prompt multi root initial +selectFileTree :: !Bool !Bool !FilePath [FilePath]-> Task [FilePath] +selectFileTree exp multi root initial = accWorld (readDirectoryTree root Nothing) @ numberTree - >>= \tree->editSelection prompt multi selectOption tree + >>= \tree->editSelection [SelectMultiple multi,selectOption] tree [i\\(i, (f, _))<-leafs tree | elem f initial] where selectOption = SelectInTree (\tree->[{foldTree (fp2cn exp) tree & label=root}]) (\tree sel->[f\\(i, (f, _))<-leafs tree | isMember i sel]) -selectFileTreeLazy :: !d !Bool !FilePath -> Task [FilePath] | toPrompt d -selectFileTreeLazy d multi root = accWorld (readDirectoryTree root (Just 1)) >>= \tree-> +selectFileTreeLazy :: !Bool !FilePath -> Task [FilePath] +selectFileTreeLazy multi root = accWorld (readDirectoryTree root (Just 1)) >>= \tree-> withShared tree \stree->let numberedtree = mapRead numberTree stree in withShared [] \ssel-> - editSharedSelectionWithShared d multi selOpt numberedtree ssel + editSharedSelectionWithShared [SelectMultiple multi,selOpt] numberedtree ssel -|| whileUnchanged (ssel >*< numberedtree) (\(sel, tree)->case sel of [i] = case find ((==)i o fst) (leafs tree) of Just (i, (fp, Ok {directory=True})) diff --git a/Libraries/iTasks/Util/Testing.icl b/Libraries/iTasks/Util/Testing.icl index 85753b674..c8edac049 100644 --- a/Libraries/iTasks/Util/Testing.icl +++ b/Libraries/iTasks/Util/Testing.icl @@ -83,28 +83,28 @@ filterTestsByName pattern tests = filter (\{UnitTest|name} -> indexOf pattern na //UTILITY TASKS testEditor :: (Editor a) (EditMode a) -> Task a | iTask a testEditor editor mode - = (interactR "Editor test" unitShare {onInit = const ((),mode), onEdit = \v l _ -> (l,v,Nothing), onRefresh = \_ l (Just v) -> (l,v,Nothing)} editor @ snd - >&> viewSharedInformation "Editor value" [ViewAs (toString o toJSON)] @? tvFromMaybe + = (interactR unitShare {onInit = const ((),mode), onEdit = \v l _ -> (l,v,Nothing), onRefresh = \_ l (Just v) -> (l,v,Nothing)} editor @ snd + >&> viewSharedInformation [ViewWithTitle "Editor value", ViewAs (toString o toJSON)] @? tvFromMaybe ) <<@ ArrangeHorizontal testEditorWithShare :: (Editor a) a Bool -> Task a | iTask a testEditorWithShare editor model viewMode = (withShared model \smodel -> - updateSharedInformation "Edit the shared source" [] smodel + (Hint "Edit the shared source" @>> updateSharedInformation [] smodel) ||- - interactR "Editor under test" smodel {onInit = \r -> ((),if viewMode View Update $ r) + (Title "Editor under test" @>> interactR smodel {onInit = \r -> ((),if viewMode View Update $ r) ,onEdit = \v l _ -> (l,v,Just (\_ -> v)) - ,onRefresh = \r l v -> (l,r,Nothing)} editor @ snd + ,onRefresh = \r l v -> (l,r,Nothing)} editor @ snd) ) <<@ ArrangeHorizontal testCommonInteractions :: String -> Task a | iTask a testCommonInteractions typeName - = enterInformation ("Enter","Enter information of type " +++ typeName) [] - -||- updateInformation ("Update","Update default value of type " +++ typeName) [] defaultValue + = (Title "Enter" @>> Hint ("Enter information of type " +++ typeName) @>> enterInformation []) + -||- (Title "Update" @>> Hint ("Update default value of type " +++ typeName) @>> updateInformation [] defaultValue) -||- (withShared defaultValue - \s -> (updateSharedInformation ("Update shared","Update shared value of type " +++ typeName) [] s + \s -> ((Title "Update shared" @>> Hint ("Update shared value of type " +++ typeName) @>> updateSharedInformation [] s) -|| - viewSharedInformation ("View shared","View shared value of type " +++ typeName) [] s + (Title "View shared" @>> Hint ("View shared value of type " +++ typeName) @>> viewSharedInformation [] s) ) ) diff --git a/Tests/Unit/iTasks/Extensions/Process/UnitTests.icl b/Tests/Unit/iTasks/Extensions/Process/UnitTests.icl index b22ec8e13..40686b1ef 100644 --- a/Tests/Unit/iTasks/Extensions/Process/UnitTests.icl +++ b/Tests/Unit/iTasks/Extensions/Process/UnitTests.icl @@ -23,22 +23,22 @@ testCallFastProcess = IF_WINDOWS (pass "Test call for fast process") (testTaskOutput "Test call fast process" sut events exp (\_ _ -> Passed)) //Only check if it does not crash where - sut = callProcess "Run fast process" [] "/bin/date" [] Nothing Nothing + sut = callProcess [] "/bin/date" [] Nothing Nothing events = [Left ResetEvent,Right 1,Left (RefreshEvent 'DS'.newSet "Update")] exp = TOUIChange <$> [ReplaceUI initialUI,ReplaceUI finishedUI] - initialUI = uiac UIContainer ('DM'.fromList [("stepped",JSONBool False)]) [toPrompt "Run fast process",uia UIProgressBar (textAttr "Running /bin/date...")] - finishedUI = uic UIContainer [toPrompt "Run fast process",uia UIProgressBar (textAttr "/bin/date done (0)")] + initialUI = uia UIProgressBar (textAttr "Running /bin/date...") + finishedUI = uia UIProgressBar (textAttr "/bin/date done (0)") testCallSlowProcess = IF_WINDOWS (pass "Test call for slow process") (testTaskOutput "Test call slow process" sut events exp (\_ _ -> Passed)) where - sut = callProcess "Run slow process" [] "/bin/sleep" ["2"] Nothing Nothing + sut = callProcess [] "/bin/sleep" ["2"] Nothing Nothing events = [Left ResetEvent ,Right 1 ,Left (RefreshEvent 'DS'.newSet "Update"),Right 2,Left (RefreshEvent 'DS'.newSet "Update") ,Left (RefreshEvent 'DS'.newSet "Update")] exp = TOUIChange <$> [ReplaceUI initialUI, ReplaceUI finishedUI] - initialUI = uic UIContainer [toPrompt "Run slow process",uia UIProgressBar (textAttr "Running /bin/sleep...")] - finishedUI = uic UIContainer [toPrompt "Run slow process",uia UIProgressBar (textAttr "/bin/sleep done (0)")] + initialUI = uia UIProgressBar (textAttr "Running /bin/sleep...") + finishedUI = uia UIProgressBar (textAttr "/bin/sleep done (0)") diff --git a/Tests/Unit/iTasks/Internal/TaskStore/UnitTests.icl b/Tests/Unit/iTasks/Internal/TaskStore/UnitTests.icl index 3a3755cd5..8eeb9be81 100644 --- a/Tests/Unit/iTasks/Internal/TaskStore/UnitTests.icl +++ b/Tests/Unit/iTasks/Internal/TaskStore/UnitTests.icl @@ -17,7 +17,7 @@ where # world = destroyIWorld iworld = (res,world) - minimalTask = viewInformation () [] "TEST" + minimalTask = viewInformation [] "TEST" tests = [testCreateTaskInstance] diff --git a/Tests/Unit/iTasks/WF/Tasks/Core/UnitTests.icl b/Tests/Unit/iTasks/WF/Tasks/Core/UnitTests.icl index bcc8b1531..db808bdfc 100644 --- a/Tests/Unit/iTasks/WF/Tasks/Core/UnitTests.icl +++ b/Tests/Unit/iTasks/WF/Tasks/Core/UnitTests.icl @@ -7,24 +7,16 @@ import Text.GenPrint derive gPrint TaskOutputMessage derive gPrint UIChange, UIChildChange, UIAttributeChange, UI, UIType, Map, JSONNode -//Test interact -expPromptUI msg - = uiac UIContainer - ('DM'.fromList [("marginTop",JSONInt 5),("marginRight",JSONInt 5),("marginBottom",JSONInt 10),("marginLeft",JSONInt 5) - ,("width",JSONString "flex"),("minWidth",JSONString "wrap"),("height",JSONString "wrap")]) - [uia UITextView ('DM'.fromList [("value",JSONString msg)])] - minimalInteractUI = skip (testTaskOutput "Initial UI of minimal interaction task" task events exp checkEqual) where task :: Task ((),String) - task = interactR "TEST" unitShare handlers gEditor{|*|} + task = interactR unitShare handlers gEditor{|*|} handlers = {onInit = \() -> ((),Update "Hello world"), onEdit = \_ l v -> (l,fromJust v,Nothing), onRefresh = \_ l v -> (l,fromJust v,Nothing)} events = [Left ResetEvent] exp = [TOUIChange (ReplaceUI expMinimalEditorUI)] - expMinimalEditorUI - = uic UIInteract [expPromptUI "TEST",editor] + expMinimalEditorUI = editor where editor = uia UITextField ('DM'.fromList [("hint-type",JSONString "valid") @@ -35,6 +27,7 @@ where ,("taskId",JSONString "1-0") ,("value",JSONString "Hello world") ,("minlength",JSONInt 1) + ,("task-type",JSONString "interact") ]) tests = [minimalInteractUI] diff --git a/Tools/CodeQualityMonitor.icl b/Tools/CodeQualityMonitor.icl index 2f53f7c6a..80c13c39a 100644 --- a/Tools/CodeQualityMonitor.icl +++ b/Tools/CodeQualityMonitor.icl @@ -56,12 +56,12 @@ inspectCodeQuality ) where application header mainTask - = (viewInformation () [] header ||- mainTask) <<@ ArrangeWithHeader 0 <<@ ApplyLayout (setUIType UIContainer) @! () + = (viewInformation [] header ||- mainTask) <<@ ArrangeWithHeader 0 <<@ ApplyLayout (setUIType UIContainer) @! () runInteractiveTests :: Task () runInteractiveTests - = ( editSelectionWithShared (Title "Select test") False (SelectInTree fileCollectionToTree selectTest) tests (const []) @? tvHd - >&> withSelection (viewInformation () [] "Select a test") testInteractive ) <<@ ArrangeWithSideBar 0 LeftSide True @! () + = ( (Title "Select test") @>> editSelectionWithShared [SelectMultiple False, SelectInTree fileCollectionToTree selectTest] tests (const []) @? tvHd + >&> withSelection (viewInformation [] "Select a test") testInteractive ) <<@ ArrangeWithSideBar 0 LeftSide True @! () where tests = sdsFocus INTERACTIVE_TESTS_PATH (fileCollection (\path isDirectory -> isDirectory || takeExtension path == "icl") False) @@ -89,11 +89,11 @@ where runUnitTests :: Task () runUnitTests = withShared 'DM'.newMap \results -> - (( ((editSelectionWithShared (Title "Tests") False - (SelectInTree toModuleSelectTree selectByIndex) + (( (((Title "Tests") @>> editSelectionWithShared + [SelectMultiple False, SelectInTree toModuleSelectTree selectByIndex] (sdsFocus UNIT_TESTS_PATH moduleList) (const []) @? tvHd) ) - >&> withSelection (viewInformation "Select a test" [] ()) + >&> withSelection (Hint "Select a test" @>> viewInformation [] ()) (viewTest results) ) @! ()) <<@ ArrangeWithSideBar 0 LeftSide True @@ -101,9 +101,9 @@ where selectByIndex nodes indices = [nodes !! i \\ i <- indices | i >= 0 && i < length nodes] viewTest results (name,_) - = (viewSharedInformation (Title "Code") [ViewUsing (join "\n") aceTextArea] (sdsFocus (UNIT_TESTS_PATH,name) moduleImplementation) + = ((Title "Code" @>> viewSharedInformation [ViewUsing (join "\n") aceTextArea] (sdsFocus (UNIT_TESTS_PATH,name) moduleImplementation)) -&&- - ((viewSharedInformation (Title "Results") [ViewAs (toTestReport o maybeToList)] (mapRead ('DM'.get name) results) <<@ ArrangeHorizontal) + (((Title "Results" @>> viewSharedInformation [ViewAs (toTestReport o maybeToList)] (mapRead ('DM'.get name) results)) <<@ ArrangeHorizontal) >^* [OnAction (Action "Run") (always ( runTestModule (UNIT_TESTS_PATH,name) <<@ InWindow >>- \res -> (upd ('DM'.put name res)) results @@ -149,12 +149,12 @@ where exploreCode :: Task () exploreCode - = (( ((editSelectionWithShared (Title "Modules") False - (SelectInTree toModuleSelectTree selectByIndex) + = (( (((Title "Modules") @>> editSelectionWithShared + [SelectMultiple False, SelectInTree toModuleSelectTree selectByIndex] (sdsFocus LIBRARY_PATH moduleList) (const []) @? tvHd) -|| viewQualityMetrics ) - >&> withSelection (viewInformation "Select a module" [] ()) + >&> withSelection (Hint "Select a module" @>> viewInformation [] ()) viewModule ) @! ()) <<@ ArrangeWithSideBar 0 LeftSide True @@ -163,13 +163,13 @@ where viewModule (name,MainModule) = allTasks - [viewSharedInformation (Title "Implementation") [] (sdsFocus (LIBRARY_PATH,name) moduleImplementation) + [(Title "Implementation") @>> viewSharedInformation [] (sdsFocus (LIBRARY_PATH,name) moduleImplementation) ] <<@ ArrangeWithTabs False viewModule (name,AuxModule) = allTasks - [viewSharedInformation (Title "Definition") [ViewAs toCodeTag] (sdsFocus (LIBRARY_PATH,name) moduleDefinition) - ,viewSharedInformation (Title "Implementation") [ViewAs toCodeTag] (sdsFocus (LIBRARY_PATH,name) moduleImplementation) + [(Title "Definition") @>> viewSharedInformation [ViewAs toCodeTag] (sdsFocus (LIBRARY_PATH,name) moduleDefinition) + ,(Title "Implementation") @>> viewSharedInformation [ViewAs toCodeTag] (sdsFocus (LIBRARY_PATH,name) moduleImplementation) ] <<@ ArrangeWithTabs False toCodeTag lines = PreTag [] [CodeTag [] [Html (join "\n" lines)]] @@ -207,9 +207,10 @@ where editSourceCode :: (Shared sds InspectState) -> Task InspectState | RWShared sds editSourceCode state - = updateSharedInformation (Title "Edit code") - [UpdateUsing (\{InspectState|lines} -> join OS_NEWLINE lines) + = Title "Edit code" @>> updateSharedInformation + [UpdateSharedUsing (\{InspectState|lines} -> join OS_NEWLINE lines) (\s c -> {InspectState|s & lines = split OS_NEWLINE c}) + const aceTextArea] state buildExecutable :: FilePath (Shared sds InspectState) -> Task () | RWShared sds @@ -227,7 +228,7 @@ where runBuildTool directory moduleName = get cpmExecutable - >>- \cpm -> callProcess () [] cpm [addExtension moduleName "prj"] (Just directory) Nothing + >>- \cpm -> callProcess [] cpm [addExtension moduleName "prj"] (Just directory) Nothing >>* [OnAction ActionClose (ifStable return)] //Pause after command... setExecutable directory moduleName state @@ -239,12 +240,12 @@ 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... ) ) @! () where - makeExecutable path = callProcess () [] "chmod" ["+x",path] Nothing Nothing + makeExecutable path = callProcess [] "chmod" ["+x",path] Nothing Nothing view _ = ATag [HrefAttr url,TargetAttr "_blank"] [Text "Running the test program at: ",Text url] where url = "http://localhost:8084" @@ -289,7 +290,7 @@ where viewQualityMetrics :: Task () viewQualityMetrics = analyzeITasksCodeBase - >>- viewInformation (Title "Metrics") [ViewAs view] @! () + >>- \a -> (Title "Metrics") @>> viewInformation [ViewAs view] a @! () where view {numFiles,numLines,numTODO,numFIXME} = UlTag [] [LiTag [] [Text "Number of files: ",Text (toString numFiles)] -- GitLab