{-# LANGUAGE LambdaCase, OverloadedStrings, ScopedTypeVariables,
ViewPatterns #-}
module Hpp.Directive (directive, macroExpansion) where
import Control.Monad (unless)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except
import Control.Monad.Trans.State.Strict (StateT)
import Hpp.Conditional (dropBranch, takeBranch)
import Hpp.Config (curFileName, curFileNameF)
import Hpp.Env (lookupKey, deleteKey, insertPair)
import Hpp.Expansion (expandLineState)
import Hpp.Expr (evalExpr, parseExpr)
import Hpp.Macro (parseDefinition)
import Hpp.Preprocessing (prepareInput)
import Hpp.StringSig (unquote, toChars)
import Hpp.Tokens (newLine, notImportant, trimUnimportant, detokenize, isImportant, Token(..))
import Hpp.Types
import Hpp.Parser (replace, await, insertInputSegment, takingWhile, droppingWhile, onInputSegment, evalParse, onElements, awaitJust, ParserT, Parser)
import Text.Read (readMaybe)
import Prelude hiding (String)
takeLine :: (Monad m, HasError m, HasHppState m) => Parser m [TOKEN] [TOKEN]
takeLine :: Parser m [TOKEN] [TOKEN]
takeLine = (ParserT m (Input m [[TOKEN]]) TOKEN [TOKEN]
-> Parser m [TOKEN] [TOKEN]
forall (m :: * -> *) i r.
Monad m =>
ParserT m (Input m [[i]]) i r -> Parser m [i] r
onElements (ParserT m (Input m [[TOKEN]]) TOKEN [TOKEN]
-> Parser m [TOKEN] [TOKEN])
-> ParserT m (Input m [[TOKEN]]) TOKEN [TOKEN]
-> Parser m [TOKEN] [TOKEN]
forall a b. (a -> b) -> a -> b
$ do
[TOKEN]
ln <- (TOKEN -> Bool) -> ParserT m (Input m [[TOKEN]]) TOKEN [TOKEN]
forall (m :: * -> *) i src.
Monad m =>
(i -> Bool) -> ParserT m src i [i]
takingWhile (Bool -> Bool
not (Bool -> Bool) -> (TOKEN -> Bool) -> TOKEN -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOKEN -> Bool
forall s. (Eq s, IsString s) => Token s -> Bool
newLine)
TOKEN
eat <- String -> ParserT m (Input m [[TOKEN]]) TOKEN TOKEN
forall (m :: * -> *) src i.
(Monad m, HasError m) =>
String -> ParserT m src i i
awaitJust String
"takeLine"
case TOKEN
eat of
Other ByteString
"\n" -> () -> StateT (Source m (Input m [[TOKEN]]) TOKEN) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
TOKEN
wat -> String -> StateT (Source m (Input m [[TOKEN]]) TOKEN) m ()
forall a. HasCallStack => String -> a
error (String -> StateT (Source m (Input m [[TOKEN]]) TOKEN) m ())
-> String -> StateT (Source m (Input m [[TOKEN]]) TOKEN) m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected newline: "String -> String -> String
forall a. [a] -> [a] -> [a]
++TOKEN -> String
forall a. Show a => a -> String
show TOKEN
watString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" after "String -> String -> String
forall a. [a] -> [a] -> [a]
++[TOKEN] -> String
forall a. Show a => a -> String
show [TOKEN]
ln
[TOKEN] -> ParserT m (Input m [[TOKEN]]) TOKEN [TOKEN]
forall (m :: * -> *) a. Monad m => a -> m a
return [TOKEN]
ln)
Parser m [TOKEN] [TOKEN]
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> Parser m [TOKEN] [TOKEN]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Lens HppState LineNum
lineNum Lens HppState LineNum
-> (LineNum -> LineNum)
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) a.
(HasHppState m, Monad m) =>
Lens HppState a -> (a -> a) -> m ()
%= (LineNum -> LineNum -> LineNum
forall a. Num a => a -> a -> a
+LineNum
1))
dropLine :: (Monad m, HasError m, HasHppState m) => Parser m [TOKEN] ()
dropLine :: Parser m [TOKEN] ()
dropLine = do ParserT m (Input m [[TOKEN]]) TOKEN () -> Parser m [TOKEN] ()
forall (m :: * -> *) i r.
Monad m =>
ParserT m (Input m [[i]]) i r -> Parser m [i] r
onElements (ParserT m (Input m [[TOKEN]]) TOKEN () -> Parser m [TOKEN] ())
-> ParserT m (Input m [[TOKEN]]) TOKEN () -> Parser m [TOKEN] ()
forall a b. (a -> b) -> a -> b
$ do
(TOKEN -> Bool) -> ParserT m (Input m [[TOKEN]]) TOKEN ()
forall (m :: * -> *) i src.
Monad m =>
(i -> Bool) -> ParserT m src i ()
droppingWhile (Bool -> Bool
not (Bool -> Bool) -> (TOKEN -> Bool) -> TOKEN -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOKEN -> Bool
forall s. (Eq s, IsString s) => Token s -> Bool
newLine)
TOKEN
eat <- String -> ParserT m (Input m [[TOKEN]]) TOKEN TOKEN
forall (m :: * -> *) src i.
(Monad m, HasError m) =>
String -> ParserT m src i i
awaitJust String
"dropLine"
case TOKEN
eat of
Other ByteString
"\n" -> () -> ParserT m (Input m [[TOKEN]]) TOKEN ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
TOKEN
wat -> String -> ParserT m (Input m [[TOKEN]]) TOKEN ()
forall a. HasCallStack => String -> a
error (String -> ParserT m (Input m [[TOKEN]]) TOKEN ())
-> String -> ParserT m (Input m [[TOKEN]]) TOKEN ()
forall a b. (a -> b) -> a -> b
$ String
"Expected dropped newline: "String -> String -> String
forall a. [a] -> [a] -> [a]
++TOKEN -> String
forall a. Show a => a -> String
show TOKEN
wat
Lens HppState LineNum
lineNum Lens HppState LineNum
-> (LineNum -> LineNum) -> Parser m [TOKEN] ()
forall (m :: * -> *) a.
(HasHppState m, Monad m) =>
Lens HppState a -> (a -> a) -> m ()
%= (LineNum -> LineNum -> LineNum
forall a. Num a => a -> a -> a
+LineNum
1)
droppingSpaces ::(Monad m) => ParserT m src TOKEN ()
droppingSpaces :: ParserT m src TOKEN ()
droppingSpaces = (TOKEN -> Bool) -> ParserT m src TOKEN ()
forall (m :: * -> *) i src.
Monad m =>
(i -> Bool) -> ParserT m src i ()
droppingWhile TOKEN -> Bool
forall s. Token s -> Bool
notImportant
streamNewFile :: (Monad m, HasHppState m)
=> FilePath -> [[TOKEN]] -> Parser m [TOKEN] ()
streamNewFile :: String -> [[TOKEN]] -> Parser m [TOKEN] ()
streamNewFile String
fp [[TOKEN]]
s =
do (Config
oldCfg,LineNum
oldLine) <- do HppState
st <- StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m HppState
forall (m :: * -> *). HasHppState m => m HppState
getState
let cfg :: Config
cfg = HppState -> Config
hppConfig HppState
st
cfg' :: Config
cfg' = Config
cfg { curFileNameF :: Identity String
curFileNameF = String -> Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
fp }
ln :: LineNum
ln = HppState -> LineNum
hppLineNum HppState
st
HppState -> Parser m [TOKEN] ()
forall (m :: * -> *). HasHppState m => HppState -> m ()
setState (HppState
st {hppConfig :: Config
hppConfig = Config
cfg', hppLineNum :: LineNum
hppLineNum = LineNum
1})
(Config, LineNum)
-> StateT
(Source m (Input m [[TOKEN]]) [TOKEN]) m (Config, LineNum)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
cfg, LineNum
ln)
[[TOKEN]] -> m () -> Parser m [TOKEN] ()
forall (m :: * -> *) src i.
Monad m =>
src -> m () -> ParserT m (Input m src) i ()
insertInputSegment
[[TOKEN]]
s (m HppState
forall (m :: * -> *). HasHppState m => m HppState
getState m HppState -> (HppState -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HppState -> m ()
forall (m :: * -> *). HasHppState m => HppState -> m ()
setState (HppState -> m ()) -> (HppState -> HppState) -> HppState -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens HppState LineNum -> LineNum -> HppState -> HppState
forall s a. Lens s a -> a -> s -> s
setL Lens HppState LineNum
lineNum LineNum
oldLine (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
oldCfg)
directive :: forall m. (Monad m, HasError m, HasHppState m, HasEnv m)
=> HppT [String] (Parser m [TOKEN]) Bool
directive :: HppT [ByteString] (Parser m [TOKEN]) Bool
directive = StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m TOKEN
-> HppT [ByteString] (Parser m [TOKEN]) TOKEN
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParserT m (Input m [[TOKEN]]) TOKEN TOKEN
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m TOKEN
forall (m :: * -> *) i r.
Monad m =>
ParserT m (Input m [[i]]) i r -> Parser m [i] r
onElements (String -> ParserT m (Input m [[TOKEN]]) TOKEN TOKEN
forall (m :: * -> *) src i.
(Monad m, HasError m) =>
String -> ParserT m src i i
awaitJust String
"directive")) HppT [ByteString] (Parser m [TOKEN]) TOKEN
-> (TOKEN -> HppT [ByteString] (Parser m [TOKEN]) Bool)
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TOKEN -> HppT [ByteString] (Parser m [TOKEN]) Bool
aux
where aux :: TOKEN -> HppT [String] (Parser m [TOKEN]) Bool
aux :: TOKEN -> HppT [ByteString] (Parser m [TOKEN]) Bool
aux (Important ByteString
cmd) = case ByteString
cmd of
ByteString
"pragma" -> Bool
True Bool
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m) =>
Parser m [TOKEN] ()
dropLine
ByteString
"define" -> Bool
True Bool
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ())
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall a b. (a -> b) -> a -> b
$ ([TOKEN] -> Maybe (ByteString, Macro))
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> StateT
(Source m (Input m [[TOKEN]]) [TOKEN])
m
(Maybe (ByteString, Macro))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TOKEN] -> Maybe (ByteString, Macro)
parseDefinition StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m) =>
Parser m [TOKEN] [TOKEN]
takeLine StateT
(Source m (Input m [[TOKEN]]) [TOKEN])
m
(Maybe (ByteString, Macro))
-> (Maybe (ByteString, Macro)
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ())
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (ByteString, Macro)
Nothing -> Lens HppState LineNum
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m LineNum
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState LineNum
lineNum StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m LineNum
-> (LineNum -> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ())
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Error -> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) a. HasError m => Error -> m a
throwError (Error -> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ())
-> (LineNum -> Error)
-> LineNum
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineNum -> Error
BadMacroDefinition
Just (ByteString, Macro)
def -> Lens HppState Env
env Lens HppState Env
-> (Env -> Env)
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) a.
(HasHppState m, Monad m) =>
Lens HppState a -> (a -> a) -> m ()
%= (ByteString, Macro) -> Env -> Env
forall a.
(ByteString, a) -> HashMap ByteString a -> HashMap ByteString a
insertPair (ByteString, Macro)
def)
ByteString
"undef" -> do ByteString
name <- StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ByteString
-> HppT [ByteString] (Parser m [TOKEN]) ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ByteString
-> HppT [ByteString] (Parser m [TOKEN]) ByteString)
-> (ParserT m (Input m [[TOKEN]]) TOKEN ByteString
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ByteString)
-> ParserT m (Input m [[TOKEN]]) TOKEN ByteString
-> HppT [ByteString] (Parser m [TOKEN]) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT m (Input m [[TOKEN]]) TOKEN ByteString
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ByteString
forall (m :: * -> *) i r.
Monad m =>
ParserT m (Input m [[i]]) i r -> Parser m [i] r
onElements (ParserT m (Input m [[TOKEN]]) TOKEN ByteString
-> HppT [ByteString] (Parser m [TOKEN]) ByteString)
-> ParserT m (Input m [[TOKEN]]) TOKEN ByteString
-> HppT [ByteString] (Parser m [TOKEN]) ByteString
forall a b. (a -> b) -> a -> b
$ do
(TOKEN -> Bool) -> ParserT m (Input m [[TOKEN]]) TOKEN ()
forall (m :: * -> *) i src.
Monad m =>
(i -> Bool) -> ParserT m src i ()
droppingWhile (Bool -> Bool
not (Bool -> Bool) -> (TOKEN -> Bool) -> TOKEN -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOKEN -> Bool
forall s. Token s -> Bool
isImportant)
ByteString
name <- String -> ParserT m (Input m [[TOKEN]]) TOKEN TOKEN
forall (m :: * -> *) src i.
(Monad m, HasError m) =>
String -> ParserT m src i i
awaitJust String
"undef" ParserT m (Input m [[TOKEN]]) TOKEN TOKEN
-> (TOKEN -> ParserT m (Input m [[TOKEN]]) TOKEN ByteString)
-> ParserT m (Input m [[TOKEN]]) TOKEN ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Important ByteString
n -> ByteString -> ParserT m (Input m [[TOKEN]]) TOKEN ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
n
TOKEN
_ -> String -> ParserT m (Input m [[TOKEN]]) TOKEN ByteString
forall a. HasCallStack => String -> a
error String
"undef directive got Other token"
ByteString -> ParserT m (Input m [[TOKEN]]) TOKEN ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
name
StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m) =>
Parser m [TOKEN] ()
dropLine
Lens HppState Env
env Lens HppState Env
-> (Env -> Env) -> HppT [ByteString] (Parser m [TOKEN]) ()
forall (m :: * -> *) a.
(HasHppState m, Monad m) =>
Lens HppState a -> (a -> a) -> m ()
%= ByteString -> Env -> Env
forall a.
ByteString -> HashMap ByteString a -> HashMap ByteString a
deleteKey ByteString
name
Bool -> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
ByteString
"include" -> Bool
True Bool
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (LineNum
-> String -> HppT [ByteString] (Parser m [TOKEN]) [ByteString])
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall src.
(LineNum -> String -> HppT src (Parser m [TOKEN]) [ByteString])
-> HppT src (Parser m [TOKEN]) ()
includeAux LineNum
-> String -> HppT [ByteString] (Parser m [TOKEN]) [ByteString]
forall (m :: * -> *) src.
Monad m =>
LineNum -> String -> HppT src m src
hppReadFile
ByteString
"include_next" -> Bool
True Bool
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (LineNum
-> String -> HppT [ByteString] (Parser m [TOKEN]) [ByteString])
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall src.
(LineNum -> String -> HppT src (Parser m [TOKEN]) [ByteString])
-> HppT src (Parser m [TOKEN]) ()
includeAux LineNum
-> String -> HppT [ByteString] (Parser m [TOKEN]) [ByteString]
forall (m :: * -> *) src.
Monad m =>
LineNum -> String -> HppT src m src
hppReadNext
ByteString
"line" -> do StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParserT m (Input m [[TOKEN]]) TOKEN ()
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) i r.
Monad m =>
ParserT m (Input m [[i]]) i r -> Parser m [i] r
onElements ParserT m (Input m [[TOKEN]]) TOKEN ()
forall (m :: * -> *) src. Monad m => ParserT m src TOKEN ()
droppingSpaces)
[TOKEN]
toks <- StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) [TOKEN]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([TOKEN] -> [TOKEN]
forall a. [a] -> [a]
init ([TOKEN] -> [TOKEN])
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *).
(Monad m, HasHppState m, HasEnv m, HasError m) =>
Parser m [TOKEN] [TOKEN]
expandLineState)
case [TOKEN]
toks of
Important (ByteString -> String
forall s. Stringy s => s -> String
toChars -> String
n):[TOKEN]
optFile ->
case String -> Maybe LineNum
forall a. Read a => String -> Maybe a
readMaybe String
n of
Maybe LineNum
Nothing -> Lens HppState LineNum
-> HppT [ByteString] (Parser m [TOKEN]) LineNum
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState LineNum
lineNum HppT [ByteString] (Parser m [TOKEN]) LineNum
-> (LineNum -> HppT [ByteString] (Parser m [TOKEN]) Bool)
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Error -> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (m :: * -> *) a. HasError m => Error -> m a
throwError (Error -> HppT [ByteString] (Parser m [TOKEN]) Bool)
-> (LineNum -> Error)
-> LineNum
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LineNum -> String -> Error) -> String -> LineNum -> Error
forall a b c. (a -> b -> c) -> b -> a -> c
flip LineNum -> String -> Error
BadLineArgument String
n
Just LineNum
ln' -> do
Bool
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TOKEN] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TOKEN]
optFile) (HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) ())
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall a b. (a -> b) -> a -> b
$ do
let fn :: String
fn = ByteString -> String
forall s. Stringy s => s -> String
toChars (ByteString -> String)
-> ([TOKEN] -> ByteString) -> [TOKEN] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall s. Stringy s => s -> s
unquote (ByteString -> ByteString)
-> ([TOKEN] -> ByteString) -> [TOKEN] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TOKEN] -> ByteString
forall s. Monoid s => [Token s] -> s
detokenize
([TOKEN] -> ByteString)
-> ([TOKEN] -> [TOKEN]) -> [TOKEN] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TOKEN -> Bool) -> [TOKEN] -> [TOKEN]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (TOKEN -> Bool) -> TOKEN -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOKEN -> Bool
forall s. Token s -> Bool
isImportant)
([TOKEN] -> String) -> [TOKEN] -> String
forall a b. (a -> b) -> a -> b
$ [TOKEN]
optFile
Lens HppState Config
config Lens HppState Config
-> (Config -> Config) -> HppT [ByteString] (Parser m [TOKEN]) ()
forall (m :: * -> *) a.
(HasHppState m, Monad m) =>
Lens HppState a -> (a -> a) -> m ()
%= (\Config
cfg -> Config
cfg { curFileNameF :: Identity String
curFileNameF = String -> Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
fn })
Lens HppState LineNum
lineNum Lens HppState LineNum
-> LineNum -> HppT [ByteString] (Parser m [TOKEN]) ()
forall (m :: * -> *) a.
(HasHppState m, Monad m) =>
Lens HppState a -> a -> m ()
.= LineNum
ln'
Bool -> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
[TOKEN]
_ -> Lens HppState LineNum
-> HppT [ByteString] (Parser m [TOKEN]) LineNum
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState LineNum
lineNum HppT [ByteString] (Parser m [TOKEN]) LineNum
-> (LineNum -> HppT [ByteString] (Parser m [TOKEN]) Bool)
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Error -> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (m :: * -> *) a. HasError m => Error -> m a
throwError
(Error -> HppT [ByteString] (Parser m [TOKEN]) Bool)
-> (LineNum -> Error)
-> LineNum
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LineNum -> String -> Error) -> String -> LineNum -> Error
forall a b c. (a -> b -> c) -> b -> a -> c
flip LineNum -> String -> Error
BadLineArgument (ByteString -> String
forall s. Stringy s => s -> String
toChars ([TOKEN] -> ByteString
forall s. Monoid s => [Token s] -> s
detokenize [TOKEN]
toks))
ByteString
"ifdef" ->
do [TOKEN]
toks <- StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) [TOKEN]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParserT m (Input m [[TOKEN]]) TOKEN ()
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) i r.
Monad m =>
ParserT m (Input m [[i]]) i r -> Parser m [i] r
onElements ParserT m (Input m [[TOKEN]]) TOKEN ()
forall (m :: * -> *) src. Monad m => ParserT m src TOKEN ()
droppingSpaces StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m) =>
Parser m [TOKEN] [TOKEN]
takeLine)
LineNum
ln <- Lens HppState LineNum
-> HppT [ByteString] (Parser m [TOKEN]) LineNum
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState LineNum
lineNum
case (TOKEN -> Bool) -> [TOKEN] -> [TOKEN]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile TOKEN -> Bool
forall s. Token s -> Bool
isImportant [TOKEN]
toks of
[Important ByteString
t] ->
ByteString -> HppT [ByteString] (Parser m [TOKEN]) (Maybe Macro)
forall (m :: * -> *).
(HasEnv m, Monad m) =>
ByteString -> m (Maybe Macro)
lookupMacro ByteString
t HppT [ByteString] (Parser m [TOKEN]) (Maybe Macro)
-> (Maybe Macro -> HppT [ByteString] (Parser m [TOKEN]) ())
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Macro
Nothing ->
StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *).
(HasError m, HasHppState m, Monad m) =>
Parser m [TOKEN] ()
dropBranch
Just Macro
_ ->
StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (([[TOKEN]] -> [[TOKEN]])
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) src i.
Monad m =>
(src -> src) -> ParserT m (Input m src) i ()
onInputSegment (LineNum -> [[TOKEN]] -> [[TOKEN]]
takeBranch LineNum
ln))
[TOKEN]
_ -> Error -> HppT [ByteString] (Parser m [TOKEN]) ()
forall (m :: * -> *) a. HasError m => Error -> m a
throwError (Error -> HppT [ByteString] (Parser m [TOKEN]) ())
-> (String -> Error)
-> String
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineNum -> String -> Error
UnknownCommand LineNum
ln (String -> HppT [ByteString] (Parser m [TOKEN]) ())
-> String -> HppT [ByteString] (Parser m [TOKEN]) ()
forall a b. (a -> b) -> a -> b
$
String
"ifdef "String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall s. Stringy s => s -> String
toChars ([TOKEN] -> ByteString
forall s. Monoid s => [Token s] -> s
detokenize [TOKEN]
toks)
Bool -> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
ByteString
"ifndef" ->
do [TOKEN]
toks <- StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) [TOKEN]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParserT m (Input m [[TOKEN]]) TOKEN ()
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) i r.
Monad m =>
ParserT m (Input m [[i]]) i r -> Parser m [i] r
onElements ParserT m (Input m [[TOKEN]]) TOKEN ()
forall (m :: * -> *) src. Monad m => ParserT m src TOKEN ()
droppingSpaces StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m) =>
Parser m [TOKEN] [TOKEN]
takeLine)
LineNum
ln <- Lens HppState LineNum
-> HppT [ByteString] (Parser m [TOKEN]) LineNum
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState LineNum
lineNum
case (TOKEN -> Bool) -> [TOKEN] -> [TOKEN]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile TOKEN -> Bool
forall s. Token s -> Bool
isImportant [TOKEN]
toks of
[Important ByteString
t] ->
ByteString -> HppT [ByteString] (Parser m [TOKEN]) (Maybe Macro)
forall (m :: * -> *).
(HasEnv m, Monad m) =>
ByteString -> m (Maybe Macro)
lookupMacro ByteString
t HppT [ByteString] (Parser m [TOKEN]) (Maybe Macro)
-> (Maybe Macro -> HppT [ByteString] (Parser m [TOKEN]) ())
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Macro
Nothing -> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (([[TOKEN]] -> [[TOKEN]])
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) src i.
Monad m =>
(src -> src) -> ParserT m (Input m src) i ()
onInputSegment (LineNum -> [[TOKEN]] -> [[TOKEN]]
takeBranch LineNum
ln))
Just Macro
_ -> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *).
(HasError m, HasHppState m, Monad m) =>
Parser m [TOKEN] ()
dropBranch
[TOKEN]
_ -> Error -> HppT [ByteString] (Parser m [TOKEN]) ()
forall (m :: * -> *) a. HasError m => Error -> m a
throwError (Error -> HppT [ByteString] (Parser m [TOKEN]) ())
-> (String -> Error)
-> String
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineNum -> String -> Error
UnknownCommand LineNum
ln (String -> HppT [ByteString] (Parser m [TOKEN]) ())
-> String -> HppT [ByteString] (Parser m [TOKEN]) ()
forall a b. (a -> b) -> a -> b
$
String
"ifndef "String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall s. Stringy s => s -> String
toChars ([TOKEN] -> ByteString
forall s. Monoid s => [Token s] -> s
detokenize [TOKEN]
toks)
Bool -> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
ByteString
"else" -> Bool
True Bool
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m) =>
Parser m [TOKEN] ()
dropLine
ByteString
"if" -> Bool
True Bool
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ HppT [ByteString] (Parser m [TOKEN]) ()
ifAux
ByteString
"elif" -> Bool
True Bool
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ HppT [ByteString] (Parser m [TOKEN]) ()
ifAux
ByteString
"endif" -> Bool
True Bool
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m) =>
Parser m [TOKEN] ()
dropLine
ByteString
"error" -> do [TOKEN]
toks <- StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) [TOKEN]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParserT m (Input m [[TOKEN]]) TOKEN ()
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) i r.
Monad m =>
ParserT m (Input m [[i]]) i r -> Parser m [i] r
onElements ParserT m (Input m [[TOKEN]]) TOKEN ()
forall (m :: * -> *) src. Monad m => ParserT m src TOKEN ()
droppingSpaces StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m) =>
Parser m [TOKEN] [TOKEN]
takeLine)
LineNum
ln <- LineNum -> LineNum -> LineNum
forall a. Num a => a -> a -> a
subtract LineNum
1 (LineNum -> LineNum)
-> HppT [ByteString] (Parser m [TOKEN]) LineNum
-> HppT [ByteString] (Parser m [TOKEN]) LineNum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lens HppState LineNum
-> HppT [ByteString] (Parser m [TOKEN]) LineNum
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState LineNum
lineNum
String
curFile <- Config -> String
curFileName (Config -> String)
-> HppT [ByteString] (Parser m [TOKEN]) Config
-> HppT [ByteString] (Parser m [TOKEN]) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lens HppState Config -> HppT [ByteString] (Parser m [TOKEN]) Config
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState Config
config
let tokStr :: String
tokStr = ByteString -> String
forall s. Stringy s => s -> String
toChars ([TOKEN] -> ByteString
forall s. Monoid s => [Token s] -> s
detokenize [TOKEN]
toks)
Error -> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (m :: * -> *) a. HasError m => Error -> m a
throwError (Error -> HppT [ByteString] (Parser m [TOKEN]) Bool)
-> Error -> HppT [ByteString] (Parser m [TOKEN]) Bool
forall a b. (a -> b) -> a -> b
$ LineNum -> String -> Error
UserError LineNum
ln (String
tokStrString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" ("String -> String -> String
forall a. [a] -> [a] -> [a]
++String
curFileString -> String -> String
forall a. [a] -> [a] -> [a]
++String
")")
ByteString
"warning" -> Bool
True Bool
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m) =>
Parser m [TOKEN] ()
dropLine
ByteString
t -> do [TOKEN]
toks <- StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) [TOKEN]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m) =>
Parser m [TOKEN] [TOKEN]
takeLine
LineNum
ln <- LineNum -> LineNum -> LineNum
forall a. Num a => a -> a -> a
subtract LineNum
1 (LineNum -> LineNum)
-> HppT [ByteString] (Parser m [TOKEN]) LineNum
-> HppT [ByteString] (Parser m [TOKEN]) LineNum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lens HppState LineNum
-> HppT [ByteString] (Parser m [TOKEN]) LineNum
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState LineNum
lineNum
Error -> HppT [ByteString] (Parser m [TOKEN]) Bool
forall (m :: * -> *) a. HasError m => Error -> m a
throwError (Error -> HppT [ByteString] (Parser m [TOKEN]) Bool)
-> Error -> HppT [ByteString] (Parser m [TOKEN]) Bool
forall a b. (a -> b) -> a -> b
$ LineNum -> String -> Error
UnknownCommand LineNum
ln
(ByteString -> String
forall s. Stringy s => s -> String
toChars ([TOKEN] -> ByteString
forall s. Monoid s => [Token s] -> s
detokenize (ByteString -> TOKEN
forall s. s -> Token s
Important ByteString
tTOKEN -> [TOKEN] -> [TOKEN]
forall a. a -> [a] -> [a]
:[TOKEN]
toks)))
aux TOKEN
_ = String -> HppT [ByteString] (Parser m [TOKEN]) Bool
forall a. HasCallStack => String -> a
error String
"Impossible unimportant directive"
includeAux :: (LineNum -> FilePath -> HppT src (Parser m [TOKEN]) [String])
-> HppT src (Parser m [TOKEN]) ()
includeAux :: (LineNum -> String -> HppT src (Parser m [TOKEN]) [ByteString])
-> HppT src (Parser m [TOKEN]) ()
includeAux LineNum -> String -> HppT src (Parser m [TOKEN]) [ByteString]
readFun =
do String
fileName <- StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m String
-> HppT src (Parser m [TOKEN]) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ByteString -> String
forall s. Stringy s => s -> String
toChars (ByteString -> String)
-> ([TOKEN] -> ByteString) -> [TOKEN] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TOKEN] -> ByteString
forall s. Monoid s => [Token s] -> s
detokenize ([TOKEN] -> ByteString)
-> ([TOKEN] -> [TOKEN]) -> [TOKEN] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TOKEN] -> [TOKEN]
forall s. [Token s] -> [Token s]
trimUnimportant ([TOKEN] -> [TOKEN]) -> ([TOKEN] -> [TOKEN]) -> [TOKEN] -> [TOKEN]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TOKEN] -> [TOKEN]
forall a. [a] -> [a]
init
([TOKEN] -> String)
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *).
(Monad m, HasHppState m, HasEnv m, HasError m) =>
Parser m [TOKEN] [TOKEN]
expandLineState)
LineNum
ln <- Lens HppState LineNum -> HppT src (Parser m [TOKEN]) LineNum
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState LineNum
lineNum
[[TOKEN]]
src <- HppT src (Parser m [TOKEN]) ([ByteString] -> [[TOKEN]])
forall (m :: * -> *).
(Monad m, HasHppState m) =>
m ([ByteString] -> [[TOKEN]])
prepareInput HppT src (Parser m [TOKEN]) ([ByteString] -> [[TOKEN]])
-> HppT src (Parser m [TOKEN]) [ByteString]
-> HppT src (Parser m [TOKEN]) [[TOKEN]]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LineNum -> String -> HppT src (Parser m [TOKEN]) [ByteString]
readFun LineNum
ln String
fileName
Lens HppState LineNum
lineNum Lens HppState LineNum -> LineNum -> HppT src (Parser m [TOKEN]) ()
forall (m :: * -> *) a.
(HasHppState m, Monad m) =>
Lens HppState a -> a -> m ()
.= LineNum
lnLineNum -> LineNum -> LineNum
forall a. Num a => a -> a -> a
+LineNum
1
StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT src (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String
-> [[TOKEN]] -> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *).
(Monad m, HasHppState m) =>
String -> [[TOKEN]] -> Parser m [TOKEN] ()
streamNewFile (String -> String
forall s. Stringy s => s -> s
unquote String
fileName) [[TOKEN]]
src)
ifAux :: HppT [ByteString] (Parser m [TOKEN]) ()
ifAux =
do [TOKEN]
toks <- StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) [TOKEN]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParserT m (Input m [[TOKEN]]) TOKEN ()
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) i r.
Monad m =>
ParserT m (Input m [[i]]) i r -> Parser m [i] r
onElements ParserT m (Input m [[TOKEN]]) TOKEN ()
forall (m :: * -> *) src. Monad m => ParserT m src TOKEN ()
droppingSpaces StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m) =>
Parser m [TOKEN] [TOKEN]
takeLine)
Env
e <- Lens HppState Env -> HppT [ByteString] (Parser m [TOKEN]) Env
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState Env
env
LineNum
ln <- Lens HppState LineNum
-> HppT [ByteString] (Parser m [TOKEN]) LineNum
forall (m :: * -> *) a.
(HasHppState m, Functor m) =>
Lens HppState a -> m a
use Lens HppState LineNum
lineNum
Lens HppState LineNum
lineNum Lens HppState LineNum
-> LineNum -> HppT [ByteString] (Parser m [TOKEN]) ()
forall (m :: * -> *) a.
(HasHppState m, Monad m) =>
Lens HppState a -> a -> m ()
.= LineNum
ln LineNum -> LineNum -> LineNum
forall a. Num a => a -> a -> a
- LineNum
1
[TOKEN]
ex <- StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) [TOKEN]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [TOKEN]
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> [[TOKEN]] -> m [TOKEN]
forall (m :: * -> *) i o. Monad m => Parser m i o -> [i] -> m o
evalParse StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *).
(Monad m, HasHppState m, HasEnv m, HasError m) =>
Parser m [TOKEN] [TOKEN]
expandLineState [Env -> [TOKEN] -> [TOKEN]
squashDefines Env
e [TOKEN]
toks]))
let res :: Maybe LineNum
res = Expr -> LineNum
evalExpr (Expr -> LineNum) -> Maybe Expr -> Maybe LineNum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token String] -> Maybe Expr
parseExpr ((TOKEN -> Token String) -> [TOKEN] -> [Token String]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> String) -> TOKEN -> Token String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
forall s. Stringy s => s -> String
toChars) [TOKEN]
ex)
Lens HppState LineNum
lineNum Lens HppState LineNum
-> LineNum -> HppT [ByteString] (Parser m [TOKEN]) ()
forall (m :: * -> *) a.
(HasHppState m, Monad m) =>
Lens HppState a -> a -> m ()
.= LineNum
ln
if Bool -> (LineNum -> Bool) -> Maybe LineNum -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (LineNum -> LineNum -> Bool
forall a. Eq a => a -> a -> Bool
/= LineNum
0) Maybe LineNum
res
then StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (([[TOKEN]] -> [[TOKEN]])
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *) src i.
Monad m =>
(src -> src) -> ParserT m (Input m src) i ()
onInputSegment (LineNum -> [[TOKEN]] -> [[TOKEN]]
takeBranch LineNum
ln))
else StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (Parser m [TOKEN]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
forall (m :: * -> *).
(HasError m, HasHppState m, Monad m) =>
Parser m [TOKEN] ()
dropBranch
{-# SPECIALIZE directive ::
HppT [String] (Parser (StateT HppState (ExceptT Error IO)) [TOKEN]) Bool #-}
squashDefines :: Env -> [TOKEN] -> [TOKEN]
squashDefines :: Env -> [TOKEN] -> [TOKEN]
squashDefines Env
_ [] = []
squashDefines Env
env' (Important ByteString
"defined" : [TOKEN]
ts) = [TOKEN] -> [TOKEN]
go [TOKEN]
ts
where go :: [TOKEN] -> [TOKEN]
go (t :: TOKEN
t@(Other ByteString
_) : [TOKEN]
ts') = TOKEN
t TOKEN -> [TOKEN] -> [TOKEN]
forall a. a -> [a] -> [a]
: [TOKEN] -> [TOKEN]
go [TOKEN]
ts'
go (t :: TOKEN
t@(Important ByteString
"(") : [TOKEN]
ts') = TOKEN
t TOKEN -> [TOKEN] -> [TOKEN]
forall a. a -> [a] -> [a]
: [TOKEN] -> [TOKEN]
go [TOKEN]
ts'
go (Important ByteString
t : [TOKEN]
ts') =
case ByteString -> Env -> Maybe Macro
forall a. ByteString -> HashMap ByteString a -> Maybe a
lookupKey ByteString
t Env
env' of
Maybe Macro
Nothing -> ByteString -> TOKEN
forall s. s -> Token s
Important ByteString
"0" TOKEN -> [TOKEN] -> [TOKEN]
forall a. a -> [a] -> [a]
: Env -> [TOKEN] -> [TOKEN]
squashDefines Env
env' [TOKEN]
ts'
Just Macro
_ -> ByteString -> TOKEN
forall s. s -> Token s
Important ByteString
"1" TOKEN -> [TOKEN] -> [TOKEN]
forall a. a -> [a] -> [a]
: Env -> [TOKEN] -> [TOKEN]
squashDefines Env
env' [TOKEN]
ts'
go [] = []
squashDefines Env
env' (TOKEN
t : [TOKEN]
ts) = TOKEN
t TOKEN -> [TOKEN] -> [TOKEN]
forall a. a -> [a] -> [a]
: Env -> [TOKEN] -> [TOKEN]
squashDefines Env
env' [TOKEN]
ts
macroExpansion :: (Monad m, HasHppState m, HasError m, HasEnv m)
=> HppT [String] (Parser m [TOKEN]) (Maybe [TOKEN])
macroExpansion :: HppT [ByteString] (Parser m [TOKEN]) (Maybe [TOKEN])
macroExpansion = do
StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m (Maybe [TOKEN])
-> HppT [ByteString] (Parser m [TOKEN]) (Maybe [TOKEN])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m (Maybe [TOKEN])
forall (m :: * -> *) src i. Monad m => ParserT m src i (Maybe i)
await HppT [ByteString] (Parser m [TOKEN]) (Maybe [TOKEN])
-> (Maybe [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) (Maybe [TOKEN]))
-> HppT [ByteString] (Parser m [TOKEN]) (Maybe [TOKEN])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe [TOKEN]
Nothing -> Maybe [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) (Maybe [TOKEN])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [TOKEN]
forall a. Maybe a
Nothing
Just [TOKEN]
ln ->
case (TOKEN -> Bool) -> [TOKEN] -> [TOKEN]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile TOKEN -> Bool
forall s. Token s -> Bool
notImportant [TOKEN]
ln of
[] -> [TOKEN] -> Maybe [TOKEN]
forall a. a -> Maybe a
Just [TOKEN]
ln Maybe [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) (Maybe [TOKEN])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Lens HppState LineNum
lineNum Lens HppState LineNum
-> (LineNum -> LineNum) -> HppT [ByteString] (Parser m [TOKEN]) ()
forall (m :: * -> *) a.
(HasHppState m, Monad m) =>
Lens HppState a -> (a -> a) -> m ()
%= (LineNum -> LineNum -> LineNum
forall a. Num a => a -> a -> a
+LineNum
1))
Important ByteString
"#":[TOKEN]
rst -> do StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> HppT [ByteString] (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 ()
replace ((TOKEN -> Bool) -> [TOKEN] -> [TOKEN]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile TOKEN -> Bool
forall s. Token s -> Bool
notImportant [TOKEN]
rst))
Bool
processed <- HppT [ByteString] (Parser m [TOKEN]) Bool
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m, HasEnv m) =>
HppT [ByteString] (Parser m [TOKEN]) Bool
directive
if Bool
processed
then HppT [ByteString] (Parser m [TOKEN]) (Maybe [TOKEN])
forall (m :: * -> *).
(Monad m, HasHppState m, HasError m, HasEnv m) =>
HppT [ByteString] (Parser m [TOKEN]) (Maybe [TOKEN])
macroExpansion
else [TOKEN] -> Maybe [TOKEN]
forall a. a -> Maybe a
Just [TOKEN]
ln Maybe [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) (Maybe [TOKEN])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> HppT [ByteString] (Parser m [TOKEN]) [TOKEN]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *).
(Monad m, HasError m, HasHppState m) =>
Parser m [TOKEN] [TOKEN]
takeLine
[TOKEN]
_ -> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m (Maybe [TOKEN])
-> HppT [ByteString] (Parser m [TOKEN]) (Maybe [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 ()
replace [TOKEN]
ln StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m ()
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m (Maybe [TOKEN])
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m (Maybe [TOKEN])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([TOKEN] -> Maybe [TOKEN]
forall a. a -> Maybe a
Just ([TOKEN] -> Maybe [TOKEN])
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m (Maybe [TOKEN])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [TOKEN]
forall (m :: * -> *).
(Monad m, HasHppState m, HasEnv m, HasError m) =>
Parser m [TOKEN] [TOKEN]
expandLineState)) HppT [ByteString] (Parser m [TOKEN]) (Maybe [TOKEN])
-> HppT [ByteString] (Parser m [TOKEN]) ()
-> HppT [ByteString] (Parser m [TOKEN]) (Maybe [TOKEN])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Lens HppState LineNum
lineNum Lens HppState LineNum
-> (LineNum -> LineNum) -> HppT [ByteString] (Parser m [TOKEN]) ()
forall (m :: * -> *) a.
(HasHppState m, Monad m) =>
Lens HppState a -> (a -> a) -> m ()
%= (LineNum -> LineNum -> LineNum
forall a. Num a => a -> a -> a
+LineNum
1))