    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE NoMonomorphismRestriction #-}
    {-# OPTIONS_GHC -funbox-strict-fields #-}
    {-# OPTIONS_HADDOCK hide #-}

    -- | Evaluates the paramaterized terminfo string capability with the
    -- given parameters.
    module Data.Terminfo.Eval
      ( writeCapExpr
      )
    where

    import Blaze.ByteString.Builder.Word
    import Blaze.ByteString.Builder
    import Data.Terminfo.Parse

    import Control.Monad
    import Control.Monad.Identity
    import Control.Monad.State.Strict
    import Control.Monad.Writer

    import Data.Bits ((.|.), (.&.), xor)
    import Data.List

    import qualified Data.Vector.Unboxed as Vector

    -- | capability evaluator state
    data EvalState = EvalState
        { EvalState -> [CapParam]
    evalStack :: ![CapParam]
        , EvalState -> CapExpression
    evalExpression :: !CapExpression
        , EvalState -> [CapParam]
    evalParams :: ![CapParam]
        }

    type Eval a = StateT EvalState (Writer Write) a

    pop :: Eval CapParam
    pop :: Eval CapParam
    pop = do
        EvalState
    s <- StateT EvalState (Writer Write) EvalState
    forall s (m :: * -> *). MonadState s m => m s
    get
        let CapParam
    v : [CapParam]
    stack' = EvalState -> [CapParam]
    evalStack EvalState
    s
            s' :: EvalState
    s' = EvalState
    s { evalStack :: [CapParam]
    evalStack = [CapParam]
    stack' }
        EvalState -> StateT EvalState (Writer Write) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put EvalState
    s'
        CapParam -> Eval CapParam
    forall a. a -> StateT EvalState (Writer Write) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CapParam
    v

    readParam :: Word -> Eval CapParam
    readParam :: CapParam -> Eval CapParam
    readParam CapParam
    pn = do
        ![CapParam]
    params <- EvalState -> [CapParam]
    evalParams (EvalState -> [CapParam])
    -> StateT EvalState (Writer Write) EvalState
    -> StateT EvalState (Writer Write) [CapParam]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT EvalState (Writer Write) EvalState
    forall s (m :: * -> *). MonadState s m => m s
    get
        CapParam -> Eval CapParam
    forall a. a -> StateT EvalState (Writer Write) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CapParam -> Eval CapParam) -> CapParam -> Eval CapParam
    forall a b. (a -> b) -> a -> b
    $! [CapParam] -> CapParam -> CapParam
    forall i a. Integral i => [a] -> i -> a
    genericIndex [CapParam]
    params CapParam
    pn

    push :: CapParam -> Eval ()
    push :: CapParam -> StateT EvalState (Writer Write) ()
    push !CapParam
    v = do
        EvalState
    s <- StateT EvalState (Writer Write) EvalState
    forall s (m :: * -> *). MonadState s m => m s
    get
        let s' :: EvalState
    s' = EvalState
    s { evalStack :: [CapParam]
    evalStack = CapParam
    v CapParam -> [CapParam] -> [CapParam]
    forall a. a -> [a] -> [a]
    : EvalState -> [CapParam]
    evalStack EvalState
    s }
        EvalState -> StateT EvalState (Writer Write) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put EvalState
    s'

    applyParamOps :: CapExpression -> [CapParam] -> [CapParam]
    applyParamOps :: CapExpression -> [CapParam] -> [CapParam]
    applyParamOps CapExpression
    cap [CapParam]
    params = ([CapParam] -> ParamOp -> [CapParam])
    -> [CapParam] -> [ParamOp] -> [CapParam]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl [CapParam] -> ParamOp -> [CapParam]
    applyParamOp [CapParam]
    params (CapExpression -> [ParamOp]
    paramOps CapExpression
    cap)

    applyParamOp :: [CapParam] -> ParamOp -> [CapParam]
    applyParamOp :: [CapParam] -> ParamOp -> [CapParam]
    applyParamOp [CapParam]
    params ParamOp
    IncFirstTwo = (CapParam -> CapParam) -> [CapParam] -> [CapParam]
    forall a b. (a -> b) -> [a] -> [b]
    map (CapParam -> CapParam -> CapParam
    forall a. Num a => a -> a -> a
    + CapParam
    1) [CapParam]
    params

    writeCapExpr :: CapExpression -> [CapParam] -> Write
    writeCapExpr :: CapExpression -> [CapParam] -> Write
    writeCapExpr CapExpression
    cap [CapParam]
    params =
        let params' :: [CapParam]
    params' = CapExpression -> [CapParam] -> [CapParam]
    applyParamOps CapExpression
    cap [CapParam]
    params
            s0 :: EvalState
    s0 = [CapParam] -> CapExpression -> [CapParam] -> EvalState
    EvalState [] CapExpression
    cap [CapParam]
    params'
        in (((), EvalState), Write) -> Write
    forall a b. (a, b) -> b
    snd ((((), EvalState), Write) -> Write)
    -> (((), EvalState), Write) -> Write
    forall a b. (a -> b) -> a -> b
    $ Writer Write ((), EvalState) -> (((), EvalState), Write)
    forall w a. Writer w a -> (a, w)
    runWriter (StateT EvalState (Writer Write) ()
    -> EvalState -> Writer Write ((), EvalState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT (CapOps -> StateT EvalState (Writer Write) ()
    writeCapOps (CapExpression -> CapOps
    capOps CapExpression
    cap)) EvalState
    s0)

    writeCapOps :: CapOps -> Eval ()
    writeCapOps :: CapOps -> StateT EvalState (Writer Write) ()
    writeCapOps = (CapOp -> StateT EvalState (Writer Write) ())
    -> CapOps -> StateT EvalState (Writer Write) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ CapOp -> StateT EvalState (Writer Write) ()
    writeCapOp

    writeCapOp :: CapOp -> Eval ()
    writeCapOp :: CapOp -> StateT EvalState (Writer Write) ()
    writeCapOp (Bytes !Int
    offset !Int
    count) = do
        !CapExpression
    cap <- EvalState -> CapExpression
    evalExpression (EvalState -> CapExpression)
    -> StateT EvalState (Writer Write) EvalState
    -> StateT EvalState (Writer Write) CapExpression
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT EvalState (Writer Write) EvalState
    forall s (m :: * -> *). MonadState s m => m s
    get
        let bytes :: Vector Word8
    bytes = Int -> Vector Word8 -> Vector Word8
    forall a. Unbox a => Int -> Vector a -> Vector a
    Vector.take Int
    count (Vector Word8 -> Vector Word8) -> Vector Word8 -> Vector Word8
    forall a b. (a -> b) -> a -> b
    $ Int -> Vector Word8 -> Vector Word8
    forall a. Unbox a => Int -> Vector a -> Vector a
    Vector.drop Int
    offset (CapExpression -> Vector Word8
    capBytes CapExpression
    cap)
        Vector Word8
    -> (Word8 -> StateT EvalState (Writer Write) ())
    -> StateT EvalState (Writer Write) ()
    forall (m :: * -> *) a b.
    (Monad m, Unbox a) =>
    Vector a -> (a -> m b) -> m ()
    Vector.forM_ Vector Word8
    bytes ((Word8 -> StateT EvalState (Writer Write) ())
     -> StateT EvalState (Writer Write) ())
    -> (Word8 -> StateT EvalState (Writer Write) ())
    -> StateT EvalState (Writer Write) ()
    forall a b. (a -> b) -> a -> b
    $ Write -> StateT EvalState (Writer Write) ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell(Write -> StateT EvalState (Writer Write) ())
    -> (Word8 -> Write) -> Word8 -> StateT EvalState (Writer Write) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Word8 -> Write
    writeWord8
    writeCapOp CapOp
    DecOut = do
        CapParam
    p <- Eval CapParam
    pop
        [Char]
    -> (Char -> StateT EvalState (Writer Write) ())
    -> StateT EvalState (Writer Write) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (CapParam -> [Char]
    forall a. Show a => a -> [Char]
    show CapParam
    p) ((Char -> StateT EvalState (Writer Write) ())
     -> StateT EvalState (Writer Write) ())
    -> (Char -> StateT EvalState (Writer Write) ())
    -> StateT EvalState (Writer Write) ()
    forall a b. (a -> b) -> a -> b
    $ Write -> StateT EvalState (Writer Write) ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell(Write -> StateT EvalState (Writer Write) ())
    -> (Char -> Write) -> Char -> StateT EvalState (Writer Write) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Word8 -> Write
    writeWord8(Word8 -> Write) -> (Char -> Word8) -> Char -> Write
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> Word8
    forall a. Enum a => Int -> a
    toEnum(Int -> Word8) -> (Char -> Int) -> Char -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> Int
    forall a. Enum a => a -> Int
    fromEnum
    writeCapOp CapOp
    CharOut = do
        Eval CapParam
    pop Eval CapParam
    -> (CapParam -> StateT EvalState (Writer Write) ())
    -> StateT EvalState (Writer Write) ()
    forall a b.
    StateT EvalState (Writer Write) a
    -> (a -> StateT EvalState (Writer Write) b)
    -> StateT EvalState (Writer Write) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Write -> StateT EvalState (Writer Write) ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell(Write -> StateT EvalState (Writer Write) ())
    -> (CapParam -> Write)
    -> CapParam
    -> StateT EvalState (Writer Write) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Word8 -> Write
    writeWord8(Word8 -> Write) -> (CapParam -> Word8) -> CapParam -> Write
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> Word8
    forall a. Enum a => Int -> a
    toEnum(Int -> Word8) -> (CapParam -> Int) -> CapParam -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .CapParam -> Int
    forall a. Enum a => a -> Int
    fromEnum
    writeCapOp (PushParam CapParam
    pn) = do
        CapParam -> Eval CapParam
    readParam CapParam
    pn Eval CapParam
    -> (CapParam -> StateT EvalState (Writer Write) ())
    -> StateT EvalState (Writer Write) ()
    forall a b.
    StateT EvalState (Writer Write) a
    -> (a -> StateT EvalState (Writer Write) b)
    -> StateT EvalState (Writer Write) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= CapParam -> StateT EvalState (Writer Write) ()
    push
    writeCapOp (PushValue CapParam
    v) = do
        CapParam -> StateT EvalState (Writer Write) ()
    push CapParam
    v
    writeCapOp (Conditional CapOps
    expr [(CapOps, CapOps)]
    parts) = do
        CapOps -> StateT EvalState (Writer Write) ()
    writeCapOps CapOps
    expr
        [(CapOps, CapOps)] -> StateT EvalState (Writer Write) ()
    writeContitionalParts [(CapOps, CapOps)]
    parts
        where
            writeContitionalParts :: [(CapOps, CapOps)] -> StateT EvalState (Writer Write) ()
    writeContitionalParts [] = () -> StateT EvalState (Writer Write) ()
    forall a. a -> StateT EvalState (Writer Write) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            writeContitionalParts ((CapOps
    trueOps, CapOps
    falseOps) : [(CapOps, CapOps)]
    falseParts) = do
                -- (man 5 terminfo)
                -- Usually the %? expr part pushes a value onto the stack,
                -- and %t pops it from the stack, testing if it is nonzero
                -- (true). If it is zero (false), control passes to the %e
                -- (else) part.
                CapParam
    v <- Eval CapParam
    pop
                if CapParam
    v CapParam -> CapParam -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CapParam
    0
                    then CapOps -> StateT EvalState (Writer Write) ()
    writeCapOps CapOps
    trueOps
                    else do
                        CapOps -> StateT EvalState (Writer Write) ()
    writeCapOps CapOps
    falseOps
                        [(CapOps, CapOps)] -> StateT EvalState (Writer Write) ()
    writeContitionalParts [(CapOps, CapOps)]
    falseParts

    writeCapOp CapOp
    BitwiseOr = do
        CapParam
    v0 <- Eval CapParam
    pop
        CapParam
    v1 <- Eval CapParam
    pop
        CapParam -> StateT EvalState (Writer Write) ()
    push (CapParam -> StateT EvalState (Writer Write) ())
    -> CapParam -> StateT EvalState (Writer Write) ()
    forall a b. (a -> b) -> a -> b
    $ CapParam
    v0 CapParam -> CapParam -> CapParam
    forall a. Bits a => a -> a -> a
    .|. CapParam
    v1
    writeCapOp CapOp
    BitwiseAnd = do
        CapParam
    v0 <- Eval CapParam
    pop
        CapParam
    v1 <- Eval CapParam
    pop
        CapParam -> StateT EvalState (Writer Write) ()
    push (CapParam -> StateT EvalState (Writer Write) ())
    -> CapParam -> StateT EvalState (Writer Write) ()
    forall a b. (a -> b) -> a -> b
    $ CapParam
    v0 CapParam -> CapParam -> CapParam
    forall a. Bits a => a -> a -> a
    .&. CapParam
    v1
    writeCapOp CapOp
    BitwiseXOr = do
        CapParam
    v1 <- Eval CapParam
    pop
        CapParam
    v0 <- Eval CapParam
    pop
        CapParam -> StateT EvalState (Writer Write) ()
    push (CapParam -> StateT EvalState (Writer Write) ())
    -> CapParam -> StateT EvalState (Writer Write) ()
    forall a b. (a -> b) -> a -> b
    $ CapParam
    v0 CapParam -> CapParam -> CapParam
    forall a. Bits a => a -> a -> a
    `xor` CapParam
    v1
    writeCapOp CapOp
    ArithPlus = do
        CapParam
    v1 <- Eval CapParam
    pop
        CapParam
    v0 <- Eval CapParam
    pop
        CapParam -> StateT EvalState (Writer Write) ()
    push (CapParam -> StateT EvalState (Writer Write) ())
    -> CapParam -> StateT EvalState (Writer Write) ()
    forall a b. (a -> b) -> a -> b
    $ CapParam
    v0 CapParam -> CapParam -> CapParam
    forall a. Num a => a -> a -> a
    + CapParam
    v1
    writeCapOp CapOp
    ArithMinus = do
        CapParam
    v1 <- Eval CapParam
    pop
        CapParam
    v0 <- Eval CapParam
    pop
        CapParam -> StateT EvalState (Writer Write) ()
    push (CapParam -> StateT EvalState (Writer Write) ())
    -> CapParam -> StateT EvalState (Writer Write) ()
    forall a b. (a -> b) -> a -> b
    $ CapParam
    v0 CapParam -> CapParam -> CapParam
    forall a. Num a => a -> a -> a
    - CapParam
    v1
    writeCapOp CapOp
    CompareEq = do
        CapParam
    v1 <- Eval CapParam
    pop
        CapParam
    v0 <- Eval CapParam
    pop
        CapParam -> StateT EvalState (Writer Write) ()
    push (CapParam -> StateT EvalState (Writer Write) ())
    -> CapParam -> StateT EvalState (Writer Write) ()
    forall a b. (a -> b) -> a -> b
    $ if CapParam
    v0 CapParam -> CapParam -> Bool
    forall a. Eq a => a -> a -> Bool
    == CapParam
    v1 then CapParam
    1 else CapParam
    0
    writeCapOp CapOp
    CompareLt = do
        CapParam
    v1 <- Eval CapParam
    pop
        CapParam
    v0 <- Eval CapParam
    pop
        CapParam -> StateT EvalState (Writer Write) ()
    push (CapParam -> StateT EvalState (Writer Write) ())
    -> CapParam -> StateT EvalState (Writer Write) ()
    forall a b. (a -> b) -> a -> b
    $ if CapParam
    v0 CapParam -> CapParam -> Bool
    forall a. Ord a => a -> a -> Bool
    < CapParam
    v1 then CapParam
    1 else CapParam
    0
    writeCapOp CapOp
    CompareGt = do
        CapParam
    v1 <- Eval CapParam
    pop
        CapParam
    v0 <- Eval CapParam
    pop
        CapParam -> StateT EvalState (Writer Write) ()
    push (CapParam -> StateT EvalState (Writer Write) ())
    -> CapParam -> StateT EvalState (Writer Write) ()
    forall a b. (a -> b) -> a -> b
    $ if CapParam
    v0 CapParam -> CapParam -> Bool
    forall a. Ord a => a -> a -> Bool
    > CapParam
    v1 then CapParam
    1 else CapParam
    0