{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# 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
b String
s -> Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
b String
s) 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
| DecOut | CharOut
| PushParam !Word | PushValue !Word
| 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 :: [Char] -> 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
, 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 <- ParsecT String BuildState Identity BuildState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT String BuildState Identity BuildState
-> (BuildState -> ParsecT String BuildState Identity Int)
-> ParsecT String BuildState Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParsecT String BuildState Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT String BuildState Identity Int)
-> (BuildState -> Int)
-> BuildState
-> ParsecT String BuildState Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildState -> Int
nextOffset
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 <- ParsecT String BuildState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT String BuildState Identity Char
-> (Char -> ParsecT String BuildState Identity Word)
-> ParsecT String BuildState Identity Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> ParsecT String BuildState Identity Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ParsecT String BuildState Identity Word)
-> (Char -> Word)
-> Char
-> ParsecT String BuildState Identity Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Char
d -> String -> Word
forall a. Read a => String -> a
read [Char
d])
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 <- ParsecT String BuildState Identity BuildState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT String BuildState Identity BuildState
-> (BuildState -> ParsecT String BuildState Identity Int)
-> ParsecT String BuildState Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParsecT String BuildState Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT String BuildState Identity Int)
-> (BuildState -> Int)
-> BuildState
-> ParsecT String BuildState Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildState -> Int
nextOffset
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