@@ -0,0 +1,132 @@
1+module Idris.Chaser(buildTree, getModuleFiles, ModuleTree(..)) where
2+
3+import Idris.Parser
4+import Idris.AbsSyntax
5+import Idris.Imports
6+import Idris.Unlit
7+import Idris.Error
8+import Idris.IBC
9+
10+import System.FilePath
11+import System.Directory
12+import Data.Time.Clock
13+import Control.Monad.Trans
14+import Control.Monad.State
15+import Data.List
16+
17+import Debug.Trace
18+
19+data ModuleTree = MTree { mod_path :: IFileType,
20+ mod_needsRecheck :: Bool,
21+ mod_time :: UTCTime,
22+ mod_deps :: [ModuleTree] }
23+ deriving Show
24+
25+latest :: UTCTime -> [ModuleTree] -> UTCTime
26+latest tm [] = tm
27+latest tm (m : ms) = latest (max tm (mod_time m)) (ms ++ mod_deps m)
28+
29+-- Given a module tree, return the list of files to be loaded. If any
30+-- module has a descendent which needs reloading, return its source, otherwise
31+-- return the IBC
32+
33+getModuleFiles :: [ModuleTree] -> [IFileType]
34+getModuleFiles ts = nub $ execState (modList ts) [] where
35+ modList :: [ModuleTree] -> State [IFileType] ()
36+ modList [] = return ()
37+ modList (m : ms) = do modTree [] m; modList ms
38+
39+ modTree path (MTree p rechk tm deps)
40+ = do let file = chkReload rechk p
41+ -- Needs rechecking if 'rechk' is true, or if any of the
42+ -- modification times in 'deps' are later than tm
43+ let depMod = latest tm deps
44+ let needsRechk = rechk || depMod > tm
45+
46+ st <- get
47+ if needsRechk then put $ nub (getSrc file : updateToSrc path st)
48+ else put $ nub (file : st)
49+-- when (not (ibc p) || rechk) $
50+ mapM_ (modTree (getSrc p : path)) deps
51+
52+ ibc (IBC _ _) = True
53+ ibc _ = False
54+
55+ chkReload False p = p
56+ chkReload True (IBC fn src) = chkReload True src
57+ chkReload True p = p
58+
59+ getSrc (IBC fn src) = getSrc src
60+ getSrc f = f
61+
62+ updateToSrc path [] = []
63+ updateToSrc path (x : xs) = if getSrc x `elem` path
64+ then getSrc x : updateToSrc path xs
65+ else x : updateToSrc path xs
66+
67+getIModTime (IBC i _) = getModificationTime i
68+getIModTime (IDR i) = getModificationTime i
69+getIModTime (LIDR i) = getModificationTime i
70+
71+buildTree :: [FilePath] -> -- already guaranteed built
72+ FilePath -> Idris [ModuleTree]
73+buildTree built fp = btree [] fp where
74+ btree done f =
75+ do i <- getIState
76+ let file = takeWhile (/= ' ') f
77+ iLOG $ "CHASING " ++ show file
78+ ibcsd <- valIBCSubDir i
79+ ids <- allImportDirs i
80+ fp <- liftIO $ findImport ids ibcsd file
81+ mt <- liftIO $ getIModTime fp
82+ if (file `elem` built)
83+ then return [MTree fp False mt []]
84+ else if file `elem` done
85+ then return []
86+ else mkChildren fp
87+
88+ where mkChildren (LIDR fn) = do ms <- children True fn (f:done)
89+ mt <- liftIO $ getModificationTime fn
90+ return [MTree (LIDR fn) True mt ms]
91+ mkChildren (IDR fn) = do ms <- children False fn (f:done)
92+ mt <- liftIO $ getModificationTime fn
93+ return [MTree (IDR fn) True mt ms]
94+ mkChildren (IBC fn src)
95+ = do srcexist <- liftIO $ doesFileExist (getSrcFile src)
96+ ms <- if srcexist then
97+ do [MTree _ _ _ ms'] <- mkChildren src
98+ return ms'
99+ else return []
100+ mt <- idrisCatch (liftIO $ getModificationTime fn)
101+ (\c -> liftIO $ getIModTime src)
102+ ok <- checkIBCUpToDate fn src
103+ return [MTree (IBC fn src) ok mt ms]
104+
105+ getSrcFile (IBC _ src) = getSrcFile src
106+ getSrcFile (LIDR src) = src
107+ getSrcFile (IDR src) = src
108+
109+ -- FIXME: It's also not up to date if anything it imports has
110+ -- been modified since its own ibc has.
111+
112+ checkIBCUpToDate fn (LIDR src) = older fn src
113+ checkIBCUpToDate fn (IDR src) = older fn src
114+
115+ older ibc src = do exist <- liftIO $ doesFileExist src
116+ if exist then do
117+ ibct <- liftIO $ getModificationTime ibc
118+ srct <- liftIO $ getModificationTime src
119+ return (srct > ibct)
120+ else return False
121+
122+ children :: Bool -> FilePath -> [FilePath] -> Idris [ModuleTree]
123+ children lit f done = idrisCatch
124+ (do exist <- liftIO $ doesFileExist f
125+ if exist then do
126+ file_in <- liftIO $ readFile f
127+ file <- if lit then tclift $ unlit f file_in else return file_in
128+ (_, modules, _, _) <- parseImports f file
129+ ms <- mapM (btree done) modules
130+ return (concat ms)
131+ else return []) -- IBC with no source available
132+ (\c -> return []) -- error, can't chase modules here