{-# 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
(CapExpression -> CapExpression -> Bool)
-> (CapExpression -> CapExpression -> Bool) -> Eq CapExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CapExpression -> CapExpression -> Bool
== :: CapExpression -> CapExpression -> Bool
$c/= :: CapExpression -> CapExpression -> Bool
/= :: 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 a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word8 -> ShowS
forall a. Integral 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 () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
str () -> () -> ()
forall a b. a -> b -> b
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
c () -> () -> ()
forall a b. a -> b -> b
`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
$cshowsPrec :: Int -> CapOp -> ShowS
showsPrec :: Int -> CapOp -> ShowS
$cshow :: CapOp -> String
show :: CapOp -> String
$cshowList :: CapOps -> ShowS
showList :: CapOps -> ShowS
Show, CapOp -> CapOp -> Bool
(CapOp -> CapOp -> Bool) -> (CapOp -> CapOp -> Bool) -> Eq CapOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CapOp -> CapOp -> Bool
== :: CapOp -> CapOp -> Bool
$c/= :: CapOp -> CapOp -> Bool
/= :: 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 () -> () -> ()
forall a b. a -> b -> b
`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 () -> () -> ()
forall a b. a -> b -> b
`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
$cshowsPrec :: Int -> ParamOp -> ShowS
showsPrec :: Int -> ParamOp -> ShowS
$cshow :: ParamOp -> String
show :: ParamOp -> String
$cshowList :: ParamOps -> ShowS
showList :: ParamOps -> ShowS
Show, ParamOp -> ParamOp -> Bool
(ParamOp -> ParamOp -> Bool)
-> (ParamOp -> ParamOp -> Bool) -> Eq ParamOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamOp -> ParamOp -> Bool
== :: ParamOp -> ParamOp -> Bool
$c/= :: ParamOp -> ParamOp -> Bool
/= :: 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 :: 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
forall a b. a -> b -> b
`seq` CapExpression
expr
type CapParser a = Parsec String BuildState a
capExpressionParser :: CapParser BuildResults
capExpressionParser :: Parsec String BuildState BuildResults
capExpressionParser = do
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
return $ mconcat rs
paramEscapeParser :: CapParser BuildResults
paramEscapeParser :: Parsec String BuildState BuildResults
paramEscapeParser = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
incOffset 1
literalPercentParser <|> paramOpParser
literalPercentParser :: CapParser BuildResults
literalPercentParser :: Parsec String BuildState BuildResults
literalPercentParser = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
startOffset <- nextOffset <$> getState
incOffset 1
return $ BuildResults 0 [Bytes startOffset 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 -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'i'
incOffset 1
return $ BuildResults 0 [] [ IncFirstTwo ]
pushOpParser :: CapParser BuildResults
pushOpParser :: Parsec String BuildState BuildResults
pushOpParser = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'p'
paramN <- read . pure <$> digit
incOffset 2
return $ BuildResults (fromEnum paramN) [PushParam $ paramN - 1] []
decOutParser :: CapParser BuildResults
decOutParser :: Parsec String BuildState BuildResults
decOutParser = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'd'
incOffset 1
return $ BuildResults 0 [ DecOut ] []
charOutParser :: CapParser BuildResults
charOutParser :: Parsec String BuildState BuildResults
charOutParser = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'c'
incOffset 1
return $ BuildResults 0 [ CharOut ] []
conditionalOpParser :: CapParser BuildResults
conditionalOpParser :: Parsec String BuildState BuildResults
conditionalOpParser = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?'
incOffset 1
condPart <- manyExpr conditionalTrueParser
parts <- manyP
( do
truePart <- manyExpr $ choice [ try $ lookAhead conditionalEndParser
, conditionalFalseParser
]
falsePart <- manyExpr $ choice [ try $ lookAhead conditionalEndParser
, conditionalTrueParser
]
return ( truePart, falsePart )
)
conditionalEndParser
let 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, 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 n cond condParamOps = condPart
let n' = [Int] -> Int
forall a. Ord a => [a] -> a
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] -> Int
forall a. Ord a => [a] -> a
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 = (BuildResults -> CapOps) -> [BuildResults] -> [CapOps]
forall a b. (a -> b) -> [a] -> [b]
map BuildResults -> CapOps
outCapOps [BuildResults]
trueParts
falseOps = (BuildResults -> CapOps) -> [BuildResults] -> [CapOps]
forall a b. (a -> b) -> [a] -> [b]
map BuildResults -> CapOps
outCapOps [BuildResults]
falseParts
condParts = [CapOps] -> [CapOps] -> [(CapOps, CapOps)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CapOps]
trueOps [CapOps]
falseOps
let 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] -> 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] -> ParamOps
forall a. Monoid a => [a] -> a
mconcat [ParamOps
condParamOps, ParamOps
trueParamOps, ParamOps
falseParamOps]
return $ BuildResults n'' [ Conditional cond condParts ] 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 a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> ParsecT s u m [a]
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
, do !v <- ParsecT s u m a
p
!vs <- manyP p end
return $! v : 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 -> ParsecT String BuildState Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%t"
incOffset 2
conditionalFalseParser :: CapParser ()
conditionalFalseParser :: CapParser ()
conditionalFalseParser = do
_ <- String -> ParsecT String BuildState Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%e"
incOffset 2
conditionalEndParser :: CapParser ()
conditionalEndParser :: CapParser ()
conditionalEndParser = do
_ <- String -> ParsecT String BuildState Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%;"
incOffset 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 -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'
incOffset 1
return $ BuildResults 0 [ BitwiseOr ] [ ]
bitwiseAndParser :: CapParser BuildResults
bitwiseAndParser :: Parsec String BuildState BuildResults
bitwiseAndParser = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'&'
incOffset 1
return $ BuildResults 0 [ BitwiseAnd ] [ ]
bitwiseXorParser :: CapParser BuildResults
bitwiseXorParser :: Parsec String BuildState BuildResults
bitwiseXorParser = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^'
incOffset 1
return $ BuildResults 0 [ 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 -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'
incOffset 1
return $ BuildResults 0 [ ArithPlus ] [ ]
minusOp :: Parsec String BuildState BuildResults
minusOp = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
incOffset 1
return $ BuildResults 0 [ ArithMinus ] [ ]
literalIntOpParser :: CapParser BuildResults
literalIntOpParser :: Parsec String BuildState BuildResults
literalIntOpParser = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
incOffset 1
nStr <- many1 digit
incOffset $ toEnum $ length nStr
let n :: Word = read nStr
_ <- char '}'
incOffset 1
return $ BuildResults 0 [ PushValue 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 -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
incOffset 1
return $ BuildResults 0 [ CompareEq ] [ ]
compareLtOp :: Parsec String BuildState BuildResults
compareLtOp = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
incOffset 1
return $ BuildResults 0 [ CompareLt ] [ ]
compareGtOp :: Parsec String BuildState BuildResults
compareGtOp = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
incOffset 1
return $ BuildResults 0 [ CompareGt ] [ ]
bytesOpParser :: CapParser BuildResults
bytesOpParser :: Parsec String BuildState BuildResults
bytesOpParser = do
bytes <- ParsecT String BuildState Identity Char
-> ParsecT String BuildState Identity String
forall s u (m :: * -> *) a. 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
'%')
startOffset <- nextOffset <$> getState
let !c = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bytes
!s <- getState
let s' = BuildState
s { nextOffset = startOffset + c }
setState s'
return $ BuildResults 0 [Bytes startOffset c] []
charConstParser :: CapParser BuildResults
charConstParser :: Parsec String BuildState BuildResults
charConstParser = do
_ <- Char -> ParsecT String BuildState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
charValue <- liftM (toEnum . fromEnum) anyChar
_ <- char '\''
incOffset 3
return $ BuildResults 0 [ PushValue charValue ] [ ]
data BuildState = BuildState
{ BuildState -> Int
nextOffset :: Int
}
incOffset :: Int -> CapParser ()
incOffset :: Int -> CapParser ()
incOffset Int
n = do
s <- ParsecT String BuildState Identity BuildState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let s' = BuildState
s { nextOffset = nextOffset s + n }
setState 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 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