{-# 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

-}