CodeQualityMonitor.icl 14 KB
Newer Older
1 2 3 4 5
module CodeQualityMonitor
/**
* This tool supports the task of monitoring the quality of the iTasks codebase.
* It allows you to run test programs and exlore the codebase
*/
6
import StdArray
7
import System.OS
8
import Text, Text.HTML
9
import Data.List, Data.Func
10
import qualified Data.Map as DM
11
import Data.Map.GenJSON
12

13
import Testing.TestEvents
14
import iTasks
15
import iTasks.Util.Testing
16
import iTasks.UI.Definition
17
import iTasks.UI.Editor, iTasks.UI.Editor.Controls, iTasks.UI.Editor.Modifiers
18

19 20 21
import iTasks.Extensions.Editors.Ace
import iTasks.Extensions.Development.Codebase
import iTasks.Extensions.Development.Testing
22
import iTasks.Extensions.Development.Tools
23 24
import iTasks.Extensions.Image
import iTasks.Extensions.TextFile
25 26
import iTasks.Extensions.Document
import iTasks.Extensions.Process
27
import iTasks.Extensions.FileCollection
28

29 30
UNIT_TESTS_PATH :== "../Tests/Unit"
INTERACTIVE_TESTS_PATH :== "../Tests/Interactive"
31

32
LIBRARY_PATH :== "../Libraries"
33 34
EXAMPLE_MODULES :== ["../Examples/BasicApiExamples.icl"
                    ,"../Examples/Applications/Incidone/IncidoneCCC.icl"
35 36
                    ,"../Examples/Applications/ShipAdventure/main.icl"
                    ,"../Examples/Applications/TheTaxMan/TheTaxMan.icl"
37 38
                    ,"../Examples/GIS/LeafletMapExample.icl"
                    ]
39

40
derive class iTask EndEventType, Expression
41

Camil Staps's avatar
Camil Staps committed
42 43 44
derive gEditor EndEvent, TestLocation, FailReason, FailedAssertion, CounterExample, Relation
derive gEq EndEvent, TestLocation, FailReason, FailedAssertion, CounterExample, Relation
derive gText EndEvent, TestLocation, FailReason, FailedAssertion, CounterExample, Relation
45

46 47 48 49 50
inspectCodeQuality :: Task ()
inspectCodeQuality
	= application {WebImage|src="/testbench.png",alt="iTasks Testbench",width=200, height=50}
    	( allTasks [Title "Unit Tests"           @>> runUnitTests 
				   ,Title "Interactive Tests"    @>> runInteractiveTests 
51
				 //,Title "Example applications" @>> checkExampleApplications
52
				   ,Title "Code"                 @>> exploreCode 
53
                   ,Title "Experiment"           @>> inspectMainModule "test" "module test\nStart = \"Hello World\""
54 55
				   ] <<@ ArrangeWithTabs False
		)
56
where
57
	application header mainTask
58
		= (viewInformation [] header ||- mainTask) <<@ ArrangeWithHeader 0 <<@ ApplyLayout (setUIType UIContainer) @! ()
59

60 61
runInteractiveTests :: Task ()
runInteractiveTests
62 63
	= (     (Title "Select test") @>> editSelectionWithShared [SelectMultiple False, SelectInTree fileCollectionToTree selectTest] tests (const []) @? tvHd
		>&> withSelection (viewInformation [] "Select a test") testInteractive ) <<@ ArrangeWithSideBar 0 LeftSide True @! ()
64
where
65
	tests = sdsFocus INTERACTIVE_TESTS_PATH (fileCollection (\path isDirectory -> isDirectory || takeExtension path == "icl") False)
66

67
	fileCollectionToTree collection = itemsToTree [] collection
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
	where
		itemsToTree prefix subCollection = map (itemToTree prefix) ('DM'.toList subCollection)

		itemToTree prefix (name,FileContent _)
			= {ChoiceNode|id = determineItemId (fileName [name:prefix]) collection, label = name
              , expanded = False, icon = Nothing, children = []}
		itemToTree prefix (name,FileCollection subCollection)
			= {ChoiceNode|id = determineItemId (fileName [name:prefix]) collection, label = name
              , expanded = False, icon = Nothing, children = itemsToTree [name:prefix] subCollection}

	fileName path = join {OS_PATH_SEPARATOR} (reverse path)

	determineItemId path collection = fromMaybe -1 (elemIndex path (toPaths collection))

	selectTest collection indices = filter (((==) "icl") o takeExtension) (getItems (toPaths collection) indices)

	testInteractive modulePath 
		=   importTextFile (INTERACTIVE_TESTS_PATH </> modulePath) 
		>>- inspectMainModule (dropExtension (dropDirectory modulePath))
87 88 89 90

runUnitTests :: Task ()
runUnitTests = withShared 'DM'.newMap
	\results ->
