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

module Data.Terminfo.Parse
  ( module Data.Terminfo.Parse
  , Text.Parsec.ParseError
  )
where

import Control.Monad ( liftM )
import Control.DeepSeq

#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import Data.Word
import qualified Data.Vector.Unboxed as Vector

import Numeric (showHex)

import Text.Parsec

data CapExpression = CapExpression
    { CapExpression -> CapOps
capOps :: !CapOps
    , CapExpression -> Vector Word8
capBytes :: !(Vector.Vector Word8)
    , CapExpression -> String
sourceString :: !String
    , CapExpression -> Int
paramCount :: !Int
    , CapExpression -> ParamOps
paramOps :: !ParamOps
    } deriving (CapExpression -> CapExpression -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CapExpression -> CapExpression -> Bool
$c/= :: CapExpression -> CapExpression -> Bool
== :: CapExpression -> CapExpression -> Bool
$c== :: CapExpression -> CapExpression -> Bool
Eq)

instance Show CapExpression where
    show :: CapExpression -> String
show CapExpression
c
        = String
"CapExpression { " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (CapExpression -> CapOps
capOps CapExpression
c) forall a. [a] -> [a] -> [a]
++ String
" }"
        forall a. [a] -> [a] -> [a]
++ String
" <- [" forall a. [a] -> [a] -> [a]
++ [Word8] -> String
hexDump ( forall a b. (a -> b) -> [a] -> [b]
map ( forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum ) forall a b. (a -> b) -> a -> b
$! CapExpression -> String
sourceString CapExpression
c ) forall a. [a] -> [a] -> [a]
++ String
"]"
        forall a. [a] -> [a] -> [a]
++ String
" <= " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (CapExpression -> String
sourceString CapExpression
c)
        where
            hexDump :: [Word8] -> String
            hexDump :: [Word8] -> String
hexDump = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. (Integral a, Show a) => a -> ShowS
showHex String
""

instance NFData CapExpression where
    rnf :: CapExpression -> ()
rnf (CapExpression CapOps
ops !Vector Word8
_bytes !String
str !Int
c !ParamOps
pOps)
        = forall a. NFData a => a -> ()
rnf CapOps
ops seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf String
str seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Int
c seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf ParamOps
pOps

type CapParam = Word

type CapOps = [CapOp]
data CapOp =
      Bytes !Int !Int -- offset count
    | DecOut | CharOut
    -- This stores a 0-based index to the parameter. However the
    -- operation that implies this op is 1-based
    | PushParam !Word | PushValue !Word
    -- The conditional parts are the sequence of (%t expression, %e
    -- The expression) pairs. %e expression may be NOP
    | Conditional
      { CapOp -> CapOps
conditionalExpr :: !CapOps
      , CapOp -> [(CapOps, CapOps)]
conditionalParts :: ![(CapOps, CapOps)]
      }
    | BitwiseOr | BitwiseXOr | BitwiseAnd
    | ArithPlus | ArithMinus
    | CompareEq | CompareLt | CompareGt
    deriving (Int -> CapOp -> ShowS
CapOps -> ShowS
CapOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: CapOps -> ShowS
$cshowList :: CapOps -> ShowS
show :: CapOp -> String
$cshow :: CapOp -> String
showsPrec :: Int -> CapOp -> ShowS
$cshowsPrec :: Int -> CapOp -> ShowS
Show, CapOp -> CapOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CapOp -> CapOp -> Bool
$c/= :: CapOp -> CapOp -> Bool
== :: CapOp -> CapOp -> Bool
$c== :: CapOp -> CapOp -> Bool
Eq)

instance NFData CapOp where
    rnf :: CapOp -> ()
rnf (Bytes Int
offset Int
byteCount ) = forall a. NFData a => a -> ()
rnf Int
offset seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Int
byteCount
    rnf (PushParam Word
pn) = forall a. NFData a => a -> ()
rnf Word
pn
    rnf (PushValue Word
v) = forall a. NFData a => a -> ()
rnf Word
v
    rnf (Conditional CapOps
cExpr [(CapOps, CapOps)]
cParts) = forall a. NFData a => a -> ()
rnf CapOps
cExpr seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [(CapOps, CapOps)]
cParts
    rnf CapOp
BitwiseOr = ()
    rnf CapOp
BitwiseXOr = ()
    rnf CapOp
BitwiseAnd = ()
    rnf CapOp
ArithPlus = ()
    rnf CapOp
ArithMinus = ()
    rnf CapOp
CompareEq = ()
    rnf CapOp
CompareLt = ()
    rnf CapOp
CompareGt = ()
    rnf CapOp
DecOut = ()
    rnf CapOp
CharOut = ()

