{-# OPTIONS -Wall #-}

module Language.Haskell.HBB.ApplyTo (
    applyTo
    ) where

import System.Process
import System.IO
import Data.List (intercalate)

-- | This function applies a String to String function to a certain String
-- (everything in the context of the module "Prelude").
-- 
-- It is expensive as it calls 'ghc' to produce its results. It has been
-- created to formally provide the mode 'apply-to' but text editors should
-- instead use 'ghc' directly. The first argument control whether a warning
-- message describing this fact is contained in the result. If it is False then
-- the second tuple element of the result will contain an according warning
-- otherwise it Nothing.
--
-- The result is a tuple of which the first elements contains the
-- (stdout-)output of the call to the 'ghc' and the second element may contain
-- warning messages. If the first function argument is False then the second
-- tuple element will never be Nothing. Otherwise it may be Nothing or contain
-- a messages (for example when the executable GHC isn'f found).
applyTo :: Bool -> String -> String -> IO (String,Maybe String)
applyTo suppressGHCWarning stringToStringFun subject = do
    let exeName = "ghc"
        exeArgQ  =                                     "'(" ++ stringToStringFun ++ ") \"" ++ subject ++ "\"\'"
        exeArgQi = "'interact (\\stdin -> (unlines . map (" ++ stringToStringFun ++ ") . lines) stdin)'"

        spec = let base = proc exeName ("-e":["(" ++ stringToStringFun ++ ") " ++ '"':subject ++ "\""])
               in base { std_in  = Inherit
                       , std_out = CreatePipe
                       , std_err = UseHandle stderr }

        warnMsg = unlines ["> Note that 'apply-to' is a small wrapper around a call to 'ghc'."
                          ,"> "
                          ,"> The functionality provided here can also be reached by calling 'ghc' as follows:"
                          ,"> "
                          ,(intercalate " " (("> # " ++ exeName):"-e":exeArgQ:[]))
                          ,"> "
                          ,"> Moreover with GHC all request could be done in a simple session."
                          ,"> In this case the subject strings are written to stdin and the results"
                          ,"> are read from stdout (one per line):"
                          ,"> "
                          ,(intercalate " " (("> # " ++ exeName):"-e":exeArgQi:[]))]

    (_,Just childStdOut,_,_) <- createProcess spec
    res                      <- hGetContents childStdOut

    case (res,suppressGHCWarning) of ([],_    ) -> return ([],Just "Empty result (is the 'ghc' executable accessible?)")
                                     (xs,False) -> return (xs,Just warnMsg)
                                     (xs,True ) -> return (xs,Nothing     )