Commit a515d3ea authored by Bas Lijnse's avatar Bas Lijnse

Added basic code browsing and viewing to the quality monitor tool

parent 9db4e132
definition module iTasks.Extensions.Development.Codebase
import iTasks
import iTasks.UI.Editor.Builtin
import System.FilePath
:: CodeBase :== [SourceTree]
......@@ -12,6 +13,7 @@ import System.FilePath
, readOnly :: Bool
, modules :: [(ModuleName,ModuleType,FilePath)] //Modules found in the paths locations
}
:: SourceTreeSelection
= SelSourceTree SourceTreeName FilePath
| SelMainModule ModuleName FilePath
......@@ -21,12 +23,11 @@ import System.FilePath
:: FileName :== String // Name of file, with extension
:: ModuleName :== String // Name of module, without extension
:: ModuleType = MainModule | AuxModule // main module: (only icl) auxilary module (icl + dcl)
:: Extension = Icl | Dcl
:: Extension = Icl | Dcl
:: CleanFile :== (FilePath,ModuleName,Extension) // A reference to a clean file on disk (either an icl or dcl)
:: CleanModuleName :== (FilePath,ModuleName) // Clean Module Name
:: CleanModule :== (CleanModuleName,Extension) // Either a definition or implementation module
:: CleanPath :== FilePath // Directory where clean application / batchbuild is located
:: Identifier :== String // Clean identifier
......@@ -35,6 +36,17 @@ derive class iTask SourceTree, SourceTreeSelection, ModuleType, Extension
instance toString Extension
instance == Extension
//List all modules in a directory on disk
moduleList :: SDS FilePath [(ModuleName,ModuleType)] ()
//Access the code and documentation for a module on disk
moduleDefinition :: SDS (FilePath,ModuleName) [String] [String]
moduleImplementation :: SDS (FilePath,ModuleName) [String] [String]
moduleDocumentation :: SDS (FilePath,ModuleName) [String] [String]
//Convert a list of modules to a tree for choice tasks
toModuleSelectTree :: [(ModuleName,ModuleType)] -> [(ChoiceNode)]
// Scan filesystem to find all the modules on disk
rescanCodeBase :: CodeBase -> Task CodeBase
......
implementation module iTasks.Extensions.Development.Codebase
import iTasks
import System.FilePath, System.File, System.Directory, Text, StdFile, Data.List, Data.Tree, Data.Error
import iTasks.UI.Editor.Builtin
import StdArray, System.FilePath, System.File, System.Directory, Text, StdFile, Data.List, Data.Tree, Data.Error
derive class iTask SourceTree, SourceTreeSelection, ModuleType, Extension
instance == Extension where (==) x y = x === y
......@@ -10,6 +11,90 @@ where
toString Dcl = ".dcl"
toString Icl = ".icl"
moduleList :: SDS FilePath [(ModuleName,ModuleType)] ()
moduleList = worldShare read write
where
read path world = case scanPaths [path] world of
(Ok paths,world) = (Ok (determineModules path paths), world)
(Error e,world) = (Error (snd e), world)
write path () world = (Ok (),world)
scanPaths [] world = (Ok [],world)
scanPaths [p:ps] world = case getFileInfo p world of
(Error e,world) = (Error e,world)
(Ok info,world)
| not info.directory
= case scanPaths ps world of
(Error e,world) = (Error e,world)
(Ok filesps,world)
| include p = (Ok ([p:filesps]),world)
= (Ok filesps,world)
= case readDirectory p world of
(Error e,world) = (Error e,world)
(Ok files,world)
= case scanPaths [p </> name \\ name <- files | not (exclude name)] world of
(Error e,world) = (Error e,world)
(Ok filesp,world) = case scanPaths ps world of
(Error e,world) = (Error e,world)
(Ok filesps,world) = (Ok (filesp++filesps),world)
//Include
include p = let ext = takeExtension p in ext == "icl" || ext == "dcl"
//We can skip directories that we know don't contain Clean modules
exclude p = startsWith "." p || p == "Clean System Files" || p == "WebPublic"
determineModules root paths = mods (sort pathsWithoutRoot)
where
//The module name is determined only from the part of the path without the root directory
pathsWithoutRoot = [subString (textSize root + 1) (textSize s) s \\ s <- paths]
mods [] = []
mods [p1,p2:ps]
# p1name = dropExtension p1
# p2name = dropExtension p2
| p1name == p2name && takeExtension p1 == "dcl" && takeExtension p2 == "icl"
= [(moduleName p1name,AuxModule):mods ps]
| takeExtension p1 == "icl"
= [(moduleName p1name,MainModule):mods [p2:ps]]
= mods [p2:ps]
mods [p1:ps]
| takeExtension p1 == "icl"
= [(moduleName (dropExtension p1),MainModule):mods ps]
= mods ps
mods paths = [(p,MainModule) \\ p <- paths]
moduleName p = replaceSubString {pathSeparator} "." p
moduleDefinition :: SDS (FilePath,ModuleName) [String] [String]
moduleDefinition = mapReadWrite mapToLines (sdsTranslate "moduleDefinition" (\(p,m) -> modulePath p m "dcl") externalFile)
moduleImplementation :: SDS (FilePath,ModuleName) [String] [String]
moduleImplementation = mapReadWrite mapToLines (sdsTranslate "moduleImplementation" (\(p,m) -> modulePath p m "icl") externalFile)
moduleDocumentation :: SDS (FilePath,ModuleName) [String] [String]
moduleDocumentation = mapReadWrite mapToLines (sdsTranslate "moduleDocumentation" (\(p,m) -> modulePath p m "md") externalFile)
mapToLines = (split "\n",\w _ -> Just (join "\n" w))
modulePath path name ext = path </> addExtension (replaceSubString "." {pathSeparator} name) ext
toModuleSelectTree :: [(ModuleName,ModuleType)] -> [(ChoiceNode)]
toModuleSelectTree modules = foldl addModule [] [(i,name,type) \\(name,type) <- modules & i <- [0..]]
where
addModule tree (i,name,type) = insert i type (split "." name) tree
insert i type [s] [t:ts]
| s == t.ChoiceNode.label= [{ChoiceNode|t & id = i}:ts]
= [t:insert i type [s] ts]
insert i type [s:ss] [t:ts]
| s == t.ChoiceNode.label= [{ChoiceNode|t & children = insert i type ss t.ChoiceNode.children}:ts]
= [t:insert i type [s:ss] ts]
insert i type [s] [] = [{id=i,label=s,icon=Nothing,expanded=False,children=[]}]
insert i type [s:ss] [] = [{ChoiceNode|id= -1,label=s,icon=Nothing,expanded=False,children = insert i type ss []}]
rescanCodeBase :: CodeBase -> Task CodeBase
rescanCodeBase codebase
= allTasks [ accWorld (findModulesForTree tree)
......@@ -156,7 +241,7 @@ where
= [(m,type,p):addModule path modName isAux ms]
toModuleName fileName modBase =join "." (reverse [fileName:modBase])
toModuleName fileName modBase = join "." (reverse [fileName:modBase])
:: FileExtension :== String
......
......@@ -4,18 +4,22 @@ definition module iTasks.SDS.Sources.Core
*/
from iTasks.SDS.Definition import :: SDS
from System.FilePath import :: FilePath
from Data.Error import :: MaybeError, :: MaybeErrorString
// constant share from which you always read the same value
constShare :: !a -> SDS p a ()
constShare :: !a -> SDS p a ()
// null share to which you can write anything
nullShare :: SDS p () a
nullShare :: SDS p () a
// world share
worldShare :: (p *World -> *(MaybeErrorString r,*World)) (p w *World -> *(MaybeErrorString (),*World)) -> SDS p r w
// Random source
randomInt :: SDS () Int ()
randomInt :: SDS () Int ()
// External file
externalFile :: SDS FilePath String String
externalFile :: SDS FilePath String String
// External directory
externalDirectory :: SDS FilePath [FilePath] ()
externalDirectory :: SDS FilePath [FilePath] ()
......@@ -15,6 +15,17 @@ constShare v = createReadOnlySDS (\_ env -> (v, env))
nullShare :: SDS p () a
nullShare = createReadWriteSDS "_core_" "nullShare" (\_ env -> (Ok (), env)) (\_ _ env -> (Ok (const False), env))
worldShare :: (p *World -> *(MaybeErrorString r,*World)) (p w *World -> *(MaybeErrorString (),*World)) -> SDS p r w
worldShare read write = createReadWriteSDS "_core_" "worldShare" read` write`
where
read` p iworld=:{IWorld|world} = case read p world of
(Ok r,world) = (Ok r, {IWorld|iworld & world = world})
(Error e,world) = (Error (exception e), {IWorld|iworld & world = world})
write` p w iworld=:{IWorld|world} = case write p w world of
(Ok (),world) = (Ok (const False), {IWorld|iworld & world = world})
(Error e,world) = (Error (exception e), {IWorld|iworld & world = world})
// Random source
randomInt :: SDS () Int ()
randomInt = createReadOnlySDS randomInt
......
......@@ -31,7 +31,6 @@ import Tests.Common.MinimalTasks
derive class iTask ExitCode
//CPM_PATH :== "/Users/bas/Clean/bin/cpm"
TESTS_PATH :== "../Tests/TestPrograms"
LIBRARY_PATH :== "../Libraries"
EXAMPLE_MODULES :== ["../Examples/BasicApiExamples.icl"
......@@ -61,6 +60,7 @@ runTests suites = application {WebImage|src="/testbench.png",alt="iTasks Testben
,runUnitTests <<@ Title "Unit Tests"
,checkExampleApplications <<@ Title "Example applications"
,viewQualityMetrics <<@ Title "Metrics"
,exploreCode <<@ Title "Code"
] <<@ ArrangeWithTabs
) @! ()
where
......@@ -153,6 +153,27 @@ where
,LiTag [] [Text "Number of FIXME's found: ",Text (toString numFIXME)]
]
exploreCode :: Task ()
exploreCode
= (( editSelectionWithShared (Title "Modules") False (SelectInTree toModuleSelectTree selectByIndex) (sdsFocus LIBRARY_PATH moduleList) (const []) @? tvHd
>&> withSelection (viewInformation "Select a module" [] ())
viewModule
)
@! ()) <<@ ArrangeWithSideBar 0 LeftSide 250 True
selectByIndex nodes indices = [nodes !! i \\ i <- indices | i >= 0 && i < length nodes]
viewModule (name,MainModule)
= allTasks
[viewSharedInformation (Title "Implementation") [] (sdsFocus (LIBRARY_PATH,name) moduleImplementation)
] <<@ ArrangeWithTabs
viewModule (name,AuxModule)
= allTasks
[viewSharedInformation (Title "Definition") [] (sdsFocus (LIBRARY_PATH,name) moduleDefinition)
,viewSharedInformation (Title "Implementation") [] (sdsFocus (LIBRARY_PATH,name) moduleImplementation)
] <<@ ArrangeWithTabs
//Begin metrics
//The following section should probably be moved to a separate module
:: SourceTreeQualityMetrics =
......
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