type ParamOps = [ParamOp]
data ParamOp =
      IncFirstTwo
    deriving (Int -> ParamOp -> ShowS
ParamOps -> ShowS
ParamOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: ParamOps -> ShowS
$cshowList :: ParamOps -> ShowS
show :: ParamOp -> String
$cshow :: ParamOp -> String
showsPrec :: Int -> ParamOp -> ShowS
$cshowsPrec :: Int -> ParamOp -> ShowS
Show, ParamOp -> ParamOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamOp -> ParamOp -> Bool
$c/= :: ParamOp -> ParamOp -> Bool
== :: ParamOp -> ParamOp -> Bool
$c== :: ParamOp -> ParamOp -> Bool
Eq)

instance NFData ParamOp where
    rnf :: ParamOp -> ()
rnf ParamOp
IncFirstTwo = ()

parseCapExpression :: String -> Either ParseError CapExpression
parseCapExpression :: String -> Either ParseError CapExpression
parseCapExpression String
capString =
    let v :: Either ParseError BuildResults
v = forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser CapParser BuildResults
capExpressionParser
                      BuildState
initialBuildState
                      String
"terminfo cap"
                      String
capString
    in case Either ParseError BuildResults
v of
        Left ParseError
e -> forall a b. a -> Either a b
Left ParseError
e
        Right BuildResults
buildResults -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> BuildResults -> CapExpression
constructCapExpression String
capString BuildResults
buildResults

constructCapExpression :: String -> BuildResults -> CapExpression
constructCapExpression :: String -> BuildResults -> CapExpression
constructCapExpression String
capString BuildResults
buildResults =
    let expr :: CapExpression
expr = CapExpression
                { capOps :: CapOps
capOps = BuildResults -> CapOps
outCapOps BuildResults
buildResults
                -- The cap bytes are the lower 8 bits of the input
                -- string's characters.
                , capBytes :: Vector Word8
capBytes = forall a. Unbox a => [a] -> Vector a
Vector.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Enum a => Int -> a
toEnumforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Enum a => a -> Int
fromEnum) String
capString
                , sourceString :: String
sourceString = String
capString
                , paramCount :: Int
paramCount = BuildResults -> Int
outParamCount BuildResults
buildResults
                , paramOps :: ParamOps
paramOps = BuildResults -> ParamOps
outParamOps BuildResults
buildResults
                }
    in forall a. NFData a => a -> ()
rnf CapExpression
expr seq :: forall a b. a -> b -> b
`seq` CapExpression
expr

type CapParser a = Parsec String BuildState a

capExpressionParser :: CapParser BuildResults
capExpressionParser :: CapParser BuildResults
capExpressionParser = do
    [BuildResults]
rs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ CapParser BuildResults
paramEscapeParser forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
bytesOpParser
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [BuildResults]
rs

paramEscapeParser :: CapParser BuildResults
paramEscapeParser :: CapParser BuildResults
paramEscapeParser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
    Int -> CapParser ()
incOffset Int
1
    CapParser BuildResults
literalPercentParser forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
paramOpParser

literalPercentParser :: CapParser BuildResults
literalPercentParser :: CapParser BuildResults
literalPercentParser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
    Int
startOffset <- BuildState -> Int
nextOffset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    Int -> CapParser ()
incOffset Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [Int -> Int -> CapOp
Bytes Int
startOffset Int
1] []

paramOpParser :: CapParser BuildResults
paramOpParser :: CapParser BuildResults
paramOpParser
    = CapParser BuildResults
incrementOpParser
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
pushOpParser
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
decOutParser
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
charOutParser
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
conditionalOpParser
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
bitwiseOpParser
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
arithOpParser
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
literalIntOpParser
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
compareOpParser
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
charConstParser

incrementOpParser :: CapParser BuildResults
incrementOpParser :: CapParser BuildResults
incrementOpParser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'i'
    Int -> CapParser ()
incOffset Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [] [ ParamOp
IncFirstTwo ]

pushOpParser :: CapParser BuildResults
pushOpParser :: CapParser BuildResults
pushOpParser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'p'
    Word
paramN <- forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
    Int -> CapParser ()
incOffset Int
2
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults (forall a. Enum a => a -> Int
fromEnum Word
paramN) [Word -> CapOp
PushParam forall a b. (a -> b) -> a -> b
$ Word
paramN forall a. Num a => a -> a -> a
- Word
1] []

decOutParser :: CapParser BuildResults
decOutParser :: CapParser BuildResults
decOutParser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'd'
    Int -> CapParser ()
incOffset Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [ CapOp
DecOut ] []

charOutParser :: CapParser BuildResults
charOutParser :: CapParser BuildResults
charOutParser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'c'
    Int -> CapParser ()
incOffset Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [ CapOp
CharOut ] []

conditionalOpParser :: CapParser BuildResults
conditionalOpParser :: CapParser BuildResults
conditionalOpParser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?'
    Int -> CapParser ()
