implementation module iTasks.API.Extensions.Development.Codebase
import iTasks
import System.File, System.Directory, Text, StdFile, Data.List, Data.Tree
import iTasks.API.Extensions.CodeMirror

derive class iTask SourceTree, SourceTreeSelection, ModuleType, Extension
instance == Extension where (==) x y = x === y

instance toString Extension
where
	toString Dcl = ".dcl"
	toString Icl = ".icl"

rescanCodeBase :: CodeBase -> Task CodeBase
rescanCodeBase codebase
    =   allTasks [ accWorld (findModulesForTree tree)
                 @ (\modules -> {SourceTree|tree & modules=modules})
                 \\ tree <- codebase]

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

    sourceTreeRoots codebase
        = flatten (map roots codebase)
    where
        roots {SourceTree|name,rootPath,subPaths=[]}  = [(name,rootPath)]
        roots {SourceTree|name,rootPath,subPaths}     = [(name,rootPath </> sub) \\sub <- subPaths]

    moduleSelection modName MainModule modPath = SelMainModule modName modPath
    moduleSelection modName AuxModule modPath = SelAuxModule modName modPath

    groupModules roots options expanded = sortByLabel (foldl insert [] options)
    where
        //Add a new source tree
	    insert nodeList (i,m=:(SelSourceTree name rootNode))
            = 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

        moduleIcon (SelMainModule _ _) = "mainmodule"
        moduleIcon (SelAuxModule _ _) = "auxmodule"

        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

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)

listFilesInCodeBase :: CodeBase -> [CleanFile]
listFilesInCodeBase codeBase
    = flatten [	[(rootPath, modName, Icl) \\ (modName,_,_)         <- modules] ++
    			[(rootPath, modName, Dcl) \\ (modName,AuxModule,_) <- modules]
	    	  \\ {SourceTree|rootPath,modules} <- codeBase]

    //TODO Also add dcl files

cleanFilePath :: CleanFile -> FilePath
cleanFilePath (baseDir,modName,ext) = foldl (</>) baseDir (split "." modName) +++ toString ext

getModuleType :: ModuleName CodeBase -> Maybe ModuleType
getModuleType modName [] = Nothing
getModuleType modName [{SourceTree|modules}:ts] = maybe (getModuleType modName ts) Just (search modules)
where
    search [] = Nothing
    search [(m,t,p):ms]
        | modName == m  = Just t
                        = search ms

codeBaseToCleanModuleNames :: CodeBase -> [CleanModuleName]
codeBaseToCleanModuleNames codeBase
    = 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]

findModulesForTree :: !SourceTree !*World -> ([(ModuleName,ModuleType,FilePath)],*World)
findModulesForTree tree w
    # (files,w) = foldr addDir ([],w) (dirsOfTree tree)
    = find [] files w
where
    addDir dir (files,w)
        # (filesInDir,w) = getFilesInPath dir w
        = ([dir </> file \\ file <- filesInDir] ++ files,w)

    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"
            = (addModule (dropExtension f) (toModuleName fileName modBase) False fsModules, w)
        | ext == "dcl"
            = (addModule (dropExtension f) (toModuleName fileName modBase) True fsModules, w)
        = (fsModules,w)

    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]


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

:: FileExtension :== String

getFilesInDir :: [FilePath] [FileExtension] !Bool !*World -> ([(FilePath,RForest FilePath)],*World)
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)
            _  -> ([RNode fileName dirNodes:filesNodes],w)
    | isEmpty extensions || isMember (snd (splitExtension fileName)) extensions
        # (treeNodes,w)         = getTree absolutePath fileNames w
		# name 					= if showExtension fileName (dropExtension fileName)
        = ([RNode name []:treeNodes],w)
    = getTree absolutePath fileNames w

getFilesInPath :: !FilePath !*World -> ([FilePath],!*World)
getFilesInPath path w
# (mbFiles,w)        = readDirectory path w
| isError mbFiles    = ([],w)
= ([name \\ name <- fromOk mbFiles | name <> "." && name <> ".."],w)

readDir :: !FilePath !*World -> ([FilePath],!*World)
readDir path w
# (mbInfo,w)                 = getFileInfo path w
| isError mbInfo             = ([],w)
| (fromOk mbInfo).directory = getFilesInPath path w
= ([],w)

/*
editCleanModule :: Bool CleanModule -> Task CodeMirror
editCleanModule mode ((path,fileName),ext) = openEditor mode (path,fileName +++ toString ext)

openEditor True (path,fileName)
	=					importTextFile (path </> fileName)
	>>- \content ->		withShared (initCleanEditor False content)
						(\config -> updateSharedInformation fileName [UpdateWith
																		(\cm -> codeMirrorEditlet cm [])
																		(\_ (Editlet value _ _) -> value)
																	 ] config)
openEditor False (path,fileName)
	=					importTextFile (path </> fileName)
	>>- \content ->		withShared (initCleanEditor True content)
						(\config -> viewSharedInformation fileName [ViewWith
																		(\cm -> codeMirrorEditlet cm [])
																	 ] config)
*/
updateCleanEditor :: (Shared CodeMirror) -> Task CodeMirror
updateCleanEditor mirror
	= updateSharedInformation () [UpdateWith  (\cm -> codeMirrorEditlet cm [])
													  (\_ e -> e.Editlet.currVal)
										 ] mirror
    <<@ ForceLayout <<@ AfterLayout (tweakUI fill)

viewCleanEditor :: (Shared CodeMirror) -> Task CodeMirror
viewCleanEditor mirror
    = viewSharedInformation () [ViewWith (\cm -> codeMirrorEditlet cm [])] mirror

initCleanEditor :: Bool [String] -> CodeMirror
initCleanEditor mode content
	=   { configuration = [ CMLineNumbers True
						  , CMMode "haskell"
						  , CMDragDrop True
		 				  , CMReadOnly mode
		 				  , CMAutofocus True
						  ] 			// [CodeMirrorConfiguration]
		 , position		= (0,0)			// cursor position
		 , selection 	= Nothing		//!Maybe ((Int,Int),(Int,Int))
		 , highlighted	= []
		 , source		= content
		 }