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

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
(CapExpression -> CapExpression -> Bool)
-> (CapExpression -> CapExpression -> Bool) -> Eq CapExpression
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 { " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CapOps -> String
forall a. Show a => a -> String
show (CapExpression -> CapOps
capOps CapExpression
c) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" }"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" <- [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Word8] -> String
hexDump ( (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map ( 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 ) (String -> [Word8]) -> String -> [Word8]
forall a b. (a -> b) -> a -> b
$! CapExpression -> String
sourceString CapExpression
c ) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" <= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (CapExpression -> String
sourceString CapExpression
c)
        where
            hexDump :: [Word8] -> String
            hexDump :: [Word8] -> String
hexDump = (Word8 -> ShowS) -> String -> [Word8] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word8 -> ShowS
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)
        = CapOps -> ()
forall a. NFData a => a -> ()
rnf CapOps
ops () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
str () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
c () -> () -> ()
`seq` ParamOps -> ()
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
(Int -> CapOp -> ShowS)
-> (CapOp -> String) -> (CapOps -> ShowS) -> Show CapOp
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
(CapOp -> CapOp -> Bool) -> (CapOp -> CapOp -> Bool) -> Eq CapOp
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 ) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
offset () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
byteCount
    rnf (PushParam Word
pn) = Word -> ()
forall a. NFData a => a -> ()
rnf Word
pn
    rnf (PushValue Word
v) = Word -> ()
forall a. NFData a => a -> ()
rnf Word
v
    rnf (Conditional CapOps
cExpr [(CapOps, CapOps)]
cParts) = CapOps -> ()
forall a. NFData a => a -> ()
rnf CapOps
cExpr () -> () -> ()
`seq` [(CapOps, CapOps)] -> ()
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
(Int -> ParamOp -> ShowS)
-> (ParamOp -> String) -> (ParamOps -> ShowS) -> Show ParamOp
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
(ParamOp -> ParamOp -> Bool)
-> (ParamOp -> ParamOp -> Bool) -> Eq ParamOp
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 = Parsec String BuildState BuildResults
-> BuildState -> String -> String -> Either ParseError BuildResults
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parsec String BuildState BuildResults
capExpressionParser
                      BuildState
initialBuildState
                      String
"terminfo cap"
                      String
capString
    in case Either ParseError BuildResults
v of
        Left ParseError
e -> ParseError -> Either ParseError CapExpression
forall a b. a -> Either a b
Left ParseError
e
        Right BuildResults
buildResults -> CapExpression -> Either ParseError CapExpression
forall a b. b -> Either a b
Right (CapExpression -> Either ParseError CapExpression)
-> CapExpression -> Either ParseError CapExpression
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
-> Vector Word8 -> String -> Int -> ParamOps -> CapExpression
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 = [Word8] -> Vector Word8
forall a. Unbox a => [a] -> Vector a
Vector.fromList ([Word8] -> Vector Word8) -> [Word8] -> Vector Word8
forall a b. (a -> b) -> a -> b
$ (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (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) String
capString
                , sourceString :: String
sourceString = String
capString
                , paramCount :: Int
paramCount = BuildResults -> Int
outParamCount BuildResults
buildResults
                , paramOps :: ParamOps
paramOps = BuildResults -> ParamOps
outParamOps BuildResults
buildResults
                }
    in CapExpression -> ()
forall a. NFData a => a -> ()
rnf CapExpression
expr () -> CapExpression -> CapExpression
`seq` CapExpression
expr

type CapParser a = Parsec String BuildState a

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

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

literalPercentParser :: CapParser BuildResults
literalPercentParser :: Parsec String BuildState BuildResults
literalPercentParser = do
    Char
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
    Int
startOffset <- BuildState -> Int
nextOffset (BuildState -> Int)
-> ParsecT String BuildState Identity BuildState
-> ParsecT String BuildState Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String BuildState Identity BuildState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    Int -> CapParser ()
incOffset Int
1
    BuildResults -> Parsec String BuildState BuildResults
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildResults -> Parsec String BuildState BuildResults)
-> BuildResults -> Parsec String BuildState BuildResults
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 :: Parsec String BuildState BuildResults
paramOpParser
    = Parsec String BuildState BuildResults
incrementOpParser
    Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String BuildState BuildResults
pushOpParser
    Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String BuildState BuildResults
decOutParser
    Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String BuildState BuildResults
charOutParser
    Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String BuildState BuildResults
conditionalOpParser
    Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String BuildState BuildResults
bitwiseOpParser
    Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String BuildState BuildResults
arithOpParser
    Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String BuildState BuildResults
literalIntOpParser
    Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String BuildState BuildResults
compareOpParser
    Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String BuildState BuildResults