incOffset Int
1
    BuildResults
condPart <- forall {a}.
ParsecT String BuildState Identity a -> CapParser BuildResults
manyExpr CapParser ()
conditionalTrueParser
    [(BuildResults, BuildResults)]
parts <- forall {s} {m :: * -> *} {t} {u} {a} {a}.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m [a]
manyP
             ( do
                BuildResults
truePart <- forall {a}.
ParsecT String BuildState Identity a -> CapParser BuildResults
manyExpr forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead CapParser ()
conditionalEndParser
                                              , CapParser ()
conditionalFalseParser
                                              ]
                BuildResults
falsePart <- forall {a}.
ParsecT String BuildState Identity a -> CapParser BuildResults
manyExpr forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead CapParser ()
conditionalEndParser
                                               , CapParser ()
conditionalTrueParser
                                               ]
                forall (m :: * -> *) a. Monad m => a -> m a
return ( BuildResults
truePart, BuildResults
falsePart )
             )
             CapParser ()
conditionalEndParser

    let trueParts :: [BuildResults]
trueParts = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(BuildResults, BuildResults)]
parts
        falseParts :: [BuildResults]
falseParts = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(BuildResults, BuildResults)]
parts
        BuildResults Int
n CapOps
cond ParamOps
condParamOps = BuildResults
condPart

    let n' :: Int
n' = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ Int
n forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map BuildResults -> Int
outParamCount [BuildResults]
trueParts
        n'' :: Int
n'' = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ Int
n' forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map BuildResults -> Int
outParamCount [BuildResults]
falseParts

    let trueOps :: [CapOps]
trueOps = forall a b. (a -> b) -> [a] -> [b]
map BuildResults -> CapOps
outCapOps [BuildResults]
trueParts
        falseOps :: [CapOps]
falseOps = forall a b. (a -> b) -> [a] -> [b]
map BuildResults -> CapOps
outCapOps [BuildResults]
falseParts
        condParts :: [(CapOps, CapOps)]
condParts = forall a b. [a] -> [b] -> [(a, b)]
zip [CapOps]
trueOps [CapOps]
falseOps

    let trueParamOps :: ParamOps
trueParamOps = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map BuildResults -> ParamOps
outParamOps [BuildResults]
trueParts
        falseParamOps :: ParamOps
falseParamOps = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map BuildResults -> ParamOps
outParamOps [BuildResults]
falseParts
        pOps :: ParamOps
pOps = forall a. Monoid a => [a] -> a
mconcat [ParamOps
condParamOps, ParamOps
trueParamOps, ParamOps
falseParamOps]

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
n'' [ CapOps -> [(CapOps, CapOps)] -> CapOp
Conditional CapOps
cond [(CapOps, CapOps)]
condParts ] ParamOps
pOps

    where
        manyP :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m [a]
manyP !ParsecT s u m a
p !ParsecT s u m a
end = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
            [ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m a
end forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return []
            , do !a
v <- ParsecT s u m a
p
                 ![a]
vs <- ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m [a]
manyP ParsecT s u m a
p ParsecT s u m a
end
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a
v forall a. a -> [a] -> [a]
: [a]
vs
            ]
        manyExpr :: ParsecT String BuildState Identity a -> CapParser BuildResults
manyExpr ParsecT String BuildState Identity a
end = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall {s} {m :: * -> *} {t} {u} {a} {a}.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m [a]
manyP ( CapParser BuildResults
paramEscapeParser forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
bytesOpParser ) ParsecT String BuildState Identity a
end

conditionalTrueParser :: CapParser ()
conditionalTrueParser :: CapParser ()
conditionalTrueParser = do
    String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%t"
    Int -> CapParser ()
incOffset Int
2

conditionalFalseParser :: CapParser ()
conditionalFalseParser :: CapParser ()
conditionalFalseParser = do
    String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%e"
    Int -> CapParser ()
incOffset Int
2

conditionalEndParser :: CapParser ()
conditionalEndParser :: CapParser ()
conditionalEndParser = do
    String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%;"
    Int -> CapParser ()
incOffset Int
2

bitwiseOpParser :: CapParser BuildResults
bitwiseOpParser :: CapParser BuildResults
bitwiseOpParser
    =   CapParser BuildResults
bitwiseOrParser
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
bitwiseAndParser
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
bitwiseXorParser

bitwiseOrParser :: CapParser BuildResults
bitwiseOrParser :: CapParser BuildResults
bitwiseOrParser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'
    Int -> CapParser ()
incOffset Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [ CapOp
BitwiseOr ] [ ]

bitwiseAndParser :: CapParser BuildResults
bitwiseAndParser :: CapParser BuildResults
bitwiseAndParser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'&'
    Int -> CapParser ()
incOffset Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [ CapOp
BitwiseAnd ] [ ]

