CodeQualityMonitor.icl 13.9 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 11
import qualified Data.Map as DM

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

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

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

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

39 40
derive class iTask EndEventType

41 42 43 44
derive gEditor EndEvent, FailReason, FailedAssertion, CounterExample, Relation
derive gDefault EndEvent, FailReason, FailedAssertion, CounterExample, Relation
derive gEq EndEvent, FailReason, FailedAssertion, CounterExample, Relation
derive gText EndEvent, 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 58
	application header mainTask
		= (viewInformation () [] header ||- mainTask) <<@ ArrangeWithSideBar 0 TopSide 50 False <<@ ApplyLayout (setUIType UIContainer) @! ()
59

60 61
runInteractiveTests :: Task ()
runInteractiveTests
62
	= (     editSelectionWithShared (Title "Select test") False (SelectInTree fileCollectionToTree selectTest) tests (const []) @? tvHd
63 64
		>&> withSelection (viewInformation () [] "Select a test") testInteractive ) <<@ ArrangeWithSideBar 0 LeftSide 250 True @! ()
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 93 94 95 96 97 98 99 100 101 102 103 104 105
	 ((    ((editSelectionWithShared (Title "Tests") False
				(SelectInTree toModuleSelectTree selectByIndex)
				(sdsFocus UNIT_TESTS_PATH moduleList) (const []) @? tvHd)
			)
		   >&> withSelection (viewInformation "Select a test" [] ())
                             (viewTest results)
          )
		@! ()) <<@ ArrangeWithSideBar 0 LeftSide 250 True
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)
		-&&-
		  ((viewSharedInformation (Title "Results") [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 400 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 141 142
				-&&-
				viewSharedInformation (Title "Results") [] (mapRead ('DM'.get path) results) <<@ ArrangeHorizontal)
				>^* [OnAction (Action "Run") (always
						(		compileTestModule path <<@ InWindow
							>>- \res -> (upd ('DM'.put path res)) results
						)
					)]
			) @! ()) <<@ ArrangeWithSideBar 0 LeftSide 250 True
		)		
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 151 152 153 154 155
exploreCode :: Task ()
exploreCode 
	= ((    ((editSelectionWithShared (Title "Modules") False
				(SelectInTree toModuleSelectTree selectByIndex)
				(sdsFocus LIBRARY_PATH moduleList) (const []) @? tvHd)
			 	-|| viewQualityMetrics
			)
156 157 158 159
		   >&> withSelection (viewInformation "Select a module" [] ())
                             viewModule 
          )
		@! ()) <<@ ArrangeWithSideBar 0 LeftSide 250 True
160
where
161 162 163 164 165
	selectByIndex nodes indices = [nodes !! i \\ i <- indices | i >= 0 && i < length nodes]

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

	viewModule (name,AuxModule)
		= allTasks
170 171
			[viewSharedInformation (Title "Definition") [ViewAs toCodeTag] (sdsFocus (LIBRARY_PATH,name) moduleDefinition)
			,viewSharedInformation (Title "Implementation") [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 208 209 210 211 212 213

	editSourceCode :: (Shared InspectState) -> Task InspectState
	editSourceCode state
		= updateSharedInformation (Title "Edit code")
			[UpdateUsing (\{InspectState|lines} -> join OS_NEWLINE lines)
                         (\s c -> {InspectState|s & lines = split OS_NEWLINE c})
                         aceTextArea] state

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

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

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

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
		}

272 273 274 275 276 277 278 279 280 281 282 283 284
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
285
	analyze text = {numFiles = 1, numLines = num OS_NEWLINE text, numTODO=num "TODO" text ,numFIXME=num "FIXME" text}
286 287
	num needle text = length (split needle text) - 1

288 289 290 291
viewQualityMetrics :: Task ()
viewQualityMetrics 
	= 	analyzeITasksCodeBase
	>>- viewInformation (Title "Metrics") [ViewAs view]  @! ()
292
where
293 294 295 296 297 298
	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)]
                   ]
299

300
Start world = startEngine inspectCodeQuality world
301

302
//CREATE THIS WITH CPM LIBRARY
303
projectTemplate moduleName = join OS_NEWLINE
304 305 306
	["Version: 1.4"
	,"Global"
	,"\tProjectRoot: ."
307
	,"\tTarget: iTasks"
308
	,"\tExec: {Project}/" +++ addExtension moduleName "exe"
309 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
	,"\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:"
349

350
	,"MainModule"
351
	,"\tName: " +++ moduleName
352 353 354 355 356 357 358 359 360 361 362 363 364
	,"\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"
	]