eddie-0.2: eddie.hs

{-# LANGUAGE DeriveDataTypeable #-}

-- import Data.ByteString.Lazy (readFile)
import Language.Haskell.Interpreter
  (setImportsQ, interpret, runInterpreter, as, MonadInterpreter)
import Data.IORef (newIORef, readIORef, writeIORef)
import System.Environment (getArgs, getProgName)
import System.IO (openFile, openBinaryFile, hClose, stdin, IOMode (ReadMode), 
                  hIsEOF, hGetChar, Handle, hSetBinaryMode, stdout)
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)
import Control.Monad     (when)

main = do
  myName <- getProgName
  opts <- cmdArgs (eddie &= program myName)
  case parseOpts opts of
    Left e -> putStrLn $ "usage: " ++ myName ++ " " ++ e
    Right o -> runIt myName o
      where runIt name opts = do
              fun <- runInterpreter $ makeFun opts
              let opener = if binary opts then openBinaryFile else openFile
              let outputFunction = if binary opts then putStr else putStrLn
              when (binary opts) $
                hSetBinaryMode stdout True
              case fun of
                Left e -> putStrLn $ name ++ ": Error: " ++ show e
                Right f -> withFiles (files opts) opener (outputFunction . 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
-- Further tweaked by mwm to allow caller to specify opening function.
withFile' :: Maybe FilePath -> (FilePath -> IOMode -> IO Handle) ->
             (String -> IO a) -> IO a
withFile' name opener f = do
    fin <- newIORef (return ())
    let
        close = readIORef fin >>= id
        open  = do
          h <- maybe (return stdin) (flip opener 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] -> (FilePath -> IOMode -> IO Handle) -> 
             (String -> IO a) -> IO a
withFiles []     o f = withFile' Nothing o f
withFiles [x]    o f = withFile' (Just x) o f
withFiles (x:xs) o f = withFile' (Just x) o $ \s ->
    let f' t = f (s ++ t) in withFiles xs o f'


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

parseOpts :: Eddie -> Either String Eddie
parseOpts opts = 
  let es = expr opts
      fs = files opts
      e:fs' = case (es, fs) of
        ([], []) -> [""]
        ([], _) -> fs
        (_, _) -> unlines es:fs
      mods = zip (modules opts) (repeat Nothing) ++ asModules opts
  in
   if e == "" then Left $ unlines ["[options] (-e expr | expr) [files ...]",
                                   "--help for options"]
   else Right $ opts {expr = [e], asModules = mods, files = fs' }

   
eddie = Eddie {line = False &= help "Process one line at a time",
               binary = False &= help "Process a binary file",
               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.2" &= details ["Haskell for shell scripts."]