bitwiseXorParser :: CapParser BuildResults
bitwiseXorParser :: CapParser BuildResults
bitwiseXorParser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^'
    Int -> CapParser ()
incOffset Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [ CapOp
BitwiseXOr ] [ ]

arithOpParser :: CapParser BuildResults
arithOpParser :: CapParser BuildResults
arithOpParser
    =   CapParser BuildResults
plusOp
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
minusOp
    where
        plusOp :: CapParser BuildResults
plusOp = do
            Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'
            Int -> CapParser ()
incOffset Int
1
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [ CapOp
ArithPlus ] [ ]
        minusOp :: CapParser BuildResults
minusOp = do
            Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
            Int -> CapParser ()
incOffset Int
1
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [ CapOp
ArithMinus ] [ ]

literalIntOpParser :: CapParser BuildResults
literalIntOpParser :: CapParser BuildResults
literalIntOpParser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
    Int -> CapParser ()
incOffset Int
1
    String
nStr <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
    Int -> CapParser ()
incOffset forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
nStr
    let Word
n :: Word = forall a. Read a => String -> a
read String
nStr
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
    Int -> CapParser ()
incOffset Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [ Word -> CapOp
PushValue Word
n ] [ ]

compareOpParser :: CapParser BuildResults
compareOpParser :: CapParser BuildResults
compareOpParser
    =   CapParser BuildResults
compareEqOp
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
compareLtOp
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CapParser BuildResults
compareGtOp
    where
        compareEqOp :: CapParser BuildResults
compareEqOp = do
            Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
            Int -> CapParser ()
incOffset Int
1
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [ CapOp
CompareEq ] [ ]
        compareLtOp :: CapParser BuildResults
compareLtOp = do
            Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
            Int -> CapParser ()
incOffset Int
1
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [ CapOp
CompareLt ] [ ]
        compareGtOp :: CapParser BuildResults
compareGtOp = do
            Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
            Int -> CapParser ()
incOffset Int
1
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [ CapOp
CompareGt ] [ ]

bytesOpParser :: CapParser BuildResults
bytesOpParser :: CapParser BuildResults
bytesOpParser = do
    String
bytes <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall a. Eq a => a -> a -> Bool
/= Char
'%')
    Int
startOffset <- BuildState -> Int
nextOffset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    let !c :: Int
c = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bytes
    !BuildState
s <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    let s' :: BuildState
s' = BuildState
s { nextOffset :: Int
nextOffset = Int
startOffset forall a. Num a => a -> a -> a
+ Int
c }
    forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState BuildState
s'
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [Int -> Int -> CapOp
Bytes Int
startOffset Int
c] []

charConstParser :: CapParser BuildResults
charConstParser :: CapParser BuildResults
charConstParser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
    Word
charValue <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
    Int -> CapParser ()
incOffset Int
3
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [ Word -> CapOp
PushValue Word
charValue ] [ ]

data BuildState = BuildState
    { BuildState -> Int
nextOffset :: Int
    }

incOffset :: Int -> CapParser ()
incOffset :: Int -> CapParser ()
incOffset Int
n = do
    BuildState
s <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    let s' :: BuildState
s' = BuildState
s { nextOffset :: Int
nextOffset = BuildState -> Int
nextOffset BuildState
s forall a. Num a => a -> a -> a
+ Int
n }
    forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState BuildState
s'

initialBuildState :: BuildState
initialBuildState :: BuildState
initialBuildState = Int -> BuildState
BuildState Int
0

data BuildResults = BuildResults
    { BuildResults -> Int
outParamCount :: !Int
    , BuildResults -> CapOps
outCapOps :: !CapOps
    , BuildResults -> ParamOps
outParamOps :: !ParamOps
    }

instance Semigroup BuildResults where
    BuildResults
v0 <> :: BuildResults -> BuildResults -> BuildResults
<> BuildResults
v1
        = BuildResults
        { outParamCount :: Int
outParamCount = BuildResults -> Int
outParamCount BuildResults
v0 forall a. Ord a => a -> a -> a
`max` BuildResults -> Int
outParamCount BuildResults
v1
        , outCapOps :: CapOps
outCapOps = BuildResults -> CapOps
outCapOps BuildResults
v0 forall a. Semigroup a => a -> a -> a
<> BuildResults -> CapOps
outCapOps BuildResults
v1
        , outParamOps :: ParamOps
outParamOps = BuildResults -> ParamOps
outParamOps BuildResults
v0 forall a. Semigroup a => a -> a -> a
<> BuildResults -> ParamOps
outParamOps BuildResults
v1
        }

instance Monoid BuildResults where
    mempty :: BuildResults
mempty = Int -> CapOps -> ParamOps -> BuildResults
BuildResults Int
0 [] []
#if !(MIN_VERSION_base(4,11,0))
    mappend = (<>)
#endif