Hashell-0.15: Hashell/Eval.hs

{-
  Function to evaluate haskell and command <-> haskell expressions.
  Copyright (C) 2005, 2008 Luis Francisco Araujo
-}

module Eval (funcProcess, hEval)
    where

import Parse

import Control.Monad
import Data.Maybe (fromJust, isJust)
import System.Exit
import System.IO
import System.Process

import qualified GHC
-- import qualified Outputable
import qualified Packages
import qualified Module

import qualified Control.Exception as E

type Modules = [String]
type Expression = String
type Files = [String]
type Import = String


{- 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. -}
ghcPath :: FilePath
ghcPath = "/usr/lib/ghc-6.8.2"

-- Good enough
-- path :: [FilePath]
-- path = ["/home/gwern/bin/bin", "/usr/local/bin", "/usr/lib64/ccache/bin", "/usr/bin", "/bin", "/opt/bin", "/usr/x86_64-pc-linux-gnu/gcc-bin/4.2.2", "/usr/games", "/usr/games/bin", "/usr/sbin", "/sbin", "/usr/share/surfraw"]

eval :: String -> [Import] -> IO (Maybe String)
-- eval = undefined
eval src _ = do
        -- start a new interactive session using the path specified above
        session <- GHC.newSession $ Just ghcPath
        -- initialize the default packages
        dflags1 <- GHC.getSessionDynFlags session

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

        -- 2) load the standard prelude
        let modules = ["Prelude"]
        loadModules session modules
        result <- GHC.runStmt session src GHC.SingleStep
        case result of
                                        GHC.RunOk _    -> return $ Just "RunOK"
                                        _ -> return Nothing
--               where loadImports s as  = mapM_ (load s) as
--                     load sess i = do target <- GHC.guessTarget (i ++ ".hs") Nothing
--                                      GHC.addTarget sess target
--                                      GHC.load sess GHC.LoadAllTargets

-- Perhaps don't blindly load modules and claim they all succeeded...
loadModules :: GHC.Session -> [String] -> IO ()
loadModules session modul = do modules <- mapM (\m -> GHC.findModule session (GHC.mkModuleName m) Nothing) modul
                               GHC.setContext session [] modules

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

-- | Parse and evaluate a Haskell expression.
hEval :: Expression -> IO (Maybe String)
hEval expr = (getProcessTokens . getEvalOpt) expr >>= eMFEval

{-
   | Split and order the hashell expression into a haskell
   expression, a list of haskell modules and a list of files.
-}

-- | Split the hashell expression into Expression , Modules, Files.
getEvalOpt :: Expression -> (Expression, Modules, Files)
getEvalOpt (x:':':'(':xs) = let (ex, modules, files) = breakEvalOpt xs
                               in
                               (([x] ++ ex), modules, files)
getEvalOpt ('(':xs) = let (ex, modules, files) = breakEvalOpt xs
                         in
                         (ex, modules, files)
getEvalOpt xs = (xs, [], [])

breakEvalOpt :: String -> (Expression, Modules, Files)
breakEvalOpt xs = let (optexpr, ex) = (takeWhile (/= ')') xs, tail $ dropWhile (/= ')') xs)
                      (modules, files) = splitEvalOpt (break (== '|') optexpr)
                      in
                        (ex, modules, files)

splitEvalOpt :: (String, String) -> (Modules, Files)
splitEvalOpt ([], []) = ([], [])
splitEvalOpt (zs, []) = (splitInto ',' zs , [])
splitEvalOpt ([], ys) = ([], splitInto ',' $ tail ys)
splitEvalOpt (zs, ys) = (splitInto ',' zs, splitInto ',' $ tail ys)

-- | Interpret the command haskell expressions, and concatenate its
--   result with the rest of the haskell expression.
getProcessTokens :: (Expression, Modules, Files) ->
                    IO (Expression, Modules, Files)
getProcessTokens (a, b, xs)
    | findSubStr "(-" a && findSubStr "-)" a =
        do
        s <- iterProcess a
        return (s, b, xs)
    | otherwise = return (a, b, xs)

iterProcess :: String -> IO String
iterProcess [] = return []
iterProcess e
    | findSubStr "(-" e && findSubStr "-)" e
        = do
          let (b, p, a) = parseCH e
          processoutput <- funcProcess p
          iter <- iterProcess a
          return (b ++ (show processoutput) ++ iter)
    | otherwise = return e

-- | Run a commmand and get its output as a string.
-- This is the main function to bring command results into Hashell.
funcProcess :: String -> IO String
funcProcess fcmd = do
                   (_,out,_,ph) <- runInteractiveProcess (getCmd fcmd) (getArg fcmd)
                                        Nothing Nothing
                   output <- hGetContents out
                   E.evaluate (length output)
                   (waitForProcess ph) `E.catch` (\ _ -> return ExitSuccess)
                   return output

----------------------------------------------------------------------------------
{- | Evaluate Expression, Modules and Files.
Return a string containing the proper haskell evaluation,
or nothing in case of errors.

All the different kind of evalutions return a string. -}
eMFEval :: (Expression, Modules, Files) -> IO (Maybe String)
eMFEval (ex, modul, files) =
    do
    hSetBuffering stdout NoBuffering
    case (ex `esc` '%') of -- | Clean special percents | --
        ('s':e)
            -> (eval (e) modul) >>= writeStdout
        ('n':e)
            -> (eval ("show $ " ++ e) modul) >>= writeStdout
        ('p':e)
            -> (eval ("show $ " ++ e) modul) >>= writeStdoutLn
        ('u':e)
            -> (eval e modul) >>= writeStdoutLn
        e  -> (eval (e)  modul :: IO (Maybe String)) >>= returnExpr
    where
    writeStdout = wrtS putStr files []
    writeStdoutLn = wrtS putStrLn files "\n"
    returnExpr n
        | isJust n = if null files
                     then return n
                     else writeProcFile (fromJust n) files >> return n
        | otherwise = return Nothing

{-
   | Functions to determine how to write the eMFEval result
-}

-- | Combine different ways of representing the eMFEval result.
wrtS :: (String -> IO ())
     -> [String]
     -> String
     -> Maybe String
     -> IO (Maybe String)
wrtS func files delim evalexpr
    | isJust evalexpr = if null files
                        then func (fromJust evalexpr) >> return Nothing
                        else writeProcFile ((++ delim) $ fromJust evalexpr) files >> return Nothing
    | otherwise = hPutStrLn stderr "error : eval returned Nothing." >> return Nothing

-- | Write expression evaluation to a list of files.
writeProcFile :: String -> (Files -> IO ())
writeProcFile s = mapM_ (flip (writeFile) s . concat . hParse)