91 92
	 ((    (((Title "Tests") @>> editSelectionWithShared
				[SelectMultiple False, SelectInTree toModuleSelectTree selectByIndex]
93 94
				(sdsFocus UNIT_TESTS_PATH moduleList) (const []) @? tvHd)
			)
95
		   >&> withSelection (Hint "Select a test" @>> viewInformation [] ())
96 97
                             (viewTest results)
          )
98
		@! ()) <<@ ArrangeWithSideBar 0 LeftSide True
99 100 101 102
where
	selectByIndex nodes indices = [nodes !! i \\ i <- indices | i >= 0 && i < length nodes]

	viewTest results (name,_)
103
		= ((Title "Code" @>> viewSharedInformation [ViewUsing (join "\n") aceTextArea] (sdsFocus (UNIT_TESTS_PATH,name) moduleImplementation))
104
		-&&-
105
		  (((Title "Results" @>> viewSharedInformation [ViewAs (toTestReport o maybeToList)] (mapRead ('DM'.get name) results)) <<@ ArrangeHorizontal)
106
				>^* [OnAction (Action "Run") (always
107 108
						(		runTestModule (UNIT_TESTS_PATH,name) <<@ InWindow
							>>- \res -> (upd ('DM'.put name res)) results
109 110
						)
					)]
111
		) @! ()) <<@ ArrangeWithSideBar 1 RightSide True
112

113
	toTestReport results
114
		= DivTag [] [setHtml res \\ res <- results | not (isEmpty results)]
115
	where
116
		setHtml testResults
117
			= TableTag [StyleAttr "width: 100%"] [headerRow:map resultRow testResults]
118 119 120

		headerRow = TrTag [] [ThTag [] [Text "Test"],ThTag [] [Text "Result"],ThTag [] [Text "Details"]]

121 122 123 124
		resultRow {name,event=Passed,message} = TrTag [] [TdTag [] [Text name],TdTag [] [SpanTag [StyleAttr "color: green"] [Text "Passed"]],TdTag [] [Text message]]
		resultRow {name,event=Skipped,message} = TrTag [] [TdTag [] [Text name],TdTag [] [SpanTag [StyleAttr "color: orange"] [Text "Skipped"]],TdTag [] [Text message]]
		resultRow {name,event=Failed Nothing,message} = TrTag [] [TdTag [] [Text name],TdTag [] [SpanTag [StyleAttr "color: red"] [Text "Failed"]],TdTag [] [Text message]]
		resultRow {name,event=Failed (Just details),message} = TrTag [] [TdTag [] [Text name],TdTag [] [SpanTag [StyleAttr "color: red"] [Text "Failed"]],TdTag [] [TextareaTag [] [Text (toString (toJSON details))]]]
125

126
/*
127 128
checkExampleApplications = withShared 'DM'.newMap
	\results ->
129 130 131 132
		(
		 (enterChoiceWithSharedAs () [ChooseFromGrid fst] (examplesWithResults results) fst 
		>&> withSelection (viewInformation "Select an example" [] ())
			(\path -> 
Bas Lijnse's avatar
Bas Lijnse committed
133
				(viewSharedInformation (Title "Code") [ViewUsing id aceTextArea] (sdsFocus path (removeMaybe Nothing fileShare))
134 135 136 137 138 139 140
				-&&-
				viewSharedInformation (Title "Results") [] (mapRead ('DM'.get path) results) <<@ ArrangeHorizontal)
				>^* [OnAction (Action "Run") (always
						(		compileTestModule path <<@ InWindow
							>>- \res -> (upd ('DM'.put path res)) results
						)
					)]
141
			) @! ()) <<@ ArrangeWithSideBar 0 LeftSide True
142
		)		
143 144
where
	examplesWithResults results = mapRead (\(res,examples) -> [(e,'DM'.get e res) \\e <- examples ]) (results |*| examples)
145
	where
146
		examples = constShare EXAMPLE_MODULES
147
*/
148

149 150
exploreCode :: Task ()
exploreCode 
151 152
	= ((    (((Title "Modules") @>> editSelectionWithShared 
				[SelectMultiple False, SelectInTree toModuleSelectTree selectByIndex]
153 154 155
				(sdsFocus LIBRARY_PATH moduleList) (const []) @? tvHd)
			 	-|| viewQualityMetrics
			)
156
		   >&> withSelection (Hint "Select a module" @>> viewInformation [] ())
157 158
                             viewModule 
          )
159
		@! ()) <<@ ArrangeWithSideBar 0 LeftSide True
160
where
161 162 163 164
	selectByIndex nodes indices = [nodes !! i \\ i <- indices | i >= 0 && i < length nodes]

	viewModule (name,MainModule)
		= allTasks
