
module IOInterpreter (interprete, typecheck, checkFile, checkDir) where


import Prelude hiding ( catch )
import Control.Monad
import Control.Monad.Error (throwError)
import Control.Monad.Catch (catch, throwM)
import Control.Exception hiding (catch)
import Debug.Trace
import System.FilePath
import System.Directory (doesFileExist, doesDirectoryExist)
import Data.List (inits, isPrefixOf)
import Language.Haskell.Interpreter

checkFile :: FilePath -> IO ()
checkFile p = do
    exists <- doesFileExist p
    when (not exists) (fail $ "File not found: " ++ p)
    return()

checkDir :: FilePath -> IO ()
checkDir p = do
    exists <- doesDirectoryExist p
    when (not exists) (fail $ "Directory not found: " ++ p)
    return()

typecheck :: FilePath -> IO ()
typecheck f = do 
    checkModule f
    (runInterpreter $ loadModules [f] ) >>= 
     either handleIErr (return . const ())
    
interprete :: FilePath -> String -> IO String
interprete m s = do 
    checkModule m
    (runInterpreter $ evalString m s) >>= either handleIErr return       


-- observe that Interpreter () is an alias for InterpreterT IO ()
evalString :: FilePath -> String -> Interpreter String
evalString m s = do
        lift $ checkModule m
        loadModules [m]
        setImportsQ [("Prelude", Nothing)
                    ,("Generics.Pointless.Combinators",Nothing)
                    ,("Generics.Pointless.Functors",Nothing)
                    ,("Generics.Pointless.RecursionPatterns", Nothing)
                    ]
        setTopLevelModules [takeBaseName m]
        (forceM $ eval s) `catch` handler

-- force evaluation to catch errors
forceM :: Monad m => m a -> m a
forceM a = a >>= (\x -> return $! x)

handler :: SomeException -> Interpreter String
handler (SomeException e) = throwM . GhcException . show $ e

handleIErr (UnknownError s) = fail . unlines $ ["UnknownError",s]  
handleIErr (WontCompile e)  = fail . unlines $ map errMsg e 
handleIErr (NotAllowed s)   = fail . unlines $ ["NotAllowed",s] 
handleIErr (GhcException s) = fail . unlines $ ["GhcException",s] 

-- fails if _XTemplateHaskell Options is set
checkModule :: FilePath -> IO ()
checkModule p = do
    f <- readFile p
    if (null . (filter (isPrefixOf "XTemplateHaskell")) . inits . head . lines $ f) 
      then return ()    
      else fail "TH not supported!"
     