Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
I
iTasks-SDK
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
75
Issues
75
List
Boards
Labels
Service Desk
Milestones
Merge Requests
7
Merge Requests
7
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
clean-and-itasks
iTasks-SDK
Commits
81e85876
Commit
81e85876
authored
Jun 14, 2019
by
Bas Lijnse
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Converted tests to attribute api changes
parent
acec3084
Pipeline
#25298
failed with stage
in 2 minutes and 6 seconds
Changes
8
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
49 additions
and
57 deletions
+49
-57
Libraries/iTasks/Extensions/Development/Codebase.icl
Libraries/iTasks/Extensions/Development/Codebase.icl
+1
-1
Libraries/iTasks/Extensions/Files.dcl
Libraries/iTasks/Extensions/Files.dcl
+2
-4
Libraries/iTasks/Extensions/Files.icl
Libraries/iTasks/Extensions/Files.icl
+6
-6
Libraries/iTasks/Util/Testing.icl
Libraries/iTasks/Util/Testing.icl
+9
-9
Tests/Unit/iTasks/Extensions/Process/UnitTests.icl
Tests/Unit/iTasks/Extensions/Process/UnitTests.icl
+6
-6
Tests/Unit/iTasks/Internal/TaskStore/UnitTests.icl
Tests/Unit/iTasks/Internal/TaskStore/UnitTests.icl
+1
-1
Tests/Unit/iTasks/WF/Tasks/Core/UnitTests.icl
Tests/Unit/iTasks/WF/Tasks/Core/UnitTests.icl
+3
-10
Tools/CodeQualityMonitor.icl
Tools/CodeQualityMonitor.icl
+21
-20
No files found.
Libraries/iTasks/Extensions/Development/Codebase.icl
View file @
81e85876
...
@@ -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
]
...
...
Libraries/iTasks/Extensions/Files.dcl
View file @
81e85876
...
@@ -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
]
Libraries/iTasks/Extensions/Files.icl
View file @
81e85876
...
@@ -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
}))
...
...
Libraries/iTasks/Util/Testing.icl
View file @
81e85876
...
@@ -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
)
)
)
)
)
...
...
Tests/Unit/iTasks/Extensions/Process/UnitTests.icl
View file @
81e85876
...
@@ -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
=
uia
c
UIContainer
('
DM
'.
fromList
[(
"stepped"
,
JSONBool
False
)])
[
toPrompt
"Run fast process"
,
uia
UIProgressBar
(
textAttr
"Running /bin/date..."
)]
initialUI
=
uia
UIProgressBar
(
textAttr
"Running /bin/date..."
)
finishedUI
=
ui
c
UIContainer
[
toPrompt
"Run fast process"
,
uia
UIProgressBar
(
textAttr
"/bin/date done (0)"
)]
finishedUI
=
ui
a
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
=
ui
c
UIContainer
[
toPrompt
"Run slow process"
,
uia
UIProgressBar
(
textAttr
"Running /bin/sleep..."
)]
initialUI
=
ui
a
UIProgressBar
(
textAttr
"Running /bin/sleep..."
)
finishedUI
=
ui
c
UIContainer
[
toPrompt
"Run slow process"
,
uia
UIProgressBar
(
textAttr
"/bin/sleep done (0)"
)]
finishedUI
=
ui
a
UIProgressBar
(
textAttr
"/bin/sleep done (0)"
)
Tests/Unit/iTasks/Internal/TaskStore/UnitTests.icl
View file @
81e85876
...
@@ -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
]
...
...
Tests/Unit/iTasks/WF/Tasks/Core/UnitTests.icl
View file @
81e85876
...
@@ -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
]
...
...
Tools/CodeQualityMonitor.icl
View file @
81e85876
...
@@ -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
)
[
Update
Shared
Using
(\{
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
)]
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment