eddie-0.1: eddie.hs

{-# LANGUAGE DeriveDataTypeable #-}

-- import Data.ByteString.Lazy (readFile)
import Language.Haskell.Interpreter
  (setImportsQ, interpret, runInterpreter, as, MonadInterpreter)
import Data.List (intercalate)
import Data.IORef (newIORef, readIORef, writeIORef)
import System.Environment (getArgs, getProgName)
import System.IO (openFile, hClose, stdin, IOMode (ReadMode), hIsEOF, hGetChar, withFile)
import System.IO.Unsafe (unsafeInterleaveIO)
import System.Console.CmdArgs.Implicit
  (cmdArgs, (&=), Data, Typeable, help, explicit, name, args, summary, program,
   details)
import Control.Exception (finally, evaluate)

main = do
  myname <- getProgName
  opts <- cmdArgs (eddie &= program myname)
  let opts' = parseOpts opts
  fun <- runInterpreter $ makeFun opts'
  case fun of
    Left e -> putStrLn $ myname ++ ": Error: " ++ show e
    Right f -> withFiles  (files opts') (putStrLn . f)

makeFun :: MonadInterpreter m => Eddie -> m (String->String)
makeFun opts = do
  setImportsQ (asModules opts)
  fun <- interpret (head (expr opts)) (as :: String -> String)
  return $ if line opts then unlines . map fun . lines else fun

-- an even lazier version of  withFile (courtesy of Heinrich Apfelmus)
-- Tweaked by mwm so withFiles uses stdin if [FilePath] is an empty list
withFile' :: Maybe FilePath -> (String -> IO a) -> IO a
withFile' name f = do
    fin <- newIORef (return ())
    let
        close = readIORef fin >>= id
        open  = do
          h <- maybe (return stdin) (flip openFile ReadMode) name
          writeIORef fin (hClose h)
          lazyRead h
    finally (unsafeInterleaveIO open >>= f >>= evaluate) close

    where
    lazyRead h = hIsEOF h >>= \b ->
        if b
            then do hClose h; return []
            else do
                c  <- hGetChar h
                cs <- unsafeInterleaveIO $ lazyRead h
                return (c:cs)


withFiles :: [FilePath] -> (String -> IO a) -> IO a
withFiles []     f = withFile' Nothing f
withFiles [x]    f = withFile' (Just x) f
withFiles (x:xs) f = withFile' (Just x) $ \s ->
    let f' t = f (s ++ t) in withFiles xs f'


-- argument processing
data Eddie = Eddie { line :: Bool,
                     expr :: [String],
                     files :: [String],
                     modules :: [String],
                     asModules :: [(String, Maybe String)]
                   } deriving (Show, Data, Typeable)

parseOpts :: Eddie -> Eddie
parseOpts opts = opts {expr = [e], asModules = mods, files = fs' }
  where es = expr opts
        fs = files opts
        e:fs' = if null es then fs else intercalate "\n" es:fs
        mods = zip (modules opts) (repeat Nothing) ++ asModules opts
   
eddie = Eddie {line = False &= help "Process line at a time.",
               expr = [] &= help "Line of expression to evaluate.",
               modules = ["Prelude", "Data.List", "Data.Char"]
                         &= help "Modules to import for expr.",
               asModules = [] &= help "Modules to import qualified." &= explicit
                           &= name "M" &= name "Modules",
               files = [] &= args} 
        &= summary "eddie 0.1" &= details ["Haskell for shell scripts."]