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
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]
......
......@@ -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]
......@@ -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}))
......
......@@ -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)
)
)
......
......@@ -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)")
......@@ -17,7 +17,7 @@ where
# world = destroyIWorld iworld
= (res,world)
minimalTask = viewInformation () [] "TEST"
minimalTask = viewInformation [] "TEST"
tests = [testCreateTaskInstance]
......
......@@ -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]
......
......@@ -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)]
......
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