addfile ./Dep1.hs
hunk ./Dep1.hs 1
+module Dep1 where
+
+import Dep2
+
+f :: String -> String
+f = g . reverse
addfile ./Dep2.hs
hunk ./Dep2.hs 1
-
+module Dep2 where
+
+import Data.Char(toUpper)
+
+g = map toUpper
addfile ./Reload.hs
hunk ./Reload.hs 1
+{-# LANGUAGE RecursiveDo #-}
+module Main where
+
+import Control.Exception
+import Control.Monad
+import Data.IORef
+import Data.Maybe
+import qualified Data.Map as Map
+import System.INotify
+import System.Plugins
+import System.Plugins.Env
+import System.Directory
+import System.FilePath
+
+main :: IO ()
+main =
+    do inotify <- initINotify
+       return ()
+
+
+type Store a = IORef (Map.Map FilePath (FileInfo a))
+
+data FileInfo a
+    = FileInfo { compRes :: (Either Errors (Module, a))
+               , deps :: [(FilePath, WatchDescriptor)]
+               }
+
+newStore :: IO (Store s)
+newStore = newIORef Map.empty
+
+-- TODO: remove all watches as well
+destroyStore :: (Store s) -> IO ()
+destroyStore store
+    = do map' <- atomicModifyIORef store (\ref -> (Map.empty, ref))
+         mapM_ unloadAll [ m | Right (m,_) <- map compRes (Map.elems map') ]
+         -- mapM_ removeWatch (map watchDescriptor (Map.elems map'))
+
+withStore :: (Store s -> IO a) -> IO a
+withStore = bracket newStore destroyStore
+
+-- we want to trigger a rebuild when any of the files that the
+-- top-level file depends on directly or indirectly change
+-- this means:
+--
+--  1. we need an inotify event for the top-level file
+--  2. an inotify event for each dependency
+--  3. we need to add/remove inotify triggers anytime the dependency graph changes
+
+{-
+reloadNotification :: (FilePath -> IO (Either Errors (Module, a))) -> Store a -> INotify -> FilePath -> IO WatchDescriptor
+reloadNotification compile store inotify filepath = 
+    do wd <- addWatch inotify [Modify, Move, Delete] filepath $ \event ->
+             do putStrLn $ "Recompiling: " ++ filepath ++ " because of " ++ show event
+                doUnload <- atomicModifyIORef store
+                            $ \ref -> (Map.insert filepath (Left ["Compiling..."]) ref
+                                      , case Map.lookup topFile ref of
+                                          Just (Right _) -> True
+                                          _              -> False )
+                when doUnload $ unloadAll topMod
+                compResult <- compile topFile
+                atomicModifyIORef' (hspStore state) $ Map.insert topFile compResult
+       return wd
+-}
+
+addDep :: (FilePath -> IO (Either Errors (Module, a))) -> INotify -> Store a -> FilePath -> FilePath -> IO WatchDescriptor
+addDep compile' inotify storeRef topFile depFile =
+   mdo -- putStrLn $ "Adding watch: rebuild " ++ topFile ++ " when " ++ depFile ++ " changes."
+       wd <- addWatch inotify [Modify, Move, Delete] depFile $ \event ->
+             do putStrLn $ "Recompiling: " ++ topFile ++ " because " ++ depFile ++ " was " ++ show event
+                -- putStrLn $ "wd: " ++ show wd
+                mUnload <- atomicModifyIORef storeRef $
+                            \store -> ( Map.update (\fi -> Just $ fi { compRes = (Left ["Compiling..."]) }) topFile store
+                                      , case fmap compRes $ Map.lookup topFile store of
+                                          Just (Right (mod, _)) -> Just mod -- if topFile was already loaded, unload it
+                                          _ -> Nothing
+                                      )
+                putStrLn $ "Unload: " ++ show (fmap path mUnload)
+                store <- readIORef storeRef
+                -- print (Map.keys store)
+                maybe (return ()) unloadAll mUnload
+                compResult <- compile' topFile
+                atomicModifyIORef' storeRef $ Map.update (\fi -> Just $ fi { compRes = compResult }) topFile 
+                updateDeps inotify storeRef compResult
+       return wd
+
+updateDeps :: INotify -> Store s -> Either Errors (Module, a) -> IO ()
+updateDeps _ _ (Left err) =
+    putStrLn (unlines err)
+updateDeps inotify storeRef (Right (mod,_)) =
+    do store <- readIORef storeRef
+       -- remove old watches
+       case Map.lookup (path mod) store of
+         Nothing -> return ()
+         (Just fi) -> mapM_ (removeWatch inotify . snd) (deps fi)
+       depMods <- getModuleDeps mod
+       depFiles <- liftM catMaybes $ mapM (findFile knownExtensions . path ) (mod : depMods)
+       -- putStrLn $ "depFiles: " ++ show depFiles
+       topFile <- liftM fromJust $ findFile knownExtensions (path mod)
+       wd <- mapM (addDep compile inotify storeRef topFile) depFiles
+       atomicModifyIORef' storeRef $ \store ->
+           Map.update (\fi -> Just (fi { deps = zip depFiles wd })) topFile store
+
+
+findFile :: [String] -> FilePath -> IO (Maybe FilePath)
+findFile [] _  = return Nothing
+findFile (ext:exts) file
+    = do let l = replaceExtension file ext
+         b <- doesFileExist l
+         if b then return $ Just l
+              else findFile exts file
+
+knownExtensions = [".hs",".lhs",".hsp"]
+
+
+test = test' =<< initINotify
+
+test' :: INotify -> IO ()
+test' inotify =
+    withStore $ \storeRef ->
+        do let topFile =  "Template1.hs"
+           forever $ loop topFile storeRef
+    where
+      loop topFile storeRef =
+          do execTemplate inotify storeRef topFile
+             getLine
+
+execTemplate :: INotify -> Store (IO ()) -> FilePath -> IO  ()
+execTemplate inotify storeRef topFile =
+    do compResult <- loadTemplate inotify storeRef topFile
+       case compResult of
+         Left errs -> putStr (unlines errs)
+         Right (_,io) -> io
+
+loadTemplate :: INotify -> Store s -> FilePath -> IO  (Either Errors (Module, s))
+loadTemplate inotify storeRef topFile =
+    do store <- readIORef storeRef
+       case Map.lookup topFile store of
+         Just x -> return (compRes x)
+         Nothing -> loadTemplate' inotify storeRef topFile
+
+loadTemplate' :: INotify -> Store s -> FilePath -> IO (Either Errors (Module, s))
+loadTemplate' inotify storeRef topFile =
+    do compResult <- compile topFile
+       atomicModifyIORef' storeRef $ Map.insert topFile  (FileInfo { compRes = compResult, deps = [] })
+       updateDeps inotify storeRef compResult
+       return compResult
+
+atomicModifyIORef' ref fn = atomicModifyIORef ref (\val -> (fn val, ()))
+
+compile :: FilePath -> IO (Either Errors (Module, a))
+compile topFile =
+    do putStrLn $ "Compiling " ++ topFile
+       mkStatus <- makeAll topFile []
+       case mkStatus of
+         MakeFailure errs ->
+             do putStrLn ("compile error:\n" ++ (unlines errs))
+                return $ Left errs
+         MakeSuccess mkCode obj -> 
+             do putStrLn $ "Loading " ++ topFile
+                ldStatus <- load obj ["."] [] "template"
+                case ldStatus of
+                  LoadFailure errs ->
+                      do putStrLn ("load error:\n" ++ (unlines errs))
+                         return $ Left errs
+                  LoadSuccess mod template ->
+                      do putStrLn "done."
+                         return $ Right (mod, template)
+
+{-
+
+I have a map of:
+
+ Map FilePath WatchDescriptor
+
+I have a list of
+
+ [FilePath]
+
+I want to create an updated map where:
+
+
+ 1. (key,value) pairs from the old map are copied
+ 2. new keys get their values generated via an IO function
+ 3. keys not in the new map get their values cleaned up using an IO function
+
+-}
+
addfile ./Template1.hs
hunk ./Template1.hs 1
+module Template1 where
+
+import Dep1
+
+template = putStrLn (f "template 1" )