@@ -1,4 +1,4 @@
1−module Idris.Chaser(buildTree, getModuleFiles, ModuleTree(..)) where
1+module Idris.Chaser(buildTree, getImports, getModuleFiles, ModuleTree(..)) where
3import Idris.Parser
3import Idris.Parser
4import Idris.AbsSyntax
4import Idris.AbsSyntax
@@ -79,42 +79,74 @@ getIModTime (IBC i _) = getModificationTime i
79getIModTime (IDR i) = getModificationTime i
79getIModTime (IDR i) = getModificationTime i
80getIModTime (LIDR i) = getModificationTime i
80getIModTime (LIDR i) = getModificationTime i
82−buildTree :: [FilePath] -> -- already guaranteed built
83− FilePath -> Idris [ModuleTree]
82+getImports :: FilePath -> Idris (FilePath, [ImportInfo])
84−buildTree built fp = btree [] fp
83+getImports f = do
85−-- = idrisCatch (btree [] fp)
86−-- (\e -> do now <- runIO $ getCurrentTime
88−-- return [MTree (IDR fp) True now []])
91− do i <- getIState
84+ i <- getIState
92 let file = extractFileName f
85 let file = extractFileName f
93− logLvl 1 $ "CHASING " ++ show file
94 ibcsd <- valIBCSubDir i
86 ibcsd <- valIBCSubDir i
95 ids <- allImportDirs
87 ids <- allImportDirs
96 fp <- findImport ids ibcsd file
88 fp <- findImport ids ibcsd file
89+ let parsef = fname fp
90+ exist <- runIO $ doesFileExist parsef
92+ src_in <- runIO $ readSource parsef
93+ src <- if lit fp then tclift $ unlit parsef src_in else return src_in
94+ (_, _, modules, _) <- parseImports parsef src
96+ return (parsef, modules)
97+ else return (parsef, [])
103+ fname (LIDR fn) = fn
104+ fname (IBC _ src) = fname src
106+buildTree :: [FilePath] -> -- already guaranteed built
107+ [(FilePath, [ImportInfo])] -> -- import lists (don't reparse)
108+ FilePath -> Idris [ModuleTree]
109+buildTree built importlists fp = evalStateT (btree [] fp) []
111+ addFile :: FilePath -> [ModuleTree] ->
112+ StateT [(FilePath, [ModuleTree])] Idris [ModuleTree]
113+ addFile f m = do fs <- get
117+ btree :: [FilePath] -> FilePath ->
118+ StateT [(FilePath, [ModuleTree])] Idris [ModuleTree]
120+ do i <- lift getIState
121+ let file = extractFileName f
122+ lift $ logLvl 1 $ "CHASING " ++ show file ++ " (" ++ show fp ++ ")"
123+ ibcsd <- lift $ valIBCSubDir i
124+ ids <- lift $ allImportDirs
125+ fp <- lift $ findImport ids ibcsd file
97− logLvl 1 $ "Found " ++ show fp
126+ lift $ logLvl 1 $ "Found " ++ show fp
98− mt <- runIO $ getIModTime fp
127+ mt <- lift $ runIO $ getIModTime fp
99 if (file `elem` built)
128 if (file `elem` built)
100 then return [MTree fp False mt []]
129 then return [MTree fp False mt []]
101− else if file `elem` done
130+ else if file `elem` stk then return []
102− then return []
131+ else do donetree <- get
132+ case lookup file donetree of
103− else mkChildren fp
134+ _ -> do ms <- mkChildren file fp
105− where mkChildren (LIDR fn) = do ms <- children True fn (f:done)
137+ where mkChildren file (LIDR fn) = do ms <- children True fn (file : stk)
106− mt <- runIO $ getModificationTime fn
138+ mt <- lift $ runIO $ getModificationTime fn
107− return [MTree (LIDR fn) True mt ms]
139+ return [MTree (LIDR fn) True mt ms]
108− mkChildren (IDR fn) = do ms <- children False fn (f:done)
140+ mkChildren file (IDR fn) = do ms <- children False fn (file : stk)
109− mt <- runIO $ getModificationTime fn
141+ mt <- lift $ runIO $ getModificationTime fn
110− return [MTree (IDR fn) True mt ms]
142+ return [MTree (IDR fn) True mt ms]
111− mkChildren (IBC fn src)
143+ mkChildren file (IBC fn src)
112− = do srcexist <- runIO $ doesFileExist (getSrcFile src)
144+ = do srcexist <- lift $ runIO $ doesFileExist (getSrcFile src)
113 ms <- if srcexist then
145 ms <- if srcexist then
114− do [MTree _ _ _ ms'] <- mkChildren src
146+ do [MTree _ _ _ ms'] <- mkChildren file src
115 return ms'
147 return ms'
116 else return []
148 else return []
117− mt <- idrisCatch (runIO $ getModificationTime fn)
149+ mt <- lift $ idrisCatch (runIO $ getModificationTime fn)
118 (\c -> runIO $ getIModTime src)
150 (\c -> runIO $ getIModTime src)
119 -- FIXME: It's also not up to date if anything it imports has
151 -- FIXME: It's also not up to date if anything it imports has
120 -- been modified since its own ibc has.
152 -- been modified since its own ibc has.
@@ -122,7 +154,7 @@ buildTree built fp = btree [] fp
122 -- Issue #1592 on the issue tracker.
154 -- Issue #1592 on the issue tracker.
124 -- https://github.com/idris-lang/Idris-dev/issues/1592
156 -- https://github.com/idris-lang/Idris-dev/issues/1592
125− ibcOutdated <- fn `younger` (getSrcFile src)
157+ ibcOutdated <- lift $ fn `younger` (getSrcFile src)
126 -- FIXME (EB): The below 'hasValidIBCVersion' that's
158 -- FIXME (EB): The below 'hasValidIBCVersion' that's
127 -- commented out appears to be breaking reloading in vim
159 -- commented out appears to be breaking reloading in vim
128 -- mode. Until we know why, I've commented it out.
160 -- mode. Until we know why, I've commented it out.
@@ -140,16 +172,14 @@ buildTree built fp = btree [] fp
140 return (srct > ibct)
172 return (srct > ibct)
141 else return False
173 else return False
143− children :: Bool -> FilePath -> [FilePath] -> Idris [ModuleTree]
175+ children :: Bool -> FilePath -> [FilePath] ->
176+ StateT [(FilePath, [ModuleTree])] Idris [ModuleTree]
144− children lit f done = -- idrisCatch
177+ children lit f stk = -- idrisCatch
145− do exist <- runIO $ doesFileExist f
178+ do exist <- lift $ runIO $ doesFileExist f
146 if exist then do
179 if exist then do
147− file_in <- runIO $ readSource f
180+ lift $ logLvl 1 $ "Reading source " ++ show f
148− file <- if lit then tclift $ unlit f file_in else return file_in
181+ let modules = maybe [] id (lookup f importlists)
149− (_, _, modules, _) <- parseImports f file
150− -- The chaser should never report warnings from sub-modules
152− ms <- mapM (btree done . import_path) modules
182+ ms <- mapM (btree stk . import_path) modules
153 return (concat ms)
183 return (concat ms)
154 else return [] -- IBC with no source available
184 else return [] -- IBC with no source available
155-- (\c -> return []) -- error, can't chase modules here
185-- (\c -> return []) -- error, can't chase modules here