{-# LANGUAGE GeneralizedNewtypeDeriving, TupleSections #-}
-- | Front-end interface to the pre-processor.
module Hpp ( -- * Running the Preprocessor
            preprocess, runHpp, streamHpp, expand,
            -- * Preprocessor State
            T.HppState, emptyHppState, initHppState,
            -- * Adding Definitions
            parseDefinition, addDefinition,
            -- * Core Types
             HppT, HppOutput(..)
            ) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Class (lift, MonadTrans)
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)
import qualified Hpp.Config as C
import qualified Hpp.Env as E
import qualified Hpp.Macro as M
import qualified Hpp.RunHpp as R
import qualified Hpp.Types as T
import Hpp.Types (setL, config, env, lineNum)
import Hpp.Parser (evalParse, Parser)
import Hpp.StringSig (readLines)
import Hpp.Tokens (tokenize)

-- | The type of preprocessor actions. Created with 'preprocess' and
-- executed with 'runHpp' or 'streamHpp'.
newtype HppT m a =
  HppT (T.HppT [ByteString]
               (Parser (S.StateT T.HppState (ExceptT T.Error m))
                       [T.TOKEN])
               a)
  deriving (a -> HppT m b -> HppT m a
(a -> b) -> HppT m a -> HppT m b
(forall a b. (a -> b) -> HppT m a -> HppT m b)
-> (forall a b. a -> HppT m b -> HppT m a) -> Functor (HppT m)
forall a b. a -> HppT m b -> HppT m a
forall a b. (a -> b) -> HppT m a -> HppT m b
forall (m :: * -> *) a b. Functor m => a -> HppT m b -> HppT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> HppT m a -> HppT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> HppT m b -> HppT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> HppT m b -> HppT m a
fmap :: (a -> b) -> HppT m a -> HppT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> HppT m a -> HppT m b
Functor, Functor (HppT m)
a -> HppT m a
Functor (HppT m)
-> (forall a. a -> HppT m a)
-> (forall a b. HppT m (a -> b) -> HppT m a -> HppT m b)
-> (forall a b c.
    (a -> b -> c) -> HppT m a -> HppT m b -> HppT m c)
-> (forall a b. HppT m a -> HppT m b -> HppT m b)
-> (forall a b. HppT m a -> HppT m b -> HppT m a)
-> Applicative (HppT m)
HppT m a -> HppT m b -> HppT m b
HppT m a -> HppT m b -> HppT m a
HppT m (a -> b) -> HppT m a -> HppT m b
(a -> b -> c) -> HppT m a -> HppT m b -> HppT m c
forall a. a -> HppT m a
forall a b. HppT m a -> HppT m b -> HppT m a
forall a b. HppT m a -> HppT m b -> HppT m b
forall a b. HppT m (a -> b) -> HppT m a -> HppT m b
forall a b c. (a -> b -> c) -> HppT m a -> HppT m b -> HppT m c
forall (m :: * -> *). Monad m => Functor (HppT m)
forall (m :: * -> *) a. Monad m => a -> HppT m a
forall (m :: * -> *) a b.
Monad m =>
HppT m a -> HppT m b -> HppT m a
forall (m :: * -> *) a b.
Monad m =>
HppT m a -> HppT m b -> HppT m b
forall (m :: * -> *) a b.
Monad m =>
HppT m (a -> b) -> HppT m a -> HppT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> HppT m a -> HppT m b -> HppT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: HppT m a -> HppT m b -> HppT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
HppT m a -> HppT m b -> HppT m a
*> :: HppT m a -> HppT m b -> HppT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
HppT m a -> HppT m b -> HppT m b
liftA2 :: (a -> b -> c) -> HppT m a -> HppT m b -> HppT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> HppT m a -> HppT m b -> HppT m c
<*> :: HppT m (a -> b) -> HppT m a -> HppT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
HppT m (a -> b) -> HppT m a -> HppT m b
pure :: a -> HppT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> HppT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (HppT m)
Applicative, Applicative (HppT m)
a -> HppT m a
Applicative (HppT m)
-> (forall a b. HppT m a -> (a -> HppT m b) -> HppT m b)
-> (forall a b. HppT m a -> HppT m b -> HppT m b)
-> (forall a. a -> HppT m a)
-> Monad (HppT m)
HppT m a -> (a -> HppT m b) -> HppT m b
HppT m a -> HppT m b -> HppT m b
forall a. a -> HppT m a
forall a b. HppT m a -> HppT m b -> HppT m b
forall a b. HppT m a -> (a -> HppT m b) -> HppT m b
forall (m :: * -> *). Monad m => Applicative (HppT m)
forall (m :: * -> *) a. Monad m => a -> HppT m a
forall (m :: * -> *) a b.
Monad m =>
HppT m a -> HppT m b -> HppT m b
forall (m :: * -> *) a b.
Monad m =>
HppT m a -> (a -> HppT m b) -> HppT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> HppT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> HppT m a
>> :: HppT m a -> HppT m b -> HppT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
HppT m a -> HppT m b -> HppT m b
>>= :: HppT m a -> (a -> HppT m b) -> HppT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
HppT m a -> (a -> HppT m b) -> HppT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (HppT m)
Monad)

