{-# LANGUAGE BangPatterns, ConstraintKinds, LambdaCase, OverloadedStrings,
ScopedTypeVariables, TupleSections, ViewPatterns #-}
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
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
data HppResult a = HppResult { HppResult a -> [FilePath]
hppFilesRead :: [FilePath]
, HppResult a -> a
hppResult :: a }
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)) #-}
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
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]
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
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)
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
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