{-# 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 <- 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' }
    forall s (m :: * -> *). MonadState s m => s -> m ()
put EvalState
s'
    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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall i a. Integral i => [a] -> i -> a
genericIndex [CapParam]
params CapParam
pn

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

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

applyParamOp :: [CapParam] -> ParamOp -> [CapParam]
applyParamOp :: [CapParam] -> ParamOp -> [CapParam]
applyParamOp [CapParam]
params ParamOp
IncFirstTwo = forall a b. (a -> b) -> [a] -> [b]
map (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 forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall w a. Writer w a -> (a, w)
runWriter (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (CapOps -> Eval ()
writeCapOps (CapExpression -> CapOps
capOps CapExpression
cap)) EvalState
s0)

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

writeCapOp :: CapOp -> Eval ()
writeCapOp :: CapOp -> Eval ()
writeCapOp (Bytes !Int
offset !Int
count) = do
    !CapExpression
cap <- EvalState -> CapExpression
evalExpression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
    let bytes :: Vector Word8
bytes = forall a. Unbox a => Int -> Vector a -> Vector a
Vector.take Int
count forall a b. (a -> b) -> a -> b
$ forall a. Unbox a => Int -> Vector a -> Vector a
Vector.drop Int
offset (CapExpression -> Vector Word8
capBytes CapExpression
cap)
    forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
Vector.forM_ Vector Word8
bytes forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tellforall b c a. (b -> c) -> (a -> b) -> a -> c
.Word8 -> Write
writeWord8
writeCapOp CapOp
DecOut = do
    CapParam
p <- Eval CapParam
pop
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. Show a => a -> String
show CapParam
p) forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tellforall b c a. (b -> c) -> (a -> b) -> a -> c
.Word8 -> Write
writeWord8forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Enum a => Int -> a
toEnumforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Enum a => a -> Int
fromEnum
writeCapOp CapOp
CharOut = do
    Eval CapParam
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall w (m :: * -> *). MonadWriter w m => w -> m ()
tellforall b c a. (b -> c) -> (a -> b) -> a -> c
.Word8 -> Write
writeWord8forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Enum a => Int -> a
toEnumforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Enum a => a -> Int
fromEnum
writeCapOp (PushParam CapParam
pn) = do
    CapParam -> Eval CapParam
readParam CapParam
pn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CapParam -> Eval ()
push
writeCapOp (PushValue CapParam
v) = do
    CapParam -> Eval ()
push CapParam
v
writeCapOp (Conditional CapOps
expr [(CapOps, CapOps)]
parts) = do
    CapOps -> Eval ()
writeCapOps CapOps
expr
    [(CapOps, CapOps)] -> Eval ()
writeContitionalParts [(CapOps, CapOps)]
parts
    where
        writeContitionalParts :: [(CapOps, CapOps)] -> Eval ()
writeContitionalParts [] = 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 forall a. Eq a => a -> a -> Bool
/= CapParam
0
                then CapOps -> Eval ()
writeCapOps CapOps
trueOps
                else do
                    CapOps -> Eval ()
writeCapOps CapOps
falseOps
                    [(CapOps, CapOps)] -> Eval ()
writeContitionalParts [(CapOps, CapOps)]
falseParts

writeCapOp CapOp
BitwiseOr = do
    CapParam
v0 <- Eval CapParam
pop
    CapParam
v1 <- Eval CapParam
pop
    CapParam -> Eval ()
push forall a b. (a -> b) -> a -> b
$ CapParam
v0 forall a. Bits a => a -> a -> a
.|. CapParam
v1
writeCapOp CapOp
BitwiseAnd = do
    CapParam
v0 <- Eval CapParam
pop
    CapParam
v1 <- Eval CapParam
pop
    CapParam -> Eval ()
push forall a b. (a -> b) -> a -> b
$ CapParam
v0 forall a. Bits a => a -> a -> a
.&. CapParam
v1
writeCapOp CapOp
BitwiseXOr = do
    CapParam
v1 <- Eval CapParam
pop
    CapParam
v0 <- Eval CapParam
pop
    CapParam -> Eval ()
push forall a b. (a -> b) -> a -> b
$ CapParam
v0 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 -> Eval ()
push forall a b. (a -> b) -> a -> b
$ CapParam
v0 forall a. Num a => a -> a -> a
+ CapParam
v1
writeCapOp CapOp
ArithMinus = do
    CapParam
v1 <- Eval CapParam
pop
    CapParam
v0 <- Eval CapParam
pop
    CapParam -> Eval ()
push forall a b. (a -> b) -> a -> b
$ CapParam
v0 forall a. Num a => a -> a -> a
- CapParam
v1
writeCapOp CapOp
CompareEq = do
    CapParam
v1 <- Eval CapParam
pop
    CapParam
v0 <- Eval CapParam
pop
    CapParam -> Eval ()
push forall a b. (a -> b) -> a -> b
$ if CapParam
v0 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 -> Eval ()
push forall a b. (a -> b) -> a -> b
$ if CapParam
v0 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 -> Eval ()
push forall a b. (a -> b) -> a -> b
$ if CapParam
v0 forall a. Ord a => a -> a -> Bool
> CapParam
v1 then CapParam
1 else CapParam
0