{-# LANGUAGE LambdaCase, OverloadedStrings, ScopedTypeVariables,
             ViewPatterns #-}
-- | Implement the logic of CPP directives (commands prefixed with an
-- octothorpe).
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)

-- | Returns everything up to the next newline. The newline character
-- itself is consumed.
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" -- Eat the newline character
              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" -- Eat the newline character
                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

-- | Run a Stream with a configuration for a new file.
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
                            -- NOTE: We should *NOT* use a the config lens here
                            --       because it will mutate the directory which
                            --       we *don't* want in this instance.
                            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)

-- | Handle preprocessor directives (commands prefixed with an octothorpe).
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 -- Ignored
          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)) -- (takeBranch ln >>= precede)
                 [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)) -- takeBranch ln >>= precede)
                      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 -- warnings not yet supported
          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)
        {- SPECIALIZE includeAux ::
            (LineNum -> FilePath -> HppT [String] (Parser (StateT HppState (ExceptT Error IO)) [TOKEN]) [String])
            -> HppT [String] (Parser (StateT HppState (ExceptT Error IO)) [TOKEN]) () #-}
        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 -- takeLine incremented the line count
             [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)) -- (takeBranch ln >>= precede)
               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 #-}

-- | We want to expand macros in expressions that must be evaluated
-- for conditionals, but we want to take special care when dealing
-- with the meta @defined@ operator of the expression language that is
-- a predicate on the evaluation environment.
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 (_,env'') -> Important "1" : squashDefines env'' 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

-- | Expands an input line producing a stream of output lines.
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 ->
      -- when (not (all isSpace (detokenize ln)))
      --      (trace ("macro expand: "++detokenize ln) (return ())) >>
      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))