module Main where
import Data.List
import Prelude hiding (catch)
import Control.Concurrent
import System.Directory
import System.Process
import System.Environment
import System.IO
import System.Exit
import System.FilePath
import Control.Exception
import qualified Data.ByteString.Char8 as S

--------------------------------------------------

main = do
  args <- getArgs
  cwd <- getCurrentDirectory
  let wdir = if null args then cwd else head args
  createDirectoryIfMissing False $ hswdir wdir
  dde <- doesDirectoryExist (hswdir wdir)
  if dde
    then do
      hsFiles <- findHaskellFiles wdir
      hasktags . concat . intersperse " " $ hsFiles
      forkIO_ $ mapM_ (typalyze wdir) hsFiles
      m_inotifywait <- getINotifyWait
      case m_inotifywait of
        Nothing              -> abort "Requires 'inotifywait' of 'inotify-tools'."
        Just inotifywaitPath -> inotifywaitLoop inotifywaitPath wdir
    else abort $ "Unable to create " ++ hswdir wdir

abort msg = hPutStrLn stderr msg >> exitFailure
hswdir wdir = wdir </> ".hswatch"
forkIO_ x = forkIO x >> return ()

--------------------------------------------------

getRunCommandOutputLine cmd = do
  (hIn, hOut, hErr, proc) <- runInteractiveCommand cmd
  code <- waitForProcess proc
  case code of
    ExitFailure _ -> return Nothing
    ExitSuccess   -> Just `fmap` hGetLine hOut 
      `finally` (hClose hIn >> hClose hOut >> hClose hErr)

--------------------------------------------------

which name = getRunCommandOutputLine $ "which " ++ name

getINotifyWait = which "inotifywait"

inotifywait path wdir = 
  getRunCommandOutputLine $ 
    path ++ " --format \"%w%f\" -e MODIFY -r \"" ++ wdir ++ "\""

hasktags file = do
  if takeExtension file `elem` haskellExts
    then do
      p <- runCommand $ "hasktags -ab " ++ file
      waitForProcess p
      return ()
    else return ()
  
typalyze wdir file = do
  truename <- canonicalizePath file
  (hIn, hOut, hErr, proc) <- runInteractiveCommand $ "typalyze " ++ file
  code <- waitForProcess proc
  case code of
    ExitFailure _ -> return ()
    ExitSuccess   -> do
      let dumpFile = hswdir wdir </> "typedb" </> ('.':'/':truename) <.> "dump"
      createDirectoryIfMissing True (takeDirectory dumpFile)
      S.hGetContents hOut >>=
        (S.writeFile dumpFile)
      return ()
    `finally` (hClose hIn >> hClose hOut >> hClose hErr)

--------------------------------------------------
  
inotifywaitLoop inotifywaitPath wdir = do
  modFile <- inotifywait inotifywaitPath wdir
  case modFile of
    Nothing -> return ()
    Just file -> do
      if all fileFilter (splitPath file)
        then do
          hasktags file
          forkIO_ $ typalyze wdir file
        else return ()
  inotifywaitLoop inotifywaitPath wdir

--------------------------------------------------

haskellExts = [".hs", ".lhs"]

fileFilter ('.':_) = False
fileFilter ('_':_) = False
fileFilter _       = True

findHaskellFiles wdir = search wdir
  where 
    search dir = do
      files <- getDirectoryContents dir
      concat `fmap` flip mapM (filter fileFilter files)
        (\ file -> do
          isFile <- doesFileExist $ dir </> file
          isDir  <- doesDirectoryExist $ dir </> file
          case () of
           _ | isFile && 
               takeExtension file 
                 `elem` haskellExts -> return [dir </> file]
             | isDir                -> search $ dir </> file
             | otherwise            -> return [])