diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,6 @@ +# 0.5.1 +Added the `expand` API for pure macro processing (i.e. `#include`s are ignored). + # 0.5.0 - Redesigned library API The `Hpp` module exports the main pieces. `Hpp.Env`, `Hpp.Types`, and `Hpp.Config` may be used for configuring the preprocessor. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -34,10 +34,10 @@ # The `hpp` Library -The `hpp` executable is a command-line interface to the `hpp` library. While the `hpp` package has been designed to have minimal dependencies beyond what the `GHC` compiler itself uses, it does include a few small, framework-free unit tests that demonstrate basic usage as a library. In the `testIf` example, we preprocess the `sourceIfdef` input with a starting definition equivalent to `#define FOO 1`. In `testArith1`, we exercise basic integer arithmetic and comparison. The `hppHelper` function shows how to run your source input through the preprocessor: `runHpp initialState (preproces mySource)`. +The `hpp` executable is a command-line interface to the `hpp` library. While the `hpp` package has been designed to have minimal dependencies beyond what the `GHC` compiler itself uses, it does include a few small, framework-free unit tests that demonstrate basic usage as a library. In the `testIf` example, we preprocess the `sourceIfdef` input with a starting definition equivalent to `#define FOO 1`. In `testArith1`, we exercise basic integer arithmetic and comparison. The `hppHelper` function shows how to run your source input through the preprocessor: `expand initialState (preproces mySource)`. If you want to support `#include`ing other files, you will use `runHpp` or `streamHpp` that operate in `IO` and support searching among a list of include paths. ```haskell -{-# LANGUAGE LambdaCase, OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} import Control.Monad.Trans.Except import Data.ByteString.Char8 (ByteString) import Data.Maybe (fromMaybe) @@ -61,13 +61,14 @@ , "#endif" ] hppHelper :: HppState -> [ByteString] -> [ByteString] -> IO Bool -hppHelper st src expected = runExceptT (runHpp st (preprocess src)) >>= \case - Left e -> putStrLn ("Error running hpp: " ++ show e) >> return False - Right (res, _) -> if hppOutput res == expected - then return True - else do putStr ("Expected "++show expected++", got") - print (hppOutput res) - return False +hppHelper st src expected = + case runExcept (expand st (preprocess src)) of + Left e -> putStrLn ("Error running hpp: " ++ show e) >> return False + Right (res, _) -> if hppOutput res == expected + then return True + else do putStr ("Expected "++show expected++", got") + print (hppOutput res) + return False testElse :: IO Bool testElse = hppHelper emptyHppState sourceIfdef ["x = 99\n","\n"] diff --git a/hpp.cabal b/hpp.cabal --- a/hpp.cabal +++ b/hpp.cabal @@ -1,5 +1,5 @@ name: hpp -version: 0.5.0.1 +version: 0.5.1 synopsis: A Haskell pre-processor description: See the README for usage examples license: BSD3 diff --git a/src/Hpp.hs b/src/Hpp.hs --- a/src/Hpp.hs +++ b/src/Hpp.hs @@ -1,7 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, TupleSections #-} -- | Front-end interface to the pre-processor. module Hpp ( -- * Running the Preprocessor - preprocess, runHpp, streamHpp, + preprocess, runHpp, streamHpp, expand, -- * Preprocessor State T.HppState, emptyHppState, initHppState, -- * Adding Definitions @@ -11,8 +11,8 @@ ) where import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Class (lift, MonadTrans) -import Control.Monad.Trans.Except (ExceptT, throwE) -import Control.Monad.Trans.State.Strict (StateT, runStateT) +import Control.Monad.Trans.Except (ExceptT, Except, throwE, runExceptT) +import qualified Control.Monad.Trans.State.Strict as S import Data.ByteString.Char8 (ByteString) import Data.IORef import Data.Maybe (fromMaybe) @@ -28,7 +28,7 @@ -- executed with 'runHpp' or 'streamHpp'. newtype HppT m a = HppT (T.HppT [ByteString] - (Parser (StateT T.HppState (ExceptT T.Error m)) + (Parser (S.StateT T.HppState (ExceptT T.Error m)) [T.TOKEN]) a) deriving (Functor, Applicative, Monad) @@ -69,13 +69,34 @@ -> HppT m a -> ExceptT T.Error m ([FilePath], T.HppState) streamHpp st snk (HppT h) = - do (a, st') <- runStateT - (evalParse - (R.runHpp (liftIO . readLines) - (lift . lift . lift . snk) h) - []) - st + do (a, st') <- S.runStateT + (evalParse + (R.runHpp (liftIO . readLines) + (lift . lift . lift . snk) h) + []) + st either (throwE . snd) (return . (,st') . R.hppFilesRead) a + +-- | Like 'runHpp', but does not access the filesystem. Run a +-- preprocessor action with some initial state. Returns the result of +-- preprocessing as well as an updated preprocessor state +-- representation. Since this operation performs no IO, @#include@ directives are ignored in terms of the generated output lines, but the files named in those directive are available in the 'HppOutput' value returned. +expand :: T.HppState + -> HppT (S.State ([ByteString] -> [ByteString])) a + -> Except T.Error (HppOutput, T.HppState) +expand st (HppT h) = + case result of + Left e -> throwE e + Right (Left (_, e), _) -> throwE e + Right (Right x, st') -> + return (HppOutput (R.hppFilesRead x) (outDlist []), st') + where snk xs = S.modify (. (xs++)) + expanded = (S.runStateT + (evalParse + (R.expandHpp (lift . lift . lift . snk) h) + []) + st) + (result, outDlist) = S.runState (runExceptT expanded) id -- | An 'T.HppState' containing no macro definitions, and default -- values for the starting configuration: the name of the current file diff --git a/src/Hpp/RunHpp.hs b/src/Hpp/RunHpp.hs --- a/src/Hpp/RunHpp.hs +++ b/src/Hpp/RunHpp.hs @@ -1,7 +1,7 @@ {-# LANGUAGE BangPatterns, ConstraintKinds, LambdaCase, OverloadedStrings, ScopedTypeVariables, TupleSections, ViewPatterns #-} -- | Mid-level interface to the pre-processor. -module Hpp.RunHpp (parseDefinition, preprocess, runHpp, +module Hpp.RunHpp (parseDefinition, preprocess, runHpp, expandHpp, hppIOSink, HppCaps, hppIO, HppResult(..)) where import Control.Arrow (first) import Control.Exception (throwIO) @@ -9,7 +9,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Trans.State.Strict (StateT, evalStateT) +import Control.Monad.Trans.State.Strict (StateT, evalStateT, State) import Data.Char (isSpace) import Data.IORef import Data.Maybe (fromMaybe) @@ -244,6 +244,9 @@ data HppResult a = HppResult { hppFilesRead :: [FilePath] , hppResult :: a } +-- | Interpret the IO components of the preprocessor. This +-- implementation relies on IO for the purpose of checking search +-- paths for included files. runHpp :: forall m a src. (MonadIO m, HasHppState m) => (FilePath -> m src) -> (src -> m ()) @@ -274,6 +277,36 @@ -> ([String] -> Parser (StateT HppState (ExceptT Error IO)) [TOKEN] ()) -> HppT [String] (Parser (StateT HppState (ExceptT Error IO)) [TOKEN]) a -> Parser (StateT HppState (ExceptT Error IO)) [TOKEN] (Either (FilePath,Error) (HppResult a)) #-} + +-- | Like ’runHpp’, but any @#include@ directives are skipped. These +-- ignored inclusions are tracked in the returned list of files, but +-- note that since extra source files are not opened, any files they +-- might wish to include are not discovered. +expandHpp :: forall m a src. (Monad m, HasHppState m, Monoid src) + => (src -> m ()) + -> HppT src m a + -> m (Either (FilePath,Error) (HppResult a)) +expandHpp sink m = runHppT m >>= go [] + where go :: [FilePath] + -> FreeF (HppF src) a (HppT src m a) + -> m (Either (FilePath, Error) (HppResult a)) + go files (PureF x) = pure $ Right (HppResult files x) + go files (FreeF s) = case s of + ReadFile _ln file k -> runHppT (k mempty) >>= go (file:files) + ReadNext _ln file k -> runHppT (k mempty) >>= go (file:files) + WriteOutput output k -> sink output >> runHppT k >>= go files +{-# SPECIALIZE expandHpp :: + ([String] -> Parser (StateT HppState + (ExceptT Error + (State ([String] -> [String])))) + [TOKEN] ()) + -> HppT [String] (Parser (StateT HppState + (ExceptT Error + (State ([String] -> [String])))) + [TOKEN]) a + -> Parser (StateT HppState + (ExceptT Error (State ([String] -> [String])))) + [TOKEN] (Either (FilePath,Error) (HppResult a)) #-} -- * Preprocessor diff --git a/tests/AsLib.hs b/tests/AsLib.hs --- a/tests/AsLib.hs +++ b/tests/AsLib.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE LambdaCase, OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} import Control.Monad.Trans.Except import Data.ByteString.Char8 (ByteString) import Data.Maybe (fromMaybe) @@ -22,13 +22,14 @@ , "#endif" ] hppHelper :: HppState -> [ByteString] -> [ByteString] -> IO Bool -hppHelper st src expected = runExceptT (runHpp st (preprocess src)) >>= \case - Left e -> putStrLn ("Error running hpp: " ++ show e) >> return False - Right (res, _) -> if hppOutput res == expected - then return True - else do putStr ("Expected "++show expected++", got") - print (hppOutput res) - return False +hppHelper st src expected = + case runExcept (expand st (preprocess src)) of + Left e -> putStrLn ("Error running hpp: " ++ show e) >> return False + Right (res, _) -> if hppOutput res == expected + then return True + else do putStr ("Expected "++show expected++", got") + print (hppOutput res) + return False testElse :: IO Bool testElse = hppHelper emptyHppState sourceIfdef ["x = 99\n","\n"]