instance MonadTrans HppT where
  lift :: m a -> HppT m a
lift = HppT
  [ByteString] (Parser (StateT HppState (ExceptT Error m)) [TOKEN]) a
-> HppT m a
forall (m :: * -> *) a.
HppT
  [ByteString] (Parser (StateT HppState (ExceptT Error m)) [TOKEN]) a
-> HppT m a
HppT (HppT
   [ByteString] (Parser (StateT HppState (ExceptT Error m)) [TOKEN]) a
 -> HppT m a)
-> (m a
    -> HppT
         [ByteString]
         (Parser (StateT HppState (ExceptT Error m)) [TOKEN])
         a)
-> m a
-> HppT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT
  (Source
     (StateT HppState (ExceptT Error m))
     (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
     [TOKEN])
  (StateT HppState (ExceptT Error m))
  a
-> HppT
     [ByteString] (Parser (StateT HppState (ExceptT Error m)) [TOKEN]) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT
   (Source
      (StateT HppState (ExceptT Error m))
      (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
      [TOKEN])
   (StateT HppState (ExceptT Error m))
   a
 -> HppT
      [ByteString]
      (Parser (StateT HppState (ExceptT Error m)) [TOKEN])
      a)
-> (m a
    -> StateT
         (Source
            (StateT HppState (ExceptT Error m))
            (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
            [TOKEN])
         (StateT HppState (ExceptT Error m))
         a)
-> m a
-> HppT
     [ByteString] (Parser (StateT HppState (ExceptT Error m)) [TOKEN]) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT HppState (ExceptT Error m) a
-> StateT
     (Source
        (StateT HppState (ExceptT Error m))
        (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
        [TOKEN])
     (StateT HppState (ExceptT Error m))
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT HppState (ExceptT Error m) a
 -> StateT
      (Source
         (StateT HppState (ExceptT Error m))
         (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
         [TOKEN])
      (StateT HppState (ExceptT Error m))
      a)
-> (m a -> StateT HppState (ExceptT Error m) a)
-> m a
-> StateT
     (Source
        (StateT HppState (ExceptT Error m))
        (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
        [TOKEN])
     (StateT HppState (ExceptT Error m))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Error m a -> StateT HppState (ExceptT Error m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error m a -> StateT HppState (ExceptT Error m) a)
-> (m a -> ExceptT Error m a)
-> m a
-> StateT HppState (ExceptT Error m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | The result of running hpp
data HppOutput = HppOutput { HppOutput -> [FilePath]
hppFilesRead :: [FilePath]
                           , HppOutput -> [ByteString]
hppOutput    :: [ByteString] }

-- | Preprocess lines of input.
preprocess :: Monad m => [ByteString] -> HppT m ()
preprocess :: [ByteString] -> HppT m ()
preprocess = HppT
  [ByteString]
  (Parser (StateT HppState (ExceptT Error m)) [TOKEN])
  ()
-> HppT m ()
forall (m :: * -> *) a.
HppT
  [ByteString] (Parser (StateT HppState (ExceptT Error m)) [TOKEN]) a
-> HppT m a
HppT (HppT
   [ByteString]
   (Parser (StateT HppState (ExceptT Error m)) [TOKEN])
   ()
 -> HppT m ())
-> ([ByteString]
    -> HppT
         [ByteString]
         (Parser (StateT HppState (ExceptT Error m)) [TOKEN])
         ())
-> [ByteString]
-> HppT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString]
-> HppT
     [ByteString]
     (Parser (StateT HppState (ExceptT Error m)) [TOKEN])
     ()
forall (m :: * -> *).
(Monad m, HasHppState m, HasError m, HasEnv m) =>
[ByteString] -> HppT [ByteString] (Parser m [TOKEN]) ()
R.preprocess

-- | Run a preprocessor action with some initial state. Returns the
-- result of preprocessing as well as an updated preprocessor state
-- representation.
runHpp :: MonadIO m
       => T.HppState
       -> HppT m a
       -> ExceptT T.Error m (HppOutput, T.HppState)
runHpp :: HppState -> HppT m a -> ExceptT Error m (HppOutput, HppState)
runHpp HppState
st HppT m a
h =
  do IORef ([ByteString] -> [ByteString])
r <- IO (IORef ([ByteString] -> [ByteString]))
-> ExceptT Error m (IORef ([ByteString] -> [ByteString]))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (([ByteString] -> [ByteString])
-> IO (IORef ([ByteString] -> [ByteString]))
forall a. a -> IO (IORef a)
newIORef [ByteString] -> [ByteString]
forall a. a -> a
id)
     let snk :: [ByteString] -> IO ()
snk [ByteString]
xs = IORef ([ByteString] -> [ByteString])
-> (([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString])
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ([ByteString] -> [ByteString])
r (([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString]
xs[ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++))
     let fin :: ([FilePath], b) -> IO (HppOutput, b)
fin ([FilePath]
x, b
st') = do [ByteString]
outLines <- (([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ []) (([ByteString] -> [ByteString]) -> [ByteString])
-> IO ([ByteString] -> [ByteString]) -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef ([ByteString] -> [ByteString])
-> IO ([ByteString] -> [ByteString])
forall a. IORef a -> IO a
readIORef IORef ([ByteString] -> [ByteString])
r
                           (HppOutput, b) -> IO (HppOutput, b)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> [ByteString] -> HppOutput
HppOutput [FilePath]
x [ByteString]
outLines, b
st')
     HppState
-> ([ByteString] -> m ())
-> HppT m a
-> ExceptT Error m ([FilePath], HppState)
forall (m :: * -> *) a.
MonadIO m =>
HppState
-> ([ByteString] -> m ())
-> HppT m a
-> ExceptT Error m ([FilePath], HppState)
streamHpp HppState
st (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> ([ByteString] -> IO ()) -> [ByteString] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> IO ()
snk) HppT m a
h ExceptT Error m ([FilePath], HppState)
-> (([FilePath], HppState)
    -> ExceptT Error m (HppOutput, HppState))
-> ExceptT Error m (HppOutput, HppState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (HppOutput, HppState) -> ExceptT Error m (HppOutput, HppState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HppOutput, HppState) -> ExceptT Error m (HppOutput, HppState))
-> (([FilePath], HppState) -> IO (HppOutput, HppState))
-> ([FilePath], HppState)
-> ExceptT Error m (HppOutput, HppState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], HppState) -> IO (HppOutput, HppState)
forall b. ([FilePath], b) -> IO (HppOutput, b)
fin

-- | @streamHpp state sink action@ runs a preprocessor @action@ with
-- some initial @state@. Output is streamed to the caller-provided
-- output @sink@ as it is generated. The list of files read during
-- preprocessing is returned along with an updated preprocessor state
-- representation.
streamHpp :: MonadIO m
          => T.HppState
          -> ([ByteString] -> m ())
          -> HppT m a
          -> ExceptT T.Error m ([FilePath], T.HppState)
streamHpp :: HppState
-> ([ByteString] -> m ())
-> HppT m a
-> ExceptT Error m ([FilePath], HppState)
streamHpp HppState
st [ByteString] -> m ()
snk (HppT HppT
  [ByteString] (Parser (StateT HppState (ExceptT Error m)) [TOKEN]) a
h) =
  do (Either (FilePath, Error) (HppResult a)
a, HppState
st') <- StateT
  HppState (ExceptT Error m) (Either (FilePath, Error) (HppResult a))
-> HppState
-> ExceptT
     Error m (Either (FilePath, Error) (HppResult a), HppState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT
                     (Parser
  (StateT HppState (ExceptT Error m))
  [TOKEN]
  (Either (FilePath, Error) (HppResult a))
-> [[TOKEN]]
-> StateT
     HppState (ExceptT Error m) (Either (FilePath, Error) (HppResult a))
forall (m :: * -> *) i o. Monad m => Parser m i o -> [i] -> m o
evalParse
                        ((FilePath
 -> StateT
      (Source
         (StateT HppState (ExceptT Error m))
         (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
         [TOKEN])
      (StateT HppState (ExceptT Error m))
      [ByteString])
-> ([ByteString]
    -> StateT
         (Source
            (StateT HppState (ExceptT Error m))
            (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
            [TOKEN])
         (StateT HppState (ExceptT Error m))
         ())
-> HppT
     [ByteString] (Parser (StateT HppState (ExceptT Error m)) [TOKEN]) a
-> Parser
     (StateT HppState (ExceptT Error m))
     [TOKEN]
     (Either (FilePath, Error) (HppResult a))
forall (m :: * -> *) a src.
(MonadIO m, HasHppState m) =>
(FilePath -> m src)
-> (src -> m ())
-> HppT src m a
-> m (Either (FilePath, Error) (HppResult a))
R.runHpp (IO [ByteString]
-> StateT
     (Source
        (StateT HppState (ExceptT Error m))
        (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
        [TOKEN])
     (StateT HppState (ExceptT Error m))
     [ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ByteString]
 -> StateT
      (Source
         (StateT HppState (ExceptT Error m))
         (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
         [TOKEN])
      (StateT HppState (ExceptT Error m))
      [ByteString])
-> (FilePath -> IO [ByteString])
-> FilePath
-> StateT
     (Source
        (StateT HppState (ExceptT Error m))
        (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
        [TOKEN])
     (StateT HppState (ExceptT Error m))
     [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [ByteString]
forall s. Stringy s => FilePath -> IO [s]
readLines)
                                  (StateT HppState (ExceptT Error m) ()
-> StateT
     (Source
        (StateT HppState (ExceptT Error m))
        (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
        [TOKEN])
     (StateT HppState (ExceptT Error m))
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT HppState (ExceptT Error m) ()
 -> StateT
      (Source
         (StateT HppState (ExceptT Error m))
         (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
         [TOKEN])
      (StateT HppState (ExceptT Error m))
      ())
-> ([ByteString] -> StateT HppState (ExceptT Error m) ())
-> [ByteString]
-> StateT
     (Source
        (StateT HppState (ExceptT Error m))
        (Input (StateT HppState (ExceptT Error m)) [[TOKEN]])
        [TOKEN])
     (StateT HppState (ExceptT Error m))
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Error m () -> StateT HppState (ExceptT Error m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error m () -> StateT HppState (ExceptT Error m) ())
-> ([ByteString] -> ExceptT Error m ())
-> [ByteString]
-> StateT HppState (ExceptT Error m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> ExceptT Error m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Error m ())
-> ([ByteString] -> m ()) -> [ByteString] -> ExceptT Error m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> m ()
snk)
                                  HppT
  [ByteString] (Parser (StateT HppState (ExceptT Error m)) [TOKEN]) a
h)
                        [])
                     HppState
st
     ((FilePath, Error) -> ExceptT Error m ([FilePath], HppState))
-> (HppResult a -> ExceptT Error m ([FilePath], HppState))
-> Either (FilePath, Error) (HppResult a)
-> ExceptT Error m ([FilePath], HppState)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Error -> ExceptT Error m ([FilePath], HppState)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> ExceptT Error m ([FilePath], HppState))
-> ((FilePath, Error) -> Error)
-> (FilePath, Error)
-> ExceptT Error m ([FilePath], HppState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Error) -> Error
forall a b. (a, b) -> b
snd) (([FilePath], HppState) -> ExceptT Error m ([FilePath], HppState)
forall (m :: * -> *) a. Monad m => a -> m a
return (([FilePath], HppState) -> ExceptT Error m ([FilePath], HppState))
-> (HppResult a -> ([FilePath], HppState))
-> HppResult a
-> ExceptT Error m ([FilePath], HppState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,HppState
st') ([FilePath] -> ([FilePath], HppState))
-> (HppResult a -> [FilePath])
-> HppResult a
-> ([FilePath], HppState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HppResult a -> [FilePath]
forall a. HppResult a -> [FilePath]
R.hppFilesRead) Either (FilePath, Error) (HppResult a)
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 :: HppState
-> HppT (State ([ByteString] -> [ByteString])) a
-> Except Error (HppOutput, HppState)
expand HppState
st (HppT HppT
  [ByteString]
  (Parser
     (StateT
        HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
     [TOKEN])
  a
h) =
  case Either Error (Either (FilePath, Error) (HppResult a), HppState)
result of
    Left Error
e -> Error -> Except Error (HppOutput, HppState)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Error
e
    Right (Left (FilePath
_, Error
e), HppState
_) -> Error -> Except Error (HppOutput, HppState)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Error
e
    Right (Right HppResult a
x, HppState
st') ->
      (HppOutput, HppState) -> Except Error (HppOutput, HppState)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> [ByteString] -> HppOutput
HppOutput (HppResult a -> [FilePath]
forall a. HppResult a -> [FilePath]
R.hppFilesRead HppResult a
x) ([ByteString] -> [ByteString]
outDlist []), HppState
st')
  where snk :: [a] -> StateT ([a] -> c) m ()
snk [a]
xs = (([a] -> c) -> [a] -> c) -> StateT ([a] -> c) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
S.modify (([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a]
xs[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++))
        expanded :: ExceptT
  Error
  (State ([ByteString] -> [ByteString]))
  (Either (FilePath, Error) (HppResult a), HppState)
expanded = (StateT
  HppState
  (ExceptT Error (State ([ByteString] -> [ByteString])))
  (Either (FilePath, Error) (HppResult a))
-> HppState
-> ExceptT
     Error
     (State ([ByteString] -> [ByteString]))
     (Either (FilePath, Error) (HppResult a), HppState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT
                      (Parser
  (StateT
     HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
  [TOKEN]
  (Either (FilePath, Error) (HppResult a))
-> [[TOKEN]]
-> StateT
     HppState
     (ExceptT Error (State ([ByteString] -> [ByteString])))
     (Either (FilePath, Error) (HppResult a))
forall (m :: * -> *) i o. Monad m => Parser m i o -> [i] -> m o
evalParse
                         (([ByteString]
 -> StateT
      (Source
         (StateT
            HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
         (Input
            (StateT
               HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
            [[TOKEN]])
         [TOKEN])
      (StateT
         HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
      ())
-> HppT
     [ByteString]
     (Parser
        (StateT
           HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
        [TOKEN])
     a
-> Parser
     (StateT
        HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
     [TOKEN]
     (Either (FilePath, Error) (HppResult a))
forall (m :: * -> *) a src.
(Monad m, HasHppState m, Monoid src) =>
(src -> m ())
-> HppT src m a -> m (Either (FilePath, Error) (HppResult a))
R.expandHpp (StateT
  HppState (ExceptT Error (State ([ByteString] -> [ByteString]))) ()
-> StateT
     (Source
        (StateT
           HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
        (Input
           (StateT
              HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
           [[TOKEN]])
        [TOKEN])
     (StateT
        HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT
   HppState (ExceptT Error (State ([ByteString] -> [ByteString]))) ()
 -> StateT
      (Source
         (StateT
            HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
         (Input
            (StateT
               HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
            [[TOKEN]])
         [TOKEN])
      (StateT
         HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
      ())
-> ([ByteString]
    -> StateT
         HppState (ExceptT Error (State ([ByteString] -> [ByteString]))) ())
-> [ByteString]
-> StateT
     (Source
        (StateT
           HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
        (Input
           (StateT
              HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
           [[TOKEN]])
        [TOKEN])
     (StateT
        HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Error (State ([ByteString] -> [ByteString])) ()
-> StateT
     HppState (ExceptT Error (State ([ByteString] -> [ByteString]))) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error (State ([ByteString] -> [ByteString])) ()
 -> StateT
      HppState (ExceptT Error (State ([ByteString] -> [ByteString]))) ())
-> ([ByteString]
    -> ExceptT Error (State ([ByteString] -> [ByteString])) ())
-> [ByteString]
-> StateT
     HppState (ExceptT Error (State ([ByteString] -> [ByteString]))) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT ([ByteString] -> [ByteString]) Identity ()
-> ExceptT Error (State ([ByteString] -> [ByteString])) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([ByteString] -> [ByteString]) Identity ()
 -> ExceptT Error (State ([ByteString] -> [ByteString])) ())
-> ([ByteString]
    -> StateT ([ByteString] -> [ByteString]) Identity ())
-> [ByteString]
-> ExceptT Error (State ([ByteString] -> [ByteString])) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> StateT ([ByteString] -> [ByteString]) Identity ()
forall (m :: * -> *) a c. Monad m => [a] -> StateT ([a] -> c) m ()
snk) HppT
  [ByteString]
  (Parser
     (StateT
        HppState (ExceptT Error (State ([ByteString] -> [ByteString]))))
     [TOKEN])
  a
h)
                         [])
                      HppState
st)
        (Either Error (Either (FilePath, Error) (HppResult a), HppState)
result, [ByteString] -> [ByteString]
outDlist) = State
  ([ByteString] -> [ByteString])
  (Either Error (Either (FilePath, Error) (HppResult a), HppState))
-> ([ByteString] -> [ByteString])
-> (Either
      Error (Either (FilePath, Error) (HppResult a), HppState),
    [ByteString] -> [ByteString])
forall s a. State s a -> s -> (a, s)
S.runState (ExceptT
  Error
  (State ([ByteString] -> [ByteString]))
  (Either (FilePath, Error) (HppResult a), HppState)
-> State
     ([ByteString] -> [ByteString])
     (Either Error (Either (FilePath, Error) (HppResult a), HppState))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT
  Error
  (State ([ByteString] -> [ByteString]))
  (Either (FilePath, Error) (HppResult a), HppState)
expanded) [ByteString] -> [ByteString]
forall a. a -> a
id

-- | An 'T.HppState' containing no macro definitions, and default
-- values for the starting configuration: the name of the current file
-- is @\"NoFile\"@, there are no paths to be searched for included
-- files, etc. See 'C.Config' for more information on available
-- configuration.
emptyHppState :: T.HppState
emptyHppState :: HppState
emptyHppState = Config -> HppState
T.emptyHppState
              (Config -> HppState) -> Config -> HppState
forall a b. (a -> b) -> a -> b
$ Config -> Maybe Config -> Config
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Config
forall a. HasCallStack => FilePath -> a
error FilePath
"emptyHppState assumption wrong")
                          (ConfigF Maybe -> Maybe Config
C.realizeConfig ConfigF Maybe
cfg)
  where cfg :: ConfigF Maybe
cfg = ConfigF Maybe
C.defaultConfigF { curFileNameF :: Maybe FilePath
C.curFileNameF = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"NoFile" }

-- | Create a 'T.HppState' with the given 'C.Config' and 'T.Env'.
initHppState :: C.Config -> T.Env -> T.HppState
initHppState :: Config -> Env -> HppState
initHppState Config
c Env
e = Lens HppState LineNum -> LineNum -> HppState -> HppState
forall s a. Lens s a -> a -> s -> s
setL Lens HppState LineNum
lineNum LineNum
1 (HppState -> HppState)
-> (HppState -> HppState) -> HppState -> HppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens HppState Env -> Env -> HppState -> HppState
forall s a. Lens s a -> a -> s -> s
setL Lens HppState Env
env Env
e (HppState -> HppState)
-> (HppState -> HppState) -> HppState -> HppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens HppState Config -> Config -> HppState -> HppState
forall s a. Lens s a -> a -> s -> s
setL Lens HppState Config
config Config
c (HppState -> HppState) -> HppState -> HppState
forall a b. (a -> b) -> a -> b
$ HppState
emptyHppState

-- | @addDefinition name expression@ adds a binding of @name@ to
-- @expression@ in the preprocessor’s internal state.
addDefinition :: ByteString -> ByteString -> T.HppState -> Maybe T.HppState
addDefinition :: ByteString -> ByteString -> HppState -> Maybe HppState
addDefinition ByteString
name ByteString
val HppState
s = ((Env -> Env) -> HppState -> HppState)
-> HppState -> (Env -> Env) -> HppState
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Lens HppState Env -> (Env -> Env) -> HppState -> HppState
forall s a. Lens s a -> (a -> a) -> s -> s
T.over Lens HppState Env
T.env) HppState
s ((Env -> Env) -> HppState)
-> ((ByteString, Macro) -> Env -> Env)
-> (ByteString, Macro)
-> HppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Macro) -> Env -> Env
forall a.
(ByteString, a) -> HashMap ByteString a -> HashMap ByteString a
E.insertPair
                           ((ByteString, Macro) -> HppState)
-> Maybe (ByteString, Macro) -> Maybe HppState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ByteString -> Maybe (ByteString, Macro)
parseDefinition ByteString
name ByteString
val

-- | Lower level parsing of macro definitions. Will typically be used
-- with 'E.insertPair' for manual construction of a 'T.Env' binding
-- environment.
parseDefinition :: ByteString -> ByteString -> Maybe (ByteString, T.Macro)
parseDefinition :: ByteString -> ByteString -> Maybe (ByteString, Macro)
parseDefinition ByteString
name ByteString
val = [TOKEN] -> Maybe (ByteString, Macro)
M.parseDefinition (ByteString -> [TOKEN]
forall s. Stringy s => s -> [Token s]
tokenize ByteString
name [TOKEN] -> [TOKEN] -> [TOKEN]
forall a. [a] -> [a] -> [a]
++ ByteString -> [TOKEN]
forall s. Stringy s => s -> [Token s]
tokenize ByteString
val)