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

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

-- the path of our GHC 6.6 installation
path :: FilePath
path = "c:\\ghc-6.6"

{-
  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 them until the user enters an empty string
-}
main :: IO ()
main = do
	-- start a new interactive session using the path specified above
	session <- GHC.newSession GHC.Interactive (Just path)
	
	-- initialize the default packages
	dflags1 <- GHC.getSessionDynFlags session
	(dflags2, packageIds) <- 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
				-- 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))
				-- 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
	-- simply use "let" to rebind "putStrLn" and "getLine"
	-- (obviously our prelude has only been imported with qualified names)
	mustWork "let putStrLn = MyPrelude.myPutStrLn"
	mustWork "let getLine  = MyPrelude.myGetLine"

	-- mustWork either runs the given statement successfully or triggers an error
	where mustWork stmt = do
		result <- GHC.runStmt session stmt
		if 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