module Language.Haskell.Preprocessor (
module Language.Haskell.Preprocessor.Ast,
module Language.Haskell.Preprocessor.Parser,
module Language.Haskell.Preprocessor.Printer,
module Language.Haskell.Preprocessor.SynSpec,
module Language.Haskell.Preprocessor.Util,
module Data.Monoid,
Loc.Locatable(..), Loc.cloneLoc, Loc.scrub,
Extension(..), base, transform,
hLoad, fileLoad, stdinLoad,
hDump, fileDump, stdoutDump, stringDump
) where
import IO
import System
import Data.Monoid (Monoid(..))
import qualified Control.Monad.Writer as W
import qualified Language.Haskell.Preprocessor.Loc as Loc
import qualified Language.Haskell.Preprocessor.Error as E
import Language.Haskell.Preprocessor.Ast
import Language.Haskell.Preprocessor.Parser
import Language.Haskell.Preprocessor.Printer
import Language.Haskell.Preprocessor.SynSpec
import Language.Haskell.Preprocessor.Util
data Extension = Extension {
keywords :: [[Keyword]],
transformer :: [Ast] -> [Ast],
synspec :: SynSpec,
usage :: Maybe (IO ()),
syntaxerror :: Maybe (E.Error -> IO ())
}
instance Monoid Extension where
mempty = Extension {
keywords = [],
transformer = id,
synspec = mempty,
usage = Nothing,
syntaxerror = Nothing
}
e1 `mappend` e2 = Extension {
keywords = keywords e1 ++ keywords e2,
transformer = transformer e1 . transformer e2,
synspec = synspec e1 `mappend` synspec e2,
usage = usage e1 <+ usage e2,
syntaxerror = syntaxerror e1 <+ syntaxerror e2
}
where Just a <+ _ = Just a
Nothing <+ b = b
base :: Extension
base = Extension {
keywords = [],
transformer = id,
synspec = defaultSpec,
usage = Just (do
prog <- getProgName
hPutStrLn stderr $
"Usage: "++prog++" [ INFILE | SOURCE INFILE OUTFILE ]"),
syntaxerror = Just (hPutStrLn stderr . show)
}
transform :: Extension -> [String] -> IO ()
transform extension files = do
easts <- case files of
[] -> stdinLoad spec
[file] -> fileLoad spec file file
[source, file, _]
-> fileLoad spec source file
_ -> do case usage extension of
Just m -> m
Nothing -> return ()
exitFailure
asts <- case easts of
Left e -> do case syntaxerror extension of
Just m -> m e
Nothing -> return ()
exitFailure
Right r -> return r
let result = transformer extension asts
case files of
[_, _, file] -> fileDump spec file result
_ -> stdoutDump spec result
where
spec = (synspec extension) {
blocks = keywords extension ++ blocks (synspec extension)
}
hLoad :: SynSpec -> String -> Handle -> IO (Either E.Error [Ast])
hLoad spec source handle = do
input <- hGetContents handle
return (parseBy spec source input)
fileLoad :: SynSpec -> String -> FilePath -> IO (Either E.Error [Ast])
fileLoad spec source filename = do
input <- readFile filename
return (parseBy spec source input)
stdinLoad :: SynSpec -> IO (Either E.Error [Ast])
stdinLoad spec = hLoad spec "-" stdin
hDump :: SynSpec -> Handle -> [Ast] -> IO ()
hDump _ = dump . hPutStr
stringDump :: SynSpec -> [Ast] -> String
stringDump _ = W.execWriter . dump W.tell
fileDump :: SynSpec -> String -> [Ast] -> IO ()
fileDump spec filename ast =
bracket (openFile filename WriteMode) hClose $ \handle ->
hDump spec handle ast
stdoutDump :: SynSpec -> [Ast] -> IO ()
stdoutDump _ = dump putStr