{-# LANGUAGE BangPatterns, ConstraintKinds, LambdaCase, OverloadedStrings,
             ScopedTypeVariables, TupleSections, ViewPatterns #-}
-- | Mid-level interface to the pre-processor.
module Hpp.RunHpp (preprocess, runHpp, expandHpp,
                   hppIOSink, hppIO, HppResult(..)) where
import Control.Exception (throwIO)
import Control.Monad ((>=>))
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, State)
import Data.IORef
import Hpp.Config (Config, curFileNameF, curFileName, includePaths, inhibitLinemarkers)
import Hpp.Directive (macroExpansion)
import Hpp.Parser (Parser, precede, evalParse)
import Hpp.Preprocessing
import Hpp.StringSig
import Hpp.String (stripAngleBrackets)
import Hpp.Tokens (detokenize)
import Hpp.Types
import System.Directory (doesFileExist)
import System.FilePath ((</>))
import Prelude hiding (String)
import qualified Prelude as P

-- * Finding @include@ files

includeCandidates :: FilePath -> [FilePath] -> P.String -> Maybe [FilePath]
includeCandidates :: FilePath -> [FilePath] -> FilePath -> Maybe [FilePath]
includeCandidates FilePath
curDir [FilePath]
searchPath FilePath
nm =
  case FilePath
nm of
    Char
'<':FilePath
nm' -> [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just ([FilePath] -> Maybe [FilePath]) -> [FilePath] -> Maybe [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
sysSearch   (FilePath -> FilePath
forall a. [a] -> [a]
init FilePath
nm')
    Char
'"':FilePath
nm' -> let nm'' :: FilePath
nm'' = FilePath -> FilePath
forall a. [a] -> [a]
init FilePath
nm'
               in [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just ([FilePath] -> Maybe [FilePath]) -> [FilePath] -> Maybe [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
nm'' FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
localSearch FilePath
nm''
    FilePath
_ -> Maybe [FilePath]
forall a. Maybe a
Nothing
  where sysSearch :: FilePath -> [FilePath]
sysSearch   FilePath
f = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
</> FilePath
f) [FilePath]
searchPath
        localSearch :: FilePath -> [FilePath]
localSearch FilePath
f = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
</> FilePath
f) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
curDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
searchPath

searchForInclude :: FilePath -> [FilePath] -> P.String -> IO (Maybe FilePath)
searchForInclude :: FilePath -> [FilePath] -> FilePath -> IO (Maybe FilePath)
searchForInclude FilePath
curDir [FilePath]
paths =
  IO (Maybe FilePath)
-> ([FilePath] -> IO (Maybe FilePath))
-> Maybe [FilePath]
-> IO (Maybe FilePath)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing) [FilePath] -> IO (Maybe FilePath)
aux (Maybe [FilePath] -> IO (Maybe FilePath))
-> (FilePath -> Maybe [FilePath])
-> FilePath
-> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> FilePath -> Maybe [FilePath]
includeCandidates FilePath
curDir [FilePath]
paths
  where aux :: [FilePath] -> IO (Maybe FilePath)
aux [] = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
        aux (FilePath
f:[FilePath]
fs) = do Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
f
                        if Bool
exists then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f) else [FilePath] -> IO (Maybe FilePath)
aux [FilePath]
fs

searchForNextInclude :: FilePath -> [FilePath] -> P.String -> IO (Maybe FilePath)
searchForNextInclude :: FilePath -> [FilePath] -> FilePath -> IO (Maybe FilePath)
searchForNextInclude FilePath
curDir [FilePath]
paths =
  IO (Maybe FilePath)
-> ([FilePath] -> IO (Maybe FilePath))
-> Maybe [FilePath]
-> IO (Maybe FilePath)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing) (Bool -> [FilePath] -> IO (Maybe FilePath)
aux Bool
False) (Maybe [FilePath] -> IO (Maybe FilePath))
-> (FilePath -> Maybe [FilePath])
-> FilePath
-> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> FilePath -> Maybe [FilePath]
includeCandidates FilePath
curDir [FilePath]
paths
  where aux :: Bool -> [FilePath] -> IO (Maybe FilePath)
