{-# 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.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 (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 (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 (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 (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 (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 (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