charConstParser

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

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

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

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

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

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

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

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

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

    BuildResults -> Parsec String BuildState BuildResults
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildResults -> Parsec String BuildState BuildResults)
-> BuildResults -> Parsec String BuildState BuildResults
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 = [ParsecT s u m [a]] -> ParsecT s u m [a]
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
            [ ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m a
end ParsecT s u m a -> ParsecT s u m [a] -> ParsecT s u m [a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> ParsecT s u m [a]
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
                 [a] -> ParsecT s u m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> ParsecT s u m [a]) -> [a] -> ParsecT s u m [a]
forall a b. (a -> b) -> a -> b
$! a
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
vs
            ]
        manyExpr :: ParsecT String BuildState Identity a
-> Parsec String BuildState BuildResults
manyExpr ParsecT String BuildState Identity a
end = ([BuildResults] -> BuildResults)
-> ParsecT String BuildState Identity [BuildResults]
-> Parsec String BuildState BuildResults
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [BuildResults] -> BuildResults
forall a. Monoid a => [a] -> a
mconcat (ParsecT String BuildState Identity [BuildResults]
 -> Parsec String BuildState BuildResults)
-> ParsecT String BuildState Identity [BuildResults]
-> Parsec String BuildState BuildResults
forall a b. (a -> b) -> a -> b
$ Parsec String BuildState BuildResults
-> ParsecT String BuildState Identity a
-> ParsecT String BuildState Identity [BuildResults]
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 ( Parsec String BuildState BuildResults
paramEscapeParser Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String BuildState BuildResults
bytesOpParser ) ParsecT String BuildState Identity a
end

conditionalTrueParser :: CapParser ()
conditionalTrueParser :: CapParser ()
conditionalTrueParser = do
    String
_ <- String -> ParsecT String BuildState Identity 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
_ <- String -> ParsecT String BuildState Identity 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
_ <- String -> ParsecT String BuildState Identity 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 :: Parsec String BuildState BuildResults
bitwiseOpParser
    =   Parsec String BuildState BuildResults
bitwiseOrParser
    Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String BuildState BuildResults
bitwiseAndParser
    Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
-> Parsec String BuildState BuildResults
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String BuildState BuildResults
bitwiseXorParser

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

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

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

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

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

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

bytesOpParser :: CapParser BuildResults
bytesOpParser :: Parsec String BuildState BuildResults
bytesOpParser = do
    String
bytes <- ParsecT String BuildState Identity Char
-> ParsecT String BuildState Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String BuildState Identity Char
 -> ParsecT String BuildState Identity String)
-> ParsecT String BuildState Identity Char
-> ParsecT String BuildState Identity String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'%')
    Int
startOffset <- BuildState -> Int
nextOffset (BuildState -> Int)
-> ParsecT String BuildState Identity BuildState
-> ParsecT String BuildState Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String BuildState Identity BuildState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    let !c :: Int
c = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bytes
    !BuildState
s <- ParsecT String BuildState Identity BuildState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    let s' :: BuildState
s' = BuildState
s { nextOffset :: Int
nextOffset = Int
startOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c }
    BuildState -> CapParser ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState BuildState
s'
    BuildResults -> Parsec String BuildState BuildResults
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildResults -> Parsec String BuildState BuildResults)
-> BuildResults -> Parsec String BuildState BuildResults
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 :: Parsec String BuildState BuildResults
charConstParser = do
    Char
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
    Word
charValue <- (Char -> Word)
-> ParsecT String BuildState Identity Char
-> ParsecT String BuildState Identity Word
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> (Char -> Int) -> Char -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum) ParsecT String BuildState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
    Char
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
    Int -> CapParser ()
incOffset Int
3
    BuildResults -> Parsec String BuildState BuildResults
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildResults -> Parsec String BuildState BuildResults)
-> BuildResults -> Parsec String BuildState BuildResults
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 <- ParsecT String BuildState Identity BuildState
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n }
    BuildState -> CapParser ()
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 :: Int -> CapOps -> ParamOps -> BuildResults
BuildResults
        { outParamCount :: Int
outParamCount = BuildResults -> Int
outParamCount BuildResults
v0 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` BuildResults -> Int
outParamCount BuildResults
v1
        , outCapOps :: CapOps
outCapOps = BuildResults -> CapOps
outCapOps BuildResults
v0 CapOps -> CapOps -> CapOps
forall a. Semigroup a => a -> a -> a
<> BuildResults -> CapOps
outCapOps BuildResults
v1
        , outParamOps :: ParamOps
outParamOps = BuildResults -> ParamOps
outParamOps BuildResults
v0 ParamOps -> ParamOps -> ParamOps
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