aux Bool
_ [] = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
        aux Bool
n (FilePath
f:[FilePath]
fs) = do Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
f
                          if Bool
exists
                          then if Bool
n
                               then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f)
                               else Bool -> [FilePath] -> IO (Maybe FilePath)
aux Bool
True [FilePath]
fs
                          else Bool -> [FilePath] -> IO (Maybe FilePath)
aux Bool
n [FilePath]
fs

-- * Running an Hpp Action

data HppResult a = HppResult { HppResult a -> [FilePath]
hppFilesRead :: [FilePath]
                             , HppResult a -> a
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 ())
       -> HppT src m a
       -> m (Either (FilePath,Error) (HppResult a))
runHpp :: (FilePath -> m src)
-> (src -> m ())
-> HppT src m a
-> m (Either (FilePath, Error) (HppResult a))
runHpp FilePath -> m src
source src -> m ()
sink HppT src m a
m = HppT src m a -> m (Hpp src a (HppT src m a))
forall t (m :: * -> *) a. HppT t m a -> m (Hpp t a (HppT t m a))
runHppT HppT src m a
m m (Hpp src a (HppT src m a))
-> (Hpp src a (HppT src m a)
    -> m (Either (FilePath, Error) (HppResult a)))
-> m (Either (FilePath, Error) (HppResult a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath]
-> Hpp src a (HppT src m a)
-> m (Either (FilePath, Error) (HppResult a))
go []
  where go :: [FilePath]
           -> FreeF (HppF src) a (HppT src m a)
           -> m (Either (FilePath, Error) (HppResult a))
        go :: [FilePath]
-> Hpp src a (HppT src m a)
-> m (Either (FilePath, Error) (HppResult a))
go [FilePath]
files (PureF a
x) = Either (FilePath, Error) (HppResult a)
-> m (Either (FilePath, Error) (HppResult a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FilePath, Error) (HppResult a)
 -> m (Either (FilePath, Error) (HppResult a)))
-> Either (FilePath, Error) (HppResult a)
-> m (Either (FilePath, Error) (HppResult a))
forall a b. (a -> b) -> a -> b
$ HppResult a -> Either (FilePath, Error) (HppResult a)
forall a b. b -> Either a b
Right ([FilePath] -> a -> HppResult a
forall a. [FilePath] -> a -> HppResult a
HppResult [FilePath]
files a
x)
        go [FilePath]
files (FreeF HppF src (HppT src m a)
s) = case HppF src (HppT src m a)
s of
          ReadFile Int
ln FilePath
file src -> HppT src m a
k -> do
            Config
cfg    <- Lens HppState Config -> m Config
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState Config
config
            FilePath
curDir <- Lens HppState FilePath -> m FilePath
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState FilePath
dir
            let ipaths :: [FilePath]
ipaths = Config -> [FilePath]
includePaths Config
cfg
            Maybe FilePath
mFound <- IO (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> m (Maybe FilePath))
-> IO (Maybe FilePath) -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath -> IO (Maybe FilePath)
searchForInclude FilePath
curDir [FilePath]
ipaths FilePath
file
            [FilePath]
-> Int
-> FilePath
-> (src -> HppT src m a)
-> Maybe FilePath
-> m (Either (FilePath, Error) (HppResult a))
readAux (FilePath
fileFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
files) Int
ln FilePath
file src -> HppT src m a
k Maybe FilePath
mFound
          ReadNext Int
ln FilePath
file src -> HppT src m a
k -> do
            Config
cfg    <- Lens HppState Config -> m Config
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState Config
config
            FilePath
curDir <- Lens HppState FilePath -> m FilePath
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState FilePath
dir
            let ipaths :: [FilePath]
ipaths = Config -> [FilePath]
includePaths Config
cfg
            Maybe FilePath
mFound <- IO (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> m (Maybe FilePath))
-> IO (Maybe FilePath) -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath -> IO (Maybe FilePath)
searchForNextInclude FilePath
curDir [FilePath]
ipaths FilePath
file
            [FilePath]
-> Int
-> FilePath
-> (src -> HppT src m a)
-> Maybe FilePath
-> m (Either (FilePath, Error) (HppResult a))
readAux (FilePath
fileFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
files) Int
ln FilePath
file src -> HppT src m a
k Maybe FilePath
mFound
          WriteOutput src
output HppT src m a
k -> src -> m ()
sink src
output m ()
-> m (Hpp src a (HppT src m a)) -> m (Hpp src a (HppT src m a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HppT src m a -> m (Hpp src a (HppT src m a))
forall t (m :: * -> *) a. HppT t m a -> m (Hpp t a (HppT t m a))
runHppT HppT src m a
k m (Hpp src a (HppT src m a))
-> (Hpp src a (HppT src m a)
    -> m (Either (FilePath, Error) (HppResult a)))
-> m (Either (FilePath, Error) (HppResult a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath]
-> Hpp src a (HppT src m a)
-> m (Either (FilePath, Error) (HppResult a))
go [FilePath]
files

        readAux :: [FilePath]
-> Int
-> FilePath
-> (src -> HppT src m a)
-> Maybe FilePath
-> m (Either (FilePath, Error) (HppResult a))
readAux [FilePath]
_files Int
ln FilePath
file src -> HppT src m a
_ Maybe FilePath
Nothing =
          (FilePath, Error) -> Either (FilePath, Error) (HppResult a)
forall a b. a -> Either a b
Left ((FilePath, Error) -> Either (FilePath, Error) (HppResult a))
-> (Config -> (FilePath, Error))
-> Config
-> Either (FilePath, Error) (HppResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, Int -> FilePath -> Error
IncludeDoesNotExist Int
ln (FilePath -> FilePath
stripAngleBrackets FilePath
file))
               (FilePath -> (FilePath, Error))
-> (Config -> FilePath) -> Config -> (FilePath, Error)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> FilePath
curFileName (Config -> Either (FilePath, Error) (HppResult a))
-> m Config -> m (Either (FilePath, Error) (HppResult a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lens HppState Config -> m Config
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState Config
config
        readAux [FilePath]
files Int
_ln FilePath
_file src -> HppT src m a
k (Just FilePath
file') =
          FilePath -> m src
source FilePath
file' m src
-> (src -> m (Hpp src a (HppT src m a)))
-> m (Hpp src a (HppT src m a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HppT src m a -> m (Hpp src a (HppT src m a))
forall t (m :: * -> *) a. HppT t m a -> m (Hpp t a (HppT t m a))
runHppT (HppT src m a -> m (Hpp src a (HppT src m a)))
-> (src -> HppT src m a) -> src -> m (Hpp src a (HppT src m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. src -> HppT src m a
k m (Hpp src a (HppT src m a))
-> (Hpp src a (HppT src m a)
    -> m (Either (FilePath, Error) (HppResult a)))
-> m (Either (FilePath, Error) (HppResult a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath]
-> Hpp src a (HppT src m a)
-> m (Either (FilePath, Error) (HppResult a))
go [FilePath]
files
{-# SPECIALIZE runHpp ::
    (FilePath -> Parser (StateT HppState (ExceptT Error IO)) [TOKEN] [String])
 -> ([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 :: (src -> m ())
-> HppT src m a -> m (Either (FilePath, Error) (HppResult a))
expandHpp src -> m ()
sink HppT src m a
m = HppT src m a -> m (Hpp src a (HppT src m a))
forall t (m :: * -> *) a. HppT t m a -> m (Hpp t a (HppT t m a))
runHppT HppT src m a
m m (Hpp src a (HppT src m a))
-> (Hpp src a (HppT src m a)
    -> m (Either (FilePath, Error) (HppResult a)))
-> m (Either (FilePath, Error) (HppResult a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath]
-> Hpp src a (HppT src m a)
-> m (Either (FilePath, Error) (HppResult a))
go []
  where go :: [FilePath]
           -> FreeF (HppF src) a (HppT src m a)
           -> m (Either (FilePath, Error) (HppResult a))
        go :: [FilePath]
-> Hpp src a (HppT src m a)
-> m (Either (FilePath, Error) (HppResult a))
go [FilePath]
files (PureF a
x) = Either (FilePath, Error) (HppResult a)
-> m (Either (FilePath, Error) (HppResult a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (FilePath, Error) (HppResult a)
 -> m (Either (FilePath, Error) (HppResult a)))
-> Either (FilePath, Error) (HppResult a)
-> m (Either (FilePath, Error) (HppResult a))
forall a b. (a -> b) -> a -> b
$ HppResult a -> Either (FilePath, Error) (HppResult a)
forall a b. b -> Either a b
Right ([FilePath] -> a -> HppResult a
forall a. [FilePath] -> a -> HppResult a
HppResult [FilePath]
files a
x)
        go [FilePath]
files (FreeF HppF src (HppT src m a)
s) = case HppF src (HppT src m a)
s of
          ReadFile Int
_ln FilePath
file src -> HppT src m a
k -> HppT src m a -> m (Hpp src a (HppT src m a))
forall t (m :: * -> *) a. HppT t m a -> m (Hpp t a (HppT t m a))
runHppT (src -> HppT src m a
k src
forall a. Monoid a => a
mempty) m (Hpp src a (HppT src m a))
-> (Hpp src a (HppT src m a)
    -> m (Either (FilePath, Error) (HppResult a)))
-> m (Either (FilePath, Error) (HppResult a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath]
-> Hpp src a (HppT src m a)
-> m (Either (FilePath, Error) (HppResult a))
go (FilePath
fileFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
files)
          ReadNext Int
_ln FilePath
file src -> HppT src m a
k -> HppT src m a -> m (Hpp src a (HppT src m a))
forall t (m :: * -> *) a. HppT t m a -> m (Hpp t a (HppT t m a))
runHppT (src -> HppT src m a
k src
forall a. Monoid a => a
mempty) m (Hpp src a (HppT src m a))
-> (Hpp src a (HppT src m a)
    -> m (Either (FilePath, Error) (HppResult a)))
-> m (Either (FilePath, Error) (HppResult a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath]
-> Hpp src a (HppT src m a)
-> m (Either (FilePath, Error) (HppResult a))
go (FilePath
fileFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
files)
          WriteOutput src
output HppT src m a
k -> src -> m ()
sink src
output m ()
-> m (Hpp src a (HppT src m a)) -> m (Hpp src a (HppT src m a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HppT src m a -> m (Hpp src a (HppT src m a))
forall t (m :: * -> *) a. HppT t m a -> m (Hpp t a (HppT t m a))
runHppT HppT src m a
k m (Hpp src a (HppT src m a))
-> (Hpp src a (HppT src m a)
    -> m (Either (FilePath, Error) (HppResult a)))
-> m (Either (FilePath, Error) (HppResult a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath]
-> Hpp src a (HppT src m a)
-> m (Either (FilePath, Error) (HppResult a))
go [FilePath]
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)) #-}

parseStreamHpp :: Monad m
               => HppT t (Parser m i) (Maybe t) -> HppT t (Parser m i) ()
parseStreamHpp :: HppT t (Parser m i) (Maybe t) -> HppT t (Parser m i) ()
parseStreamHpp HppT t (Parser m i) (Maybe t)
m = HppT t (Parser m i) ()
go
  where go :: HppT t (Parser m i) ()
go = HppT t (Parser m i) (Maybe t)
m HppT t (Parser m i) (Maybe t)
-> (Maybe t -> HppT t (Parser m i) ()) -> HppT t (Parser m i) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe t
Nothing -> () -> HppT t (Parser m i) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just t
o -> t -> HppT t (Parser m i) ()
forall (m :: * -> *) t. Monad m => t -> HppT t m ()
hppWriteOutput t
o HppT t (Parser m i) ()
-> HppT t (Parser m i) () -> HppT t (Parser m i) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HppT t (Parser m i) ()
go

-- * Front End

-- | Run a stream of lines through the preprocessor.
preprocess :: (Monad m, HasHppState m, HasError m, HasEnv m)
           => [String] -> HppT [String] (Parser m [TOKEN]) ()
preprocess :: [String] -> HppT [String] (Parser m [TOKEN]) ()
preprocess [String]
src =
  do Config
cfg <- Lens HppState Config -> HppState -> Config
forall s a. Lens s a -> s -> a
getL Lens HppState Config
config (HppState -> Config)
-> HppT [String] (Parser m [TOKEN]) HppState
-> HppT [String] (Parser m [TOKEN]) Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HppT [String] (Parser m [TOKEN]) HppState
forall (m :: * -> *). HasHppState m => m HppState
getState
     [String] -> [[TOKEN]]
prep <- HppT [String] (Parser m [TOKEN]) ([String] -> [[TOKEN]])
forall (m :: * -> *).
(Monad m, HasHppState m) =>
m ([String] -> [[TOKEN]])
prepareInput
     let prepOutput :: String -> [String]
prepOutput = if Config -> Bool
inhibitLinemarkers Config
cfg then String -> [String]
forall a. Stringy a => a -> [a]
aux else String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
     StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [String] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([[TOKEN]] -> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) i src. Monad m => [i] -> ParserT m src i ()
precede ([String] -> [[TOKEN]]
prep [String]
src))
     HppT [String] (Parser m [TOKEN]) (Maybe [String])
-> HppT [String] (Parser m [TOKEN]) ()
forall (m :: * -> *) t i.
Monad m =>
HppT t (Parser m i) (Maybe t) -> HppT t (Parser m i) ()
parseStreamHpp (([TOKEN] -> [String]) -> Maybe [TOKEN] -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String]
prepOutput (String -> [String]) -> ([TOKEN] -> String) -> [TOKEN] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TOKEN] -> String
forall s. Monoid s => [Token s] -> s
detokenize) (Maybe [TOKEN] -> Maybe [String])
-> HppT [String] (Parser m [TOKEN]) (Maybe [TOKEN])
-> HppT [String] (Parser m [TOKEN]) (Maybe [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HppT [String] (Parser m [TOKEN]) (Maybe [TOKEN])
forall (m :: * -> *).
(Monad m, HasHppState m, HasError m, HasEnv m) =>
HppT [String] (Parser m [TOKEN]) (Maybe [TOKEN])
macroExpansion)
  where aux :: a -> [a]
aux a
xs | a -> a -> Bool
forall s. Stringy s => s -> s -> Bool
sIsPrefixOf a
"#line" a
xs = []
               | Bool
otherwise = [a
xs]

-- Note: `preprocess` is the workhorse of the library. We run the
-- value it returns in `hppIO'` by interleaving interpretation of
-- `HppT` with binds of types providing the `HppCaps`
-- capabilities. When making things concrete, we specialize to
-- `ExceptT`, `StateT`, and `Parser` (note that `Parser` is actually
-- just another `StateT`).

-- | A concreate choice of types to satisfy the constraints of
-- `preprocess`.
dischargeHppCaps :: Monad m
                 => Config -> Env
                 -> Parser (StateT HppState (ExceptT Error m))
                           i
                           (Either (a, Error) b)
                 -> m (Either Error b)
dischargeHppCaps :: Config
-> Env
-> Parser
     (StateT HppState (ExceptT Error m)) i (Either (a, Error) b)
-> m (Either Error b)
dischargeHppCaps Config
cfg Env
env' Parser (StateT HppState (ExceptT Error m)) i (Either (a, Error) b)
m =
  ExceptT Error m b -> m (Either Error b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
    (StateT HppState (ExceptT Error m) b
-> HppState -> ExceptT Error m b
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
       (Parser (StateT HppState (ExceptT Error m)) i b
-> [i] -> StateT HppState (ExceptT Error m) b
forall (m :: * -> *) i o. Monad m => Parser m i o -> [i] -> m o
evalParse (Parser (StateT HppState (ExceptT Error m)) i (Either (a, Error) b)
m Parser (StateT HppState (ExceptT Error m)) i (Either (a, Error) b)
-> (Either (a, Error) b
    -> Parser (StateT HppState (ExceptT Error m)) i b)
-> Parser (StateT HppState (ExceptT Error m)) i b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((a, Error) -> Parser (StateT HppState (ExceptT Error m)) i b)
-> (b -> Parser (StateT HppState (ExceptT Error m)) i b)
-> Either (a, Error) b
-> Parser (StateT HppState (ExceptT Error m)) i b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Error -> Parser (StateT HppState (ExceptT Error m)) i b
forall (m :: * -> *) a. HasError m => Error -> m a
throwError (Error -> Parser (StateT HppState (ExceptT Error m)) i b)
-> ((a, Error) -> Error)
-> (a, Error)
-> Parser (StateT HppState (ExceptT Error m)) i b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Error) -> Error
forall a b. (a, b) -> b
snd) b -> Parser (StateT HppState (ExceptT Error m)) i b
forall (m :: * -> *) a. Monad m => a -> m a
return) [])
       HppState
initialState)
  where initialState :: HppState
initialState = Lens HppState Env -> Env -> HppState -> HppState
forall s a. Lens s a -> a -> s -> s
setL Lens HppState Env
env Env
env' (HppState -> HppState) -> HppState -> HppState
forall a b. (a -> b) -> a -> b
$ Config -> HppState
emptyHppState Config
cfg

-- | General hpp runner against input source file lines; can return an
-- 'Error' value if something goes wrong.
hppIOSink' :: Config -> Env -> ([String] -> IO ()) -> [String]
           -> IO (Either Error [FilePath])
hppIOSink' :: Config
-> Env
-> ([String] -> IO ())
-> [String]
-> IO (Either Error [FilePath])
hppIOSink' Config
cfg Env
env' [String] -> IO ()
snk [String]
src =
  (Either Error (HppResult ()) -> Either Error [FilePath])
-> IO (Either Error (HppResult ())) -> IO (Either Error [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HppResult () -> [FilePath])
-> Either Error (HppResult ()) -> Either Error [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HppResult () -> [FilePath]
forall a. HppResult a -> [FilePath]
hppFilesRead)
  (IO (Either Error (HppResult ())) -> IO (Either Error [FilePath]))
-> (Parser
      (StateT HppState (ExceptT Error IO))
      [TOKEN]
      (Either (FilePath, Error) (HppResult ()))
    -> IO (Either Error (HppResult ())))
-> Parser
     (StateT HppState (ExceptT Error IO))
     [TOKEN]
     (Either (FilePath, Error) (HppResult ()))
-> IO (Either Error [FilePath])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config
-> Env
-> Parser
     (StateT HppState (ExceptT Error IO))
     [TOKEN]
     (Either (FilePath, Error) (HppResult ()))
-> IO (Either Error (HppResult ()))
forall (m :: * -> *) i a b.
Monad m =>
Config
-> Env
-> Parser
     (StateT HppState (ExceptT Error m)) i (Either (a, Error) b)
-> m (Either Error b)
dischargeHppCaps Config
cfg Env
env' (Parser
   (StateT HppState (ExceptT Error IO))
   [TOKEN]
   (Either (FilePath, Error) (HppResult ()))
 -> IO (Either Error [FilePath]))
-> Parser
     (StateT HppState (ExceptT Error IO))
     [TOKEN]
     (Either (FilePath, Error) (HppResult ()))
-> IO (Either Error [FilePath])
forall a b. (a -> b) -> a -> b
$
  (FilePath
 -> Parser (StateT HppState (ExceptT Error IO)) [TOKEN] [String])
-> ([String]
    -> Parser (StateT HppState (ExceptT Error IO)) [TOKEN] ())
-> HppT
     [String] (Parser (StateT HppState (ExceptT Error IO)) [TOKEN]) ()
-> Parser
     (StateT HppState (ExceptT Error IO))
     [TOKEN]
     (Either (FilePath, Error) (HppResult ()))
forall (m :: * -> *) a src.
(MonadIO m, HasHppState m) =>
(FilePath -> m src)
-> (src -> m ())
-> HppT src m a
-> m (Either (FilePath, Error) (HppResult a))
runHpp (IO [String]
-> Parser (StateT HppState (ExceptT Error IO)) [TOKEN] [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String]
 -> Parser (StateT HppState (ExceptT Error IO)) [TOKEN] [String])
-> (FilePath -> IO [String])
-> FilePath
-> Parser (StateT HppState (ExceptT Error IO)) [TOKEN] [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [String]
forall s. Stringy s => FilePath -> IO [s]
readLines) (IO () -> Parser (StateT HppState (ExceptT Error IO)) [TOKEN] ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Parser (StateT HppState (ExceptT Error IO)) [TOKEN] ())
-> ([String] -> IO ())
-> [String]
-> Parser (StateT HppState (ExceptT Error IO)) [TOKEN] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> IO ()
snk) ([String]
-> HppT
     [String] (Parser (StateT HppState (ExceptT Error IO)) [TOKEN]) ()
forall (m :: * -> *).
(Monad m, HasHppState m, HasError m, HasEnv m) =>
[String] -> HppT [String] (Parser m [TOKEN]) ()
preprocess [String]
src)

-- | General hpp runner against input source file lines. Output lines
-- are fed to the caller-supplied sink function. Any errors
-- encountered are thrown with 'error'.
hppIOSink :: Config -> Env -> ([String] -> IO ()) -> [String] -> IO [FilePath]
hppIOSink :: Config -> Env -> ([String] -> IO ()) -> [String] -> IO [FilePath]
hppIOSink Config
cfg Env
env' [String] -> IO ()
snk = Config
-> Env
-> ([String] -> IO ())
-> [String]
-> IO (Either Error [FilePath])
hppIOSink' Config
cfg Env
env' [String] -> IO ()
snk ([String] -> IO (Either Error [FilePath]))
-> (Either Error [FilePath] -> IO [FilePath])
-> [String]
-> IO [FilePath]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Error -> IO [FilePath])
-> ([FilePath] -> IO [FilePath])
-> Either Error [FilePath]
-> IO [FilePath]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Error -> IO [FilePath]
forall e a. Exception e => e -> IO a
throwIO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | hpp runner that returns output lines.
hppIO :: Config -> Env ->  FilePath -> [String]
      -> IO (Either Error ([FilePath], [String]))
hppIO :: Config
-> Env
-> FilePath
-> [String]
-> IO (Either Error ([FilePath], [String]))
hppIO Config
cfg Env
env' FilePath
fileName [String]
src = do
  IORef ([String] -> [String])
r <- ([String] -> [String]) -> IO (IORef ([String] -> [String]))
forall a. a -> IO (IORef a)
newIORef [String] -> [String]
forall a. a -> a
id
  let snk :: [String] -> IO ()
snk [String]
xs = IORef ([String] -> [String])
-> (([String] -> [String]) -> [String] -> [String]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ([String] -> [String])
r (([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String]
xs[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++))
  Config
-> Env
-> ([String] -> IO ())
-> [String]
-> IO (Either Error [FilePath])
hppIOSink' (Config
cfg {curFileNameF :: Identity FilePath
curFileNameF = FilePath -> Identity FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
fileName}) Env
env' [String] -> IO ()
snk [String]
src IO (Either Error [FilePath])
-> (Either Error [FilePath]
    -> IO (Either Error ([FilePath], [String])))
-> IO (Either Error ([FilePath], [String]))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Error
e -> Either Error ([FilePath], [String])
-> IO (Either Error ([FilePath], [String]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> Either Error ([FilePath], [String])
forall a b. a -> Either a b
Left Error
e)
    Right [FilePath]
files -> ([FilePath], [String]) -> Either Error ([FilePath], [String])
forall a b. b -> Either a b
Right (([FilePath], [String]) -> Either Error ([FilePath], [String]))
-> (([String] -> [String]) -> ([FilePath], [String]))
-> ([String] -> [String])
-> Either Error ([FilePath], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath]
files,) ([String] -> ([FilePath], [String]))
-> (([String] -> [String]) -> [String])
-> ([String] -> [String])
-> ([FilePath], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ []) (([String] -> [String]) -> Either Error ([FilePath], [String]))
-> IO ([String] -> [String])
-> IO (Either Error ([FilePath], [String]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef ([String] -> [String]) -> IO ([String] -> [String])
forall a. IORef a -> IO a
readIORef IORef ([String] -> [String])
r