165
			[(Title "Implementation") @>> viewSharedInformation [] (sdsFocus (LIBRARY_PATH,name) moduleImplementation)
166
			] <<@ ArrangeWithTabs False
167 168 169

	viewModule (name,AuxModule)
		= allTasks
170 171
			[(Title "Definition") @>> viewSharedInformation [ViewAs toCodeTag] (sdsFocus (LIBRARY_PATH,name) moduleDefinition)
			,(Title "Implementation") @>> viewSharedInformation [ViewAs toCodeTag] (sdsFocus (LIBRARY_PATH,name) moduleImplementation)
172
			] <<@ ArrangeWithTabs False
173

174
	toCodeTag lines = PreTag [] [CodeTag [] [Html (join "\n" lines)]]
175 176 177

//Inspecting individual programs 
:: InspectState
178 179
  = { moduleName  :: String
    , lines       :: [String]
180
    , executable  :: Maybe FilePath
181 182 183 184 185 186
    }

derive class iTask InspectState

// To inspect code we need to do a few things:
// We must be able to view it, change it without risk and run it with changes
187 188 189
inspectMainModule :: String String -> Task ()
inspectMainModule moduleName sourceCode = withShared
	(initialInspectState moduleName sourceCode)
190 191 192 193 194 195
	(\state -> withTemporaryDirectory
		\workDirectory ->
			editSourceCode state
			>^* [OnAction (Action "Build") (always (buildExecutable workDirectory state))
				,OnAction (Action "Run")   (ifValue hasExecutable (\_ -> runProgram workDirectory state))
				]
196 197
    ) @! ()
where
198
	initialInspectState moduleName ourceCode
199
		= {InspectState
200 201
          |moduleName = moduleName
          ,lines = split OS_NEWLINE sourceCode
202 203 204
 		  ,executable = Nothing
		  }

205
	hasExecutable {InspectState|executable} = (executable =: (Just _))
206

207
	editSourceCode :: (Shared sds InspectState) -> Task InspectState | RWShared sds
208
	editSourceCode state
209 210
		= Title "Edit code" @>> updateSharedInformation 
			[UpdateSharedUsing (\{InspectState|lines} -> join OS_NEWLINE lines)
211
                         (\s c -> {InspectState|s & lines = split OS_NEWLINE c})
212
						 (const o Just)
213 214
                         aceTextArea] state

215
	buildExecutable :: FilePath (Shared sds InspectState) -> Task () | RWShared sds
216
	buildExecutable temporaryDirectory state = 
217 218 219
              get state @ (\{InspectState|moduleName,lines} -> (moduleName,join OS_NEWLINE lines))
		  >>- \(moduleName,sourceCode) -> 
              prepareBuildFiles temporaryDirectory moduleName sourceCode
220 221
		  >-| runBuildTool temporaryDirectory moduleName
		  >-| setExecutable temporaryDirectory moduleName state
222 223
		  @!  ()
	where
224
		prepareBuildFiles directory moduleName sourceCode
225 226
			=   exportTextFile (directory </> addExtension moduleName "icl") sourceCode
			>-| exportTextFile (directory </> addExtension moduleName "prj") (projectTemplate moduleName)
227
		
228
		runBuildTool directory moduleName
229
			=   get cpmExecutable 
230
			>>- \cpm -> callProcess [] cpm [addExtension moduleName "prj"] (Just directory) Nothing
231
			>>* [OnAction ActionClose (ifStable return)] //Pause after command...
232
		
233 234 235
		setExecutable directory moduleName state
            = upd (\s -> {InspectState|s & executable = Just (directory </> addExtension moduleName "exe")}) state

236
	runProgram :: FilePath (Shared sds InspectState) -> Task () | RWShared sds
237
	runProgram temporaryDirectory state = (
238 239
			    get state @ (\{InspectState|executable} -> executable)
			>>-	maybe (throw "Cannot run the program. There is no executable yet")
240 241
				      (\executable -> 
									makeExecutable executable
242
						>-| callProcess [ViewAs view] executable ["-port","8084"] (Just temporaryDirectory) Nothing
243
						>>* [OnAction ActionClose (always (return ()))] //Pause after command...
244 245 246
					  )
		) @! ()
	where
247
		makeExecutable path = callProcess [] "chmod" ["+x",path] Nothing Nothing
248 249 250
		view _ = ATag [HrefAttr url,TargetAttr "_blank"] [Text "Running the test program at: ",Text url]
		where
			url = "http://localhost:8084"
251

252
:: SourceTreeQualityMetrics =
253 254 255
	{ numFiles :: Int
    , numLines :: Int
    , numTODO  :: Int
256 257
	, numFIXME :: Int
	}
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272

instance zero SourceTreeQualityMetrics
where
	zero =
		{numFiles = 0, numLines = 0, numTODO=0,numFIXME=0}

instance + SourceTreeQualityMetrics
where
	(+) x y = 
		{numFiles = x.numFiles + y.numFiles
		,numLines = x.numLines + y.numLines
		,numTODO  = x.numTODO  + y.numTODO
		,numFIXME = x.numFIXME + y.numFIXME
		}

273 274 275 276 277 278 279 280 281 282 283 284 285
derive class iTask SourceTreeQualityMetrics 

analyzeITasksCodeBase :: Task SourceTreeQualityMetrics 
analyzeITasksCodeBase
	= 	rescanCodeBase [{name="iTasks",rootPath=LIBRARY_PATH,subPaths=[],readOnly=True,modules=[]}]
	@   listFilesInCodeBase
	>>- \files -> allTasks (map determineQualityMetrics files) @ aggregate
where
	aggregate ms = foldr (+) zero ms

determineQualityMetrics :: CleanFile -> Task SourceTreeQualityMetrics
determineQualityMetrics file = importTextFile (cleanFilePath file) @ analyze
where
286
	analyze text = {numFiles = 1, numLines = num OS_NEWLINE text, numTODO=num "TODO" text ,numFIXME=num "FIXME" text}
287 288
	num needle text = length (split needle text) - 1

289 290 291
viewQualityMetrics :: Task ()
viewQualityMetrics 
	= 	analyzeITasksCodeBase
292
	>>- \a -> (Title "Metrics") @>> viewInformation [ViewAs view] a @! ()
293
where
294 295 296 297 298 299
	view {numFiles,numLines,numTODO,numFIXME}
		= UlTag [] [LiTag [] [Text "Number of files: ",Text (toString numFiles)]
				   ,LiTag [] [Text "Number of lines: ",Text (toString numLines)]
				   ,LiTag [] [Text "Number of TODO's found: ",Text (toString numTODO)]
                   ,LiTag [] [Text "Number of FIXME's found: ",Text (toString numFIXME)]
                   ]
300

301
Start world = doTasks inspectCodeQuality world
302

303
//CREATE THIS WITH CPM LIBRARY
304
projectTemplate moduleName = join OS_NEWLINE
305 306 307
	["Version: 1.4"
	,"Global"
	,"\tProjectRoot: ."
308
	,"\tTarget: iTasks"
309
	,"\tExec: {Project}/" +++ addExtension moduleName "exe"
310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349
	,"\tCodeGen"
	,"\t\tCheckStacks: False"
	,"\t\tCheckIndexes: True"
	,"\tApplication"
    ,"\t\tHeapSize: 20971520"
    ,"\t\tStackSize: 512000"
    ,"\t\tExtraMemory: 8192"
	,"\t\tIntialHeapSize: 204800"
    ,"\t\tHeapSizeMultiplier: 4096"
    ,"\t\tShowExecutionTime: False"
    ,"\t\tShowGC: False"
    ,"\t\tShowStackSize: False"
    ,"\t\tMarkingCollector:	False"
    ,"\t\tDisableRTSFlags: False"
    ,"\t\tStandardRuntimeEnv: True"
    ,"\t\tProfile"
    ,"\t\t\tMemory: False"
    ,"\t\t\tMemoryMinimumHeapSize: 0"
	,"\t\t\tTime: False"
	,"\t\t\tStack: False"
 	,"\t\t\tDynamics:	True"
	,"\t\t\tDescExL: False"
	,"\t\tOutput"
	,"\t\t\tOutput: ShowConstructors"
	,"\t\t\tFont: Monaco"
	,"\t\t\tFontSize:	9"
	,"\t\t\tWriteStdErr: False"
	,"\tLink"
	,"\t\tLinkMethod: Static"
	,"\t\tGenerateRelocations: False"
	,"\t\tGenerateSymbolTable: False"
	,"\t\tGenerateLinkMap: False"
	,"\t\tLinkResources: False"
	,"\t\tResourceSource:"
	,"\t\tGenerateDLL: False"
	,"\t\tExportedNames:"
	,"\tPaths"
	,"\t\tPath: {Project}"
	,"\tPrecompile:"
	,"\tPostlink:"
350

351
	,"MainModule"
352
	,"\tName: " +++ moduleName
353 354 355 356 357 358 359 360 361 362 363 364 365
	,"\tDir: {Project}"
	,"\tCompiler"
	,"\t\tNeverMemoryProfile: False"
	,"\t\tNeverTimeProfile: False"
	,"\t\tStrictnessAnalysis: True"
	,"\t\tListTypes: StrictExportTypes"
	,"\t\tListAttributes: True"
	,"\t\tWarnings: True"
	,"\t\tVerbose: True"
	,"\t\tReadableABC: False"
	,"\t\tReuseUniqueNodes: True"
	,"\t\tFusion: False"
	]