Commit 81e85876 authored by Bas Lijnse's avatar Bas Lijnse

Converted tests to attribute api changes

parent acec3084
Pipeline #25298 failed with stage
in 2 minutes and 6 seconds
...@@ -103,7 +103,7 @@ rescanCodeBase codebase ...@@ -103,7 +103,7 @@ rescanCodeBase codebase
navigateCodebase :: CodeBase -> Task SourceTreeSelection navigateCodebase :: CodeBase -> Task SourceTreeSelection
navigateCodebase codebase navigateCodebase codebase
= enterChoice () [/* ChooseWith (ChooseFromTree (groupModules (sourceTreeRoots codebase)))*/] (modulesOf codebase) = enterChoice [/* ChooseWith (ChooseFromTree (groupModules (sourceTreeRoots codebase)))*/] (modulesOf codebase)
where where
modulesOf codebase modulesOf codebase
= flatten [[SelSourceTree name rootPath:[moduleSelection modName modType modPath \\ (modName,modType,modPath) <- modules]] \\ {SourceTree|name,rootPath,modules} <- codebase] = flatten [[SelSourceTree name rootPath:[moduleSelection modName modType modPath \\ (modName,modType,modPath) <- modules]] \\ {SourceTree|name,rootPath,modules} <- codebase]
......
...@@ -56,19 +56,17 @@ copyDirectory :: !FilePath !FilePath -> Task () ...@@ -56,19 +56,17 @@ copyDirectory :: !FilePath !FilePath -> Task ()
* If your file structure is big or contains cyclic links, choose {{`selectFileLazyTree`}} * If your file structure is big or contains cyclic links, choose {{`selectFileLazyTree`}}
* *
* @param Start with all directories expanded * @param Start with all directories expanded
* @param Prompt
* @param Flag for multiple selection * @param Flag for multiple selection
* @param Root directory to select from * @param Root directory to select from
* @param Initial selection * @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. * Browse for a file in a lazy tree structure.
* *
* @param Prompt
* @param Multiple selection allowed * @param Multiple selection allowed
* @param Path to start in * @param Path to start in
* @result Filepaths picked * @result Filepaths picked
*/ */
selectFileTreeLazy :: !d !Bool !FilePath -> Task [FilePath] | toPrompt d selectFileTreeLazy :: !Bool !FilePath -> Task [FilePath]
...@@ -101,21 +101,21 @@ where ...@@ -101,21 +101,21 @@ where
//Why is this necessary?!?!?!? //Why is this necessary?!?!?!?
derive class iTask RTree, FileInfo, Tm derive class iTask RTree, FileInfo, Tm
selectFileTree :: !Bool !d !Bool !FilePath [FilePath]-> Task [FilePath] | toPrompt d selectFileTree :: !Bool !Bool !FilePath [FilePath]-> Task [FilePath]
selectFileTree exp prompt multi root initial selectFileTree exp multi root initial
= accWorld (readDirectoryTree root Nothing) @ numberTree = 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] [i\\(i, (f, _))<-leafs tree | elem f initial]
where where
selectOption = SelectInTree selectOption = SelectInTree
(\tree->[{foldTree (fp2cn exp) tree & label=root}]) (\tree->[{foldTree (fp2cn exp) tree & label=root}])
(\tree sel->[f\\(i, (f, _))<-leafs tree | isMember i sel]) (\tree sel->[f\\(i, (f, _))<-leafs tree | isMember i sel])
selectFileTreeLazy :: !d !Bool !FilePath -> Task [FilePath] | toPrompt d selectFileTreeLazy :: !Bool !FilePath -> Task [FilePath]
selectFileTreeLazy d multi root = accWorld (readDirectoryTree root (Just 1)) >>= \tree-> selectFileTreeLazy multi root = accWorld (readDirectoryTree root (Just 1)) >>= \tree->
withShared tree \stree->let numberedtree = mapRead numberTree stree in withShared tree \stree->let numberedtree = mapRead numberTree stree in
withShared [] \ssel-> withShared [] \ssel->
editSharedSelectionWithShared d multi selOpt numberedtree ssel editSharedSelectionWithShared [SelectMultiple multi,selOpt] numberedtree ssel
-|| whileUnchanged (ssel >*< numberedtree) (\(sel, tree)->case sel of -|| whileUnchanged (ssel >*< numberedtree) (\(sel, tree)->case sel of
[i] = case find ((==)i o fst) (leafs tree) of [i] = case find ((==)i o fst) (leafs tree) of
Just (i, (fp, Ok {directory=True})) Just (i, (fp, Ok {directory=True}))
......
...@@ -83,28 +83,28 @@ filterTestsByName pattern tests = filter (\{UnitTest|name} -> indexOf pattern na ...@@ -83,28 +83,28 @@ filterTestsByName pattern tests = filter (\{UnitTest|name} -> indexOf pattern na
//UTILITY TASKS //UTILITY TASKS
testEditor :: (Editor a) (EditMode a) -> Task a | iTask a testEditor :: (Editor a) (EditMode a) -> Task a | iTask a
testEditor editor mode 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 = (interactR 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 >&> viewSharedInformation [ViewWithTitle "Editor value", ViewAs (toString o toJSON)] @? tvFromMaybe
) <<@ ArrangeHorizontal ) <<@ ArrangeHorizontal
testEditorWithShare :: (Editor a) a Bool -> Task a | iTask a testEditorWithShare :: (Editor a) a Bool -> Task a | iTask a
testEditorWithShare editor model viewMode = (withShared model testEditorWithShare editor model viewMode = (withShared model
\smodel -> \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)) ,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 ) <<@ ArrangeHorizontal
testCommonInteractions :: String -> Task a | iTask a testCommonInteractions :: String -> Task a | iTask a
testCommonInteractions typeName testCommonInteractions typeName
= enterInformation ("Enter","Enter information of type " +++ typeName) [] = (Title "Enter" @>> Hint ("Enter information of type " +++ typeName) @>> enterInformation [])
-||- updateInformation ("Update","Update default value of type " +++ typeName) [] defaultValue -||- (Title "Update" @>> Hint ("Update default value of type " +++ typeName) @>> updateInformation [] defaultValue)
-||- (withShared 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)
) )
) )
......
...@@ -23,22 +23,22 @@ testCallFastProcess = IF_WINDOWS ...@@ -23,22 +23,22 @@ testCallFastProcess = IF_WINDOWS
(pass "Test call for fast process") (pass "Test call for fast process")
(testTaskOutput "Test call fast process" sut events exp (\_ _ -> Passed)) //Only check if it does not crash (testTaskOutput "Test call fast process" sut events exp (\_ _ -> Passed)) //Only check if it does not crash
where 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")] events = [Left ResetEvent,Right 1,Left (RefreshEvent 'DS'.newSet "Update")]
exp = TOUIChange <$> [ReplaceUI initialUI,ReplaceUI finishedUI] exp = TOUIChange <$> [ReplaceUI initialUI,ReplaceUI finishedUI]
initialUI = uiac UIContainer ('DM'.fromList [("stepped",JSONBool False)]) [toPrompt "Run fast process",uia UIProgressBar (textAttr "Running /bin/date...")] initialUI = uia UIProgressBar (textAttr "Running /bin/date...")
finishedUI = uic UIContainer [toPrompt "Run fast process",uia UIProgressBar (textAttr "/bin/date done (0)")] finishedUI = uia UIProgressBar (textAttr "/bin/date done (0)")
testCallSlowProcess = IF_WINDOWS testCallSlowProcess = IF_WINDOWS
(pass "Test call for slow process") (pass "Test call for slow process")
(testTaskOutput "Test call slow process" sut events exp (\_ _ -> Passed)) (testTaskOutput "Test call slow process" sut events exp (\_ _ -> Passed))
where 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")] 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] exp = TOUIChange <$> [ReplaceUI initialUI, ReplaceUI finishedUI]
initialUI = uic UIContainer [toPrompt "Run slow process",uia UIProgressBar (textAttr "Running /bin/sleep...")] initialUI = uia UIProgressBar (textAttr "Running /bin/sleep...")
finishedUI = uic UIContainer [toPrompt "Run slow process",uia UIProgressBar (textAttr "/bin/sleep done (0)")] finishedUI = uia UIProgressBar (textAttr "/bin/sleep done (0)")
...@@ -17,7 +17,7 @@ where ...@@ -17,7 +17,7 @@ where
# world = destroyIWorld iworld # world = destroyIWorld iworld
= (res,world) = (res,world)
minimalTask = viewInformation () [] "TEST" minimalTask = viewInformation [] "TEST"
tests = [testCreateTaskInstance] tests = [testCreateTaskInstance]
......
...@@ -7,24 +7,16 @@ import Text.GenPrint ...@@ -7,24 +7,16 @@ import Text.GenPrint
derive gPrint TaskOutputMessage derive gPrint TaskOutputMessage
derive gPrint UIChange, UIChildChange, UIAttributeChange, UI, UIType, Map, JSONNode 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) minimalInteractUI = skip (testTaskOutput "Initial UI of minimal interaction task" task events exp checkEqual)
where where
task :: Task ((),String) 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)} handlers = {onInit = \() -> ((),Update "Hello world"), onEdit = \_ l v -> (l,fromJust v,Nothing), onRefresh = \_ l v -> (l,fromJust v,Nothing)}
events = [Left ResetEvent] events = [Left ResetEvent]
exp = [TOUIChange (ReplaceUI expMinimalEditorUI)] exp = [TOUIChange (ReplaceUI expMinimalEditorUI)]
expMinimalEditorUI expMinimalEditorUI = editor
= uic UIInteract [expPromptUI "TEST",editor]
where where
editor = uia UITextField ('DM'.fromList editor = uia UITextField ('DM'.fromList
[("hint-type",JSONString "valid") [("hint-type",JSONString "valid")
...@@ -35,6 +27,7 @@ where ...@@ -35,6 +27,7 @@ where
,("taskId",JSONString "1-0") ,("taskId",JSONString "1-0")
,("value",JSONString "Hello world") ,("value",JSONString "Hello world")
,("minlength",JSONInt 1) ,("minlength",JSONInt 1)
,("task-type",JSONString "interact")
]) ])
tests = [minimalInteractUI] tests = [minimalInteractUI]
......
...@@ -56,12 +56,12 @@ inspectCodeQuality ...@@ -56,12 +56,12 @@ inspectCodeQuality
) )
where where
application header mainTask application header mainTask
= (viewInformation () [] header ||- mainTask) <<@ ArrangeWithHeader 0 <<@ ApplyLayout (setUIType UIContainer) @! () = (viewInformation [] header ||- mainTask) <<@ ArrangeWithHeader 0 <<@ ApplyLayout (setUIType UIContainer) @! ()
runInteractiveTests :: Task () runInteractiveTests :: Task ()
runInteractiveTests runInteractiveTests
= ( editSelectionWithShared (Title "Select test") False (SelectInTree fileCollectionToTree selectTest) tests (const []) @? tvHd = ( (Title "Select test") @>> editSelectionWithShared [SelectMultiple False, SelectInTree fileCollectionToTree selectTest] tests (const []) @? tvHd
>&> withSelection (viewInformation () [] "Select a test") testInteractive ) <<@ ArrangeWithSideBar 0 LeftSide True @! () >&> withSelection (viewInformation [] "Select a test") testInteractive ) <<@ ArrangeWithSideBar 0 LeftSide True @! ()
where where
tests = sdsFocus INTERACTIVE_TESTS_PATH (fileCollection (\path isDirectory -> isDirectory || takeExtension path == "icl") False) tests = sdsFocus INTERACTIVE_TESTS_PATH (fileCollection (\path isDirectory -> isDirectory || takeExtension path == "icl") False)
...@@ -89,11 +89,11 @@ where ...@@ -89,11 +89,11 @@ where
runUnitTests :: Task () runUnitTests :: Task ()
runUnitTests = withShared 'DM'.newMap runUnitTests = withShared 'DM'.newMap
\results -> \results ->
(( ((editSelectionWithShared (Title "Tests") False (( (((Title "Tests") @>> editSelectionWithShared
(SelectInTree toModuleSelectTree selectByIndex) [SelectMultiple False, SelectInTree toModuleSelectTree selectByIndex]
(sdsFocus UNIT_TESTS_PATH moduleList) (const []) @? tvHd) (sdsFocus UNIT_TESTS_PATH moduleList) (const []) @? tvHd)
) )
>&> withSelection (viewInformation "Select a test" [] ()) >&> withSelection (Hint "Select a test" @>> viewInformation [] ())
(viewTest results) (viewTest results)
) )
@! ()) <<@ ArrangeWithSideBar 0 LeftSide True @! ()) <<@ ArrangeWithSideBar 0 LeftSide True
...@@ -101,9 +101,9 @@ where ...@@ -101,9 +101,9 @@ where
selectByIndex nodes indices = [nodes !! i \\ i <- indices | i >= 0 && i < length nodes] selectByIndex nodes indices = [nodes !! i \\ i <- indices | i >= 0 && i < length nodes]
viewTest results (name,_) 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 >^* [OnAction (Action "Run") (always
( runTestModule (UNIT_TESTS_PATH,name) <<@ InWindow ( runTestModule (UNIT_TESTS_PATH,name) <<@ InWindow
>>- \res -> (upd ('DM'.put name res)) results >>- \res -> (upd ('DM'.put name res)) results
...@@ -149,12 +149,12 @@ where ...@@ -149,12 +149,12 @@ where
exploreCode :: Task () exploreCode :: Task ()
exploreCode exploreCode
= (( ((editSelectionWithShared (Title "Modules") False = (( (((Title "Modules") @>> editSelectionWithShared
(SelectInTree toModuleSelectTree selectByIndex) [SelectMultiple False, SelectInTree toModuleSelectTree selectByIndex]
(sdsFocus LIBRARY_PATH moduleList) (const []) @? tvHd) (sdsFocus LIBRARY_PATH moduleList) (const []) @? tvHd)
-|| viewQualityMetrics -|| viewQualityMetrics
) )
>&> withSelection (viewInformation "Select a module" [] ()) >&> withSelection (Hint "Select a module" @>> viewInformation [] ())
viewModule viewModule
) )
@! ()) <<@ ArrangeWithSideBar 0 LeftSide True @! ()) <<@ ArrangeWithSideBar 0 LeftSide True
...@@ -163,13 +163,13 @@ where ...@@ -163,13 +163,13 @@ where
viewModule (name,MainModule) viewModule (name,MainModule)
= allTasks = allTasks
[viewSharedInformation (Title "Implementation") [] (sdsFocus (LIBRARY_PATH,name) moduleImplementation) [(Title "Implementation") @>> viewSharedInformation [] (sdsFocus (LIBRARY_PATH,name) moduleImplementation)
] <<@ ArrangeWithTabs False ] <<@ ArrangeWithTabs False
viewModule (name,AuxModule) viewModule (name,AuxModule)
= allTasks = allTasks
[viewSharedInformation (Title "Definition") [ViewAs toCodeTag] (sdsFocus (LIBRARY_PATH,name) moduleDefinition) [(Title "Definition") @>> viewSharedInformation [ViewAs toCodeTag] (sdsFocus (LIBRARY_PATH,name) moduleDefinition)
,viewSharedInformation (Title "Implementation") [ViewAs toCodeTag] (sdsFocus (LIBRARY_PATH,name) moduleImplementation) ,(Title "Implementation") @>> viewSharedInformation [ViewAs toCodeTag] (sdsFocus (LIBRARY_PATH,name) moduleImplementation)
] <<@ ArrangeWithTabs False ] <<@ ArrangeWithTabs False
toCodeTag lines = PreTag [] [CodeTag [] [Html (join "\n" lines)]] toCodeTag lines = PreTag [] [CodeTag [] [Html (join "\n" lines)]]
...@@ -207,9 +207,10 @@ where ...@@ -207,9 +207,10 @@ where
editSourceCode :: (Shared sds InspectState) -> Task InspectState | RWShared sds editSourceCode :: (Shared sds InspectState) -> Task InspectState | RWShared sds
editSourceCode state editSourceCode state
= updateSharedInformation (Title "Edit code") = Title "Edit code" @>> updateSharedInformation
[UpdateUsing (\{InspectState|lines} -> join OS_NEWLINE lines) [UpdateSharedUsing (\{InspectState|lines} -> join OS_NEWLINE lines)
(\s c -> {InspectState|s & lines = split OS_NEWLINE c}) (\s c -> {InspectState|s & lines = split OS_NEWLINE c})
const
aceTextArea] state aceTextArea] state
buildExecutable :: FilePath (Shared sds InspectState) -> Task () | RWShared sds buildExecutable :: FilePath (Shared sds InspectState) -> Task () | RWShared sds
...@@ -227,7 +228,7 @@ where ...@@ -227,7 +228,7 @@ where
runBuildTool directory moduleName runBuildTool directory moduleName
= get cpmExecutable = 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... >>* [OnAction ActionClose (ifStable return)] //Pause after command...
setExecutable directory moduleName state setExecutable directory moduleName state
...@@ -239,12 +240,12 @@ where ...@@ -239,12 +240,12 @@ where
>>- maybe (throw "Cannot run the program. There is no executable yet") >>- maybe (throw "Cannot run the program. There is no executable yet")
(\executable -> (\executable ->
makeExecutable 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... >>* [OnAction ActionClose (always (return ()))] //Pause after command...
) )
) @! () ) @! ()
where 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] view _ = ATag [HrefAttr url,TargetAttr "_blank"] [Text "Running the test program at: ",Text url]
where where
url = "http://localhost:8084" url = "http://localhost:8084"
...@@ -289,7 +290,7 @@ where ...@@ -289,7 +290,7 @@ where
viewQualityMetrics :: Task () viewQualityMetrics :: Task ()
viewQualityMetrics viewQualityMetrics
= analyzeITasksCodeBase = analyzeITasksCodeBase
>>- viewInformation (Title "Metrics") [ViewAs view] @! () >>- \a -> (Title "Metrics") @>> viewInformation [ViewAs view] a @! ()
where where
view {numFiles,numLines,numTODO,numFIXME} view {numFiles,numLines,numTODO,numFIXME}
= UlTag [] [LiTag [] [Text "Number of files: ",Text (toString numFiles)] = UlTag [] [LiTag [] [Text "Number of files: ",Text (toString numFiles)]
......
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