import Data.List
 
import qualified Control.Monad as M
import qualified Language.Haskell.Interpreter as Itpr
import qualified System.Directory as Dir
import qualified FileSystem as FS
 
main :: IO ()
main = 
    do
        Dir.setCurrentDirectory "app"
        createSomeModule
        putStrLn "start runInterpreter"
        r <- Itpr.runInterpreter testHint
        putStrLn "finished runInterpreter"
        case r of
            Left err -> putStrLn $ errorString err
            Right () -> return ()
        deleteSomeModule
 
createSomeModule :: IO ()
createSomeModule =
    FS.processData
        (FS.DataReader FS.NoInp FS.hGetContents sSomeModuleContent)
        [
            FS.DataWriter (FS.FileOut "SomeModule.hs") FS.hPutStr
        ]
    where
        sSomeModuleContent :: String
        sSomeModuleContent = 
            "module SomeModule(g, h) where\n\
            \\n\
            \f = head\n\
            \\n\
            \g = f [f]\n\
            \\n\
            \h = f\n\
            \\n"
 
deleteSomeModule :: IO ()
deleteSomeModule = 
    FS.removeFileIfExists "SomeModule.hs"
 
errorString :: Itpr.InterpreterError -> String
errorString (Itpr.WontCompile es) = intercalate "\n" (header : map unbox es)
    where
        header = "ERROR: Won't compile:"
        unbox (Itpr.GhcError e) = e
errorString e = show e
 
say :: String -> Itpr.Interpreter ()
say = Itpr.liftIO . putStrLn
 
emptyLine :: Itpr.Interpreter ()
emptyLine = say ""
 
-- observe that Itpr.Interpreter () is an alias for InterpreterT IO ()
testHint :: Itpr.Interpreter ()
testHint =
    do
        say "Load SomeModule.hs"
        Itpr.loadModules ["SomeModule.hs"]
        emptyLine
        say "Put the Prelude, Data.Map and *SomeModule in scope"
        say "Data.Map is qualified as M!"
        Itpr.setTopLevelModules ["SomeModule"]
        Itpr.setImportsQ [("Prelude", Nothing), ("Data.Map", Just "M")]
        emptyLine
        say "Now we can query the type of an expression"
        let expr1 = "M.singleton (f, g, h, 42)"
        say $ "e.g. typeOf " ++ expr1
        say =<< Itpr.typeOf expr1
        emptyLine
        say $ "Observe that f, g and h are defined in SomeModule.hs, " ++
            "but f is not exported. Let's check it..."
        exports <- Itpr.getModuleExports "SomeModule"
        say $ show exports
        emptyLine
        say "We can also evaluate an expression; the result will be a string"
        let expr2 = "length $ concat [[f,g],[h]]"
        say $ "e.g. eval " ++ show expr2
        a <- Itpr.eval expr2
        say $ show a
        emptyLine
        say "Or we can interpret it as a proper, say, int value!"
        a_int <- Itpr.interpret expr2 (Itpr.as :: Int)
        say $ show a_int
        emptyLine
        say "This works for any monomorphic type, even for function types"
        let expr3 = "\\(Just x) -> succ x"
        say $ "e.g. we interpret " ++ expr3 ++
            " with type Maybe Int -> Int and apply it on Just 7"
        fun <- Itpr.interpret expr3 (Itpr.as :: Maybe Int -> Int)
        say $ show $ fun (Just 7)
        emptyLine
        say "And sometimes we can even use the type system to infer the expected type (eg Maybe Bool -> Bool)!"
        bool_val <- Itpr.interpret expr3 Itpr.infer `ap` return (Just False)
        say $ show $ not bool_val
        emptyLine
        say "Here we evaluate an expression of type string, that when evaluated (again) leads to a string"
        res <- 
            do
                s <- Itpr.interpret "head $ map show [\"Worked!\", \"Didn't work\"]" Itpr.infer
                Itpr.interpret s Itpr.infer
        say res
        emptyLine
        say "We can also execute statements in the IO monad and bind new names, e.g."
        let stmts = ["x <- return 42", "print x"]
        forM_ stmts $ \s -> do
            say $ "    " ++ s
            Itpr.runStmt s
        emptyLine