Codebase.icl 12.9 KB
Newer Older
1
implementation module iTasks.Extensions.Development.Codebase
2
import iTasks
3
import iTasks.UI.Editor.Controls
Steffen Michels's avatar
Steffen Michels committed
4
import StdArray, System.FilePath, System.File, System.Directory, Text, StdFile, Data.List, Data.Tree, Data.Error, Data.Maybe
5

6
derive class iTask SourceTree, SourceTreeSelection, ModuleType, Extension
Bas Lijnse's avatar
Bas Lijnse committed
7
instance == Extension where (==) x y = x === y
8

9 10 11 12 13
instance toString Extension
where
	toString Dcl = ".dcl"
	toString Icl = ".icl"

Haye Böhm's avatar
Fix CI  
Haye Böhm committed
14
moduleList :: SDSSource FilePath [(ModuleName,ModuleType)] ()
15
moduleList = worldShare read write notify
16 17 18 19 20 21
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)
22
	notify p1 _ p2 = p1 == p2
23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71

	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
	

Haye Böhm's avatar
Fix CI  
Haye Böhm committed
72 73
moduleDefinition :: SDSLens (FilePath,ModuleName) [String] [String]
moduleDefinition = mapReadWrite mapToLines Nothing (sdsTranslate "moduleDefinition" (\(p,m) -> modulePath p m "dcl") (removeMaybe (Just "") fileShare))
74

Haye Böhm's avatar
Fix CI  
Haye Böhm committed
75 76
moduleImplementation :: SDSLens (FilePath,ModuleName) [String] [String]
moduleImplementation = mapReadWrite mapToLines Nothing (sdsTranslate "moduleImplementation" (\(p,m) -> modulePath p m "icl") (removeMaybe (Just "") fileShare))
77

Haye Böhm's avatar
Fix CI  
Haye Böhm committed
78 79
moduleDocumentation :: SDSLens (FilePath,ModuleName) [String] [String]
moduleDocumentation = mapReadWrite mapToLines Nothing (sdsTranslate "moduleDocumentation" (\(p,m) -> modulePath p m "md") (removeMaybe (Just "") fileShare))
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98

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 []}]
	
Bas Lijnse's avatar
Bas Lijnse committed
99 100 101 102 103
rescanCodeBase :: CodeBase -> Task CodeBase
rescanCodeBase codebase
    =   allTasks [ accWorld (findModulesForTree tree)
                 @ (\modules -> {SourceTree|tree & modules=modules})
                 \\ tree <- codebase]
104

105
navigateCodebase :: CodeBase -> Task SourceTreeSelection
106
navigateCodebase codebase
107
    = enterChoice () [/* ChooseWith (ChooseFromTree (groupModules (sourceTreeRoots codebase)))*/] (modulesOf codebase)
108
where
109
    modulesOf codebase
110
        = flatten [[SelSourceTree name rootPath:[moduleSelection modName modType modPath \\ (modName,modType,modPath) <- modules]] \\ {SourceTree|name,rootPath,modules} <- codebase]
111

112 113 114
    moduleSelection modName MainModule modPath = SelMainModule modName modPath
    moduleSelection modName AuxModule modPath = SelAuxModule modName modPath
/*
Bas Lijnse's avatar
Bas Lijnse committed
115 116
    sourceTreeRoots codebase
        = flatten (map roots codebase)
117
    where
Bas Lijnse's avatar
Bas Lijnse committed
118 119
        roots {SourceTree|name,rootPath,subPaths=[]}  = [(name,rootPath)]
        roots {SourceTree|name,rootPath,subPaths}     = [(name,rootPath </> sub) \\sub <- subPaths]
120

121

Bas Lijnse's avatar
Bas Lijnse committed
122 123 124
    groupModules roots options expanded = sortByLabel (foldl insert [] options)
    where
        //Add a new source tree
125
	    insert nodeList (i,m=:(SelSourceTree name rootNode))
Bas Lijnse's avatar
Bas Lijnse committed
126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157
            = nodeList ++ [{ChoiceTree|label=name,icon=Just "sourcetree",value=ChoiceNode i, type = ifExpandedChoice i expanded []}]
        //Find the node that holds the tree to which this module belongs, and add it there
        insert nodeList (i,m) = insert` (sourceTreeOf m roots) (split "." (moduleName m)) (i,m) nodeList

        insert` Nothing _ _ nodeList = nodeList
        insert` _ _ _ [] = []
	    insert` (Just treeName) moduleSplit (i,m) [n=:{ChoiceTree|label}:ns]
            | label == treeName = [{ChoiceTree|n & type = case n.ChoiceTree.type of
                                        ExpandedNode nodes = ExpandedNode (insert`` moduleSplit (i,m) nodes)
                                        CollapsedNode nodes = CollapsedNode (insert`` moduleSplit (i,m) nodes)
                                   }:ns]
            | otherwise         = [n:insert` (Just treeName) moduleSplit (i,m) ns]
        where
            insert`` [] (i,m) nodeList = nodeList
            //Search
            insert`` path=:[nodeP:pathR] (i,m) [node=:{ChoiceTree|label=nodeL,value}:nodesR]
                | nodeP == nodeL
                    # type = ifExpandedChoice i expanded (insert`` pathR (i,m) (choiceTreeChildren node))
                    | pathR =:[]
                        = [{ChoiceTree|node & value = ChoiceNode i, icon = Just (moduleIcon m), type = type}:nodesR]
                    = [{ChoiceTree|node & type = type}:nodesR]
                | otherwise         = [node:insert`` path (i,m) nodesR]
		    insert`` path=:[nodeP:pathR] (i,m) []
                | pathR =:[]
                    = [{ChoiceTree|label=nodeP,icon=Just (moduleIcon m),value=ChoiceNode i, type= LeafNode}]
                | otherwise
                    = [{ChoiceTree|label=nodeP,icon=Nothing,value=GroupNode (moduleName m), type= ifExpandedGroup (moduleName m) expanded (insert`` pathR (i,m) [])}] 
        moduleName (SelMainModule name _) = name
        moduleName (SelAuxModule name _) = name

        modulePath (SelMainModule _ path) = path
        modulePath (SelAuxModule _ path) = path
158 159 160

        moduleIcon (SelMainModule _ _) = "mainmodule"
        moduleIcon (SelAuxModule _ _) = "auxmodule"
Bas Lijnse's avatar
Bas Lijnse committed
161

Bas Lijnse's avatar
Bas Lijnse committed
162 163 164 165 166 167 168 169 170 171 172 173
        sourceTreeOf m roots
            = case [name \\ (name,path) <- roots | startsWith path (modulePath m)] of
                [x:_] = Just x
                _     = Nothing

    sortByLabel nodes = map sortChildren (sortBy ordering nodes)
    where
        ordering a b = a.ChoiceTree.label < b.ChoiceTree.label

        sortChildren node=:{ChoiceTree|type=ExpandedNode children} = {node & type = ExpandedNode (sortByLabel children)}
        sortChildren node=:{ChoiceTree|type=CollapsedNode children} = {node & type = CollapsedNode (sortByLabel children)}
        sortChildren node = node
174
*/
Bas Lijnse's avatar
Bas Lijnse committed
175 176 177 178 179 180

lookupModule :: ModuleName CodeBase -> Maybe (ModuleName,ModuleType,FilePath)
lookupModule module [] = Nothing
lookupModule module [t=:{SourceTree|modules}:ts]
    = maybe (lookupModule module ts) Just (find ((==) module o fst3) modules)

181 182
listFilesInCodeBase :: CodeBase -> [CleanFile]
listFilesInCodeBase codeBase
Bas Lijnse's avatar
Bas Lijnse committed
183 184 185
    = flatten [	[(rootPath, modName, Icl) \\ (modName,_,_)         <- modules] ++
    			[(rootPath, modName, Dcl) \\ (modName,AuxModule,_) <- modules]
	    	  \\ {SourceTree|rootPath,modules} <- codeBase]
186

187 188 189 190
    //TODO Also add dcl files

cleanFilePath :: CleanFile -> FilePath
cleanFilePath (baseDir,modName,ext) = foldl (</>) baseDir (split "." modName) +++ toString ext
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
191

Bas Lijnse's avatar
Bas Lijnse committed
192 193 194 195 196
getModuleType :: ModuleName CodeBase -> Maybe ModuleType
getModuleType modName [] = Nothing
getModuleType modName [{SourceTree|modules}:ts] = maybe (getModuleType modName ts) Just (search modules)
where
    search [] = Nothing
Bas Lijnse's avatar
Bas Lijnse committed
197
    search [(m,t,p):ms]
Bas Lijnse's avatar
Bas Lijnse committed
198 199 200
        | modName == m  = Just t
                        = search ms

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
201
codeBaseToCleanModuleNames :: CodeBase -> [CleanModuleName]
202
codeBaseToCleanModuleNames codeBase
Bas Lijnse's avatar
Bas Lijnse committed
203 204 205 206 207
    = flatten [[(foldl (</>) rootPath (split "." modName), modName) \\ (modName,modType,modPath) <- modules] \\ {SourceTree|rootPath,modules} <- codeBase]

dirsOfTree :: !SourceTree -> [FilePath]
dirsOfTree {SourceTree|rootPath,subPaths=[]} = [rootPath]
dirsOfTree {SourceTree|rootPath,subPaths}    = [rootPath </> subPath \\ subPath <- subPaths]
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
208

Bas Lijnse's avatar
Bas Lijnse committed
209 210 211 212
findModulesForTree :: !SourceTree !*World -> ([(ModuleName,ModuleType,FilePath)],*World)
findModulesForTree tree w
    # (files,w) = foldr addDir ([],w) (dirsOfTree tree)
    = find [] files w
213
where
Bas Lijnse's avatar
Bas Lijnse committed
214 215 216 217
    addDir dir (files,w)
        # (filesInDir,w) = getFilesInPath dir w
        = ([dir </> file \\ file <- filesInDir] ++ files,w)

218 219 220 221 222 223 224 225 226 227 228 229
    find modBase [] w = ([],w)
    find modBase [f:fs] w
        # (mbInfo,w)                = getFileInfo f w
        | isError mbInfo            = find modBase fs w
        | (fromOk mbInfo).directory
            # (filesInDir,w)        = getFilesInPath f w
            # (subModules,w)        = find [dropExtension (dropDirectory f):modBase] [f </> file \\ file <- filesInDir] w
            # (fsModules,w)         = find modBase fs w
            = (subModules ++ fsModules,w)
        # (fileName,ext)            = splitExtension (dropDirectory f)
        # (fsModules,w)             = find modBase fs w
        | ext == "icl"
Bas Lijnse's avatar
Bas Lijnse committed
230
            = (addModule (dropExtension f) (toModuleName fileName modBase) False fsModules, w)
231
        | ext == "dcl"
Bas Lijnse's avatar
Bas Lijnse committed
232
            = (addModule (dropExtension f) (toModuleName fileName modBase) True fsModules, w)
233 234
        = (fsModules,w)

Bas Lijnse's avatar
Bas Lijnse committed
235 236 237 238 239 240 241 242 243
    addModule path modName isAux []
        = [(modName,if isAux AuxModule MainModule,path)]
    addModule path modName isAux [(m,MainModule,p):ms]
        | modName == m && isAux = [(m,AuxModule,p):ms]
                                = [(m,MainModule,p):addModule path modName isAux ms]
    addModule path modName isAux [(m,type,p):ms]
        | modName == m          = [(m,type,p):ms]
                                = [(m,type,p):addModule path modName isAux ms]

244

245
    toModuleName fileName modBase = join "." (reverse [fileName:modBase])
246

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
247 248
:: FileExtension :== String

249
getFilesInDir :: [FilePath] [FileExtension] !Bool !*World -> ([(FilePath,RForest FilePath)],*World)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266
getFilesInDir [] extensions showExtension w = ([],w)
getFilesInDir [path:paths] extensions showExtension w
# (treeFiles,w)	= getTree (takeDirectory path) [dropDirectory path] w
# (ntrees,w)	= getFilesInDir paths extensions showExtension w
= ([(takeDirectory path,treeFiles):ntrees],w)
where
    getTree absolutePath [] w   = ([],w)
    getTree absolutePath [fileName:fileNames] w
    # absoluteFileName          = absolutePath </> fileName
    # (mbInfo,w)                = getFileInfo absoluteFileName w
    | isError mbInfo            = getTree absolutePath fileNames w
    | (fromOk mbInfo).directory // file is directory name
        # (filesInDir,w)        = getFilesInPath absoluteFileName w
        # (dirNodes,w)          = getTree absoluteFileName filesInDir w
        # (filesNodes,w)		= getTree absolutePath fileNames w
        = case dirNodes of
            [] -> (filesNodes,w)
267
            _  -> ([RNode fileName dirNodes:filesNodes],w)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
268 269 270
    | isEmpty extensions || isMember (snd (splitExtension fileName)) extensions
        # (treeNodes,w)         = getTree absolutePath fileNames w
		# name 					= if showExtension fileName (dropExtension fileName)
271
        = ([RNode name []:treeNodes],w)
272 273
    = getTree absolutePath fileNames w

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
274 275 276 277 278
getFilesInPath :: !FilePath !*World -> ([FilePath],!*World)
getFilesInPath path w
# (mbFiles,w)        = readDirectory path w
| isError mbFiles    = ([],w)
= ([name \\ name <- fromOk mbFiles | name <> "." && name <> ".."],w)
279

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
280 281 282 283 284
readDir :: !FilePath !*World -> ([FilePath],!*World)
readDir path w
# (mbInfo,w)                 = getFileInfo path w
| isError mbInfo             = ([],w)
| (fromOk mbInfo).directory = getFilesInPath path w
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
285
= ([],w)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
286