{- <http://haskell.org/haskellwiki/GHC/As_a_library>

  a very simple interactive Haskell expression evaluator
  successfully compiles with GHC 6.6 using "ghc --make -package ghc-6.6 Interactive.hs"

  This program shows some results of our experiments with using GHC as a library
  (see also http://www.haskell.org/haskellwiki/GHC/As_a_library).
  One of our goals was to figure out to what extent it is possible to replace
  some of the standard prelude functions with our own modified versions.
  This could be used, for example, in a GUI for GHCi (something like WinHugs)
  to redirect "putStrLn" output from a haskell program to the GUI window
  and to appropriately react on "getLine" prompts.
  We still have to find out how the user's response to such a prompt
  can be sent back to the underlying GHCi instance.

  Bastian Hackler and Matthias Stemmler
  University of Marburg, Germany

  version of 2006-12-03

  Albert Y. C. Lai (Treblacy on haskellwiki) adds a bit to disable
  *.hi and *.o production
  2007-01-07

  Gwern Branwen <gwern0@gmail.com>
  *Get working with 6.8
  Sat Dec  1 13:25:02 EST 2007
-}

module Main where

-- qualified imports so that we can see where the GHC api is used
import qualified GHC
import qualified Outputable
import qualified Packages
import qualified PackageConfig
import System.IO
import Control.Monad
import MyPrelude
import Data.Maybe

{- the path of our GHC 6.8 installation; this obviously needs to be edited to
   point to the right place  - the current value happens to be right for me, but
   for you it might be in /usr/lib/, ~/lib, ~/bin/lib... depending on where your
   GHC is installed. -}
path :: FilePath
path = "/usr/lib64/ghc-6.8.1.20071127/"

{- Our program does the following:
   * start an interactive GHC session
   * initialize the default packages
   * load some modified versions of "putStrLn" and "getLine" from MyPrelude.hs
   * load the standard prelude
   * replace "putStrLn" and "getLine" with our modified versions
   * repeatedly ask for Haskell expressions and evaluate until the user enters empty string. -}
main :: IO ()
main = do
        -- start a new interactive session using the path specified above
        session <- GHC.newSession $ Just path

        -- initialize the default packages
        dflags1 <- GHC.getSessionDynFlags session

        (dflags2, _) <- Packages.initPackages dflags1
        GHC.setSessionDynFlags session dflags2{GHC.hscTarget=GHC.HscInterpreted}

        -- now the order of the statements is important:
        -- 1) load our modified prelude functions
        target <- GHC.guessTarget "MyPrelude.hs" Nothing

        GHC.addTarget session target

        -- this would unload the standard prelude if it had already been loaded
        GHC.load session GHC.LoadAllTargets

        -- 2) load the standard prelude
        let preludeModule = GHC.mkModule (PackageConfig.stringToPackageId "base") (GHC.mkModuleName "Prelude")
        GHC.setContext session [] [preludeModule]

        -- 3) replace "putStrLn" and "getLine" with our modified versions
        replaceFunctions session

        -- enter a query-and-response loop
        nextStmt session

        where nextStmt session = do
                -- ask for a Haskell expression to evaluate
                -- print lines beginning with "***" so they can be distinguished from output coming from the GHC api
                putStr "* Enter statement: " >> hFlush stdout
                stmt <- getLine

                -- if the user entered an empty query ...
                if stmt == ""
                        -- ... then quit the program
                        then putStrLn "* Bye!"
                        else do
                                -- ... otherwise run the given statement
                                result <- GHC.runStmt session stmt GHC.SingleStep
                                -- display the result
                                case result of
                                        GHC.RunOk names    -> putStrLn $ "* Ok: " ++ showNames names -- see below
                                        GHC.RunFailed      -> putStrLn "* Failed"
                                        GHC.RunException e -> putStrLn $ "* Exception: " ++ show e
                                        GHC.RunBreak _ _ _ -> putStrLn "* Break."
                                -- and ask for an expression again
                                nextStmt session

-- If GHC.runStmt returns GHC.RunOk names then names is a list
-- of the names of all variables that were bound during evaluation.
-- This function somehow manages to pretty-print such a list.
showNames :: [GHC.Name] -> String
showNames = Outputable.showSDoc . Outputable.ppr

-- replaces "putStrLn" and "getLine" with our modified versions
replaceFunctions :: GHC.Session -> IO ()
replaceFunctions session = do
  mustWork "let putStrLn = MyPrelude.myPutStrLn" session GHC.SingleStep
  mustWork "let getLine  = MyPrelude.myGetLine" session GHC.SingleStep
  return ()
        -- simply use "let" to rebind "putStrLn" and "getLine"
        -- (obviously our prelude has only been imported with qualified names)
         where
           -- mustWork either runs the given statement successfully or triggers an error
           mustWork :: String -> GHC.Session -> GHC.SingleStep -> IO GHC.RunResult
           mustWork stmt sssn = GHC.runStmt sssn stmt
  --                if (liftM isOk) result then return () else error "replaceFunctions failed."

-- is the given result of type "RunOk"?
isOk :: GHC.RunResult -> Bool
isOk (GHC.RunOk _)     = True
isOk _                 = False