{-# LANGUAGE Safe #-}
module Parser.Common (
ParseFromSource(..),
anyComment,
assignOperator,
blockComment,
builtinValues,
categorySymbolGet,
char_,
endOfDoc,
escapeStart,
inferredParam,
infixFuncEnd,
infixFuncStart,
keyword,
kwAll,
kwAllows,
kwAny,
kwBreak,
kwCategory,
kwCleanup,
kwConcrete,
kwContinue,
kwDefine,
kwDefines,
kwElif,
kwElse,
kwEmpty,
kwFail,
kwFalse,
kwIf,
kwIgnore,
kwIn,
kwInterface,
kwOptional,
kwPresent,
kwReduce,
kwRefines,
kwRequire,
kwRequires,
kwReturn,
kwScoped,
kwSelf,
kwStrong,
kwTestcase,
kwTrue,
kwType,
kwTypename,
kwTypes,
kwUpdate,
kwValue,
kwWeak,
kwWhile,
labeled,
lineComment,
lineEnd,
merge2,
merge3,
noKeywords,
notAllowed,
nullParse,
operator,
optionalSpace,
parseBin,
parseDec,
parseHex,
parseOct,
parseSubOne,
pragmaArgsEnd,
pragmaArgsStart,
pragmaEnd,
pragmaStart,
put12,
put13,
put22,
put23,
put33,
regexChar,
requiredSpace,
sepAfter,
sepAfter1,
sepAfter_,
statementEnd,
statementStart,
stringChar,
string_,
typeSymbolGet,
valueSymbolGet,
) where
import Data.Char
import Data.Foldable
import Data.Functor
import Data.Monoid
import Prelude hiding (foldl,foldr)
import Text.Parsec
import Text.Parsec.String
import qualified Data.Set as Set
class ParseFromSource a where
sourceParser :: Parser a
labeled :: String -> Parser a -> Parser a
labeled :: String -> Parser a -> Parser a
labeled = (Parser a -> String -> Parser a) -> String -> Parser a -> Parser a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser a -> String -> Parser a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
label
escapeStart :: Parser ()
escapeStart :: Parser ()
escapeStart = Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
string_ String
"\\")
statementStart :: Parser ()
statementStart :: Parser ()
statementStart = Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
string_ String
"\\")
statementEnd :: Parser ()
statementEnd :: Parser ()
statementEnd = Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
string_ String
"")
valueSymbolGet :: Parser ()
valueSymbolGet :: Parser ()
valueSymbolGet = Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
string_ String
".")
categorySymbolGet :: Parser ()
categorySymbolGet :: Parser ()
categorySymbolGet = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
labeled String
":" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ()
useNewOperators Parser () -> Parser () -> Parser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
string_ String
":")
typeSymbolGet :: Parser ()
typeSymbolGet :: Parser ()
typeSymbolGet = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
labeled String
"." (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ()
useNewOperators Parser () -> Parser () -> Parser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
string_ String
".")
useNewOperators :: Parser ()
useNewOperators :: Parser ()
useNewOperators = Parser ()
forall b. ParsecT String () Identity b
newCategory Parser () -> Parser () -> Parser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ()
forall b. ParsecT String () Identity b
newType where
newCategory :: ParsecT String () Identity b
newCategory = do
Parser () -> Parser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
string_ String
"$$"
String -> ParsecT String () Identity b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"use \":\" instead of \"$$\" to call @category functions"
newType :: ParsecT String () Identity b
newType = do
Parser () -> Parser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
string_ String
"$"
String -> ParsecT String () Identity b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"use \".\" instead of \"$\" to call @type functions"
assignOperator :: Parser ()
assignOperator :: Parser ()
assignOperator = String -> Parser String
operator String
"<-" Parser String -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
infixFuncStart :: Parser ()
infixFuncStart :: Parser ()
infixFuncStart = Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
string_ String
"`")
infixFuncEnd :: Parser ()
infixFuncEnd :: Parser ()
infixFuncEnd = Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
string_ String
"`")
builtinValues :: Parser String
builtinValues :: Parser String
builtinValues = (Parser String -> Parser String -> Parser String)
-> Parser String -> [Parser String] -> Parser String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) (String -> Parser String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty") ([Parser String] -> Parser String)
-> [Parser String] -> Parser String
forall a b. (a -> b) -> a -> b
$ (Parser String -> Parser String)
-> [Parser String] -> [Parser String]
forall a b. (a -> b) -> [a] -> [b]
map Parser String -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try [
Parser ()
kwSelf Parser () -> Parser String -> Parser String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"self"
]
kwAll :: Parser ()
kwAll :: Parser ()
kwAll = String -> Parser ()
keyword String
"all"
kwAllows :: Parser ()
kwAllows :: Parser ()
kwAllows = String -> Parser ()
keyword String
"allows"
kwAny :: Parser ()
kwAny :: Parser ()
kwAny = String -> Parser ()
keyword String
"any"
kwBreak :: Parser ()
kwBreak :: Parser ()
kwBreak = String -> Parser ()
keyword String
"break"
kwCategory :: Parser ()
kwCategory :: Parser ()
kwCategory = String -> Parser ()
keyword String
"@category"
kwCleanup :: Parser ()
kwCleanup :: Parser ()
kwCleanup = String -> Parser ()
keyword String
"cleanup"
kwConcrete :: Parser ()
kwConcrete :: Parser ()
kwConcrete = String -> Parser ()
keyword String
"concrete"
kwContinue :: Parser ()
kwContinue :: Parser ()
kwContinue = String -> Parser ()
keyword String
"continue"
kwDefine :: Parser ()
kwDefine :: Parser ()
kwDefine = String -> Parser ()
keyword String
"define"
kwDefines :: Parser ()
kwDefines :: Parser ()
kwDefines = String -> Parser ()
keyword String
"defines"
kwElif :: Parser ()
kwElif :: Parser ()
kwElif = String -> Parser ()
keyword String
"elif"
kwElse :: Parser ()
kwElse :: Parser ()
kwElse = String -> Parser ()
keyword String
"else"
kwEmpty :: Parser ()
kwEmpty :: Parser ()
kwEmpty = String -> Parser ()
keyword String
"empty"
kwFail :: Parser ()
kwFail :: Parser ()
kwFail = String -> Parser ()
keyword String
"fail"
kwFalse :: Parser ()
kwFalse :: Parser ()
kwFalse = String -> Parser ()
keyword String
"false"
kwIf :: Parser ()
kwIf :: Parser ()
kwIf = String -> Parser ()
keyword String
"if"
kwIn :: Parser ()
kwIn :: Parser ()
kwIn = String -> Parser ()
keyword String
"in"
kwIgnore :: Parser ()
kwIgnore :: Parser ()
kwIgnore = String -> Parser ()
keyword String
"_"
kwInterface :: Parser ()
kwInterface :: Parser ()
kwInterface = String -> Parser ()
keyword String
"interface"
kwOptional :: Parser ()
kwOptional :: Parser ()
kwOptional = String -> Parser ()
keyword String
"optional"
kwPresent :: Parser ()
kwPresent :: Parser ()
kwPresent = String -> Parser ()
keyword String
"present"
kwReduce :: Parser ()
kwReduce :: Parser ()
kwReduce = String -> Parser ()
keyword String
"reduce"
kwRefines :: Parser ()
kwRefines :: Parser ()
kwRefines = String -> Parser ()
keyword String
"refines"
kwRequire :: Parser ()
kwRequire :: Parser ()
kwRequire = String -> Parser ()
keyword String
"require"
kwRequires :: Parser ()
kwRequires :: Parser ()
kwRequires = String -> Parser ()
keyword String
"requires"
kwReturn :: Parser ()
kwReturn :: Parser ()
kwReturn = String -> Parser ()
keyword String
"return"
kwSelf :: Parser ()
kwSelf :: Parser ()
kwSelf = String -> Parser ()
keyword String
"self"
kwScoped :: Parser ()
kwScoped :: Parser ()
kwScoped = String -> Parser ()
keyword String
"scoped"
kwStrong :: Parser ()
kwStrong :: Parser ()
kwStrong = String -> Parser ()
keyword String
"strong"
kwTestcase :: Parser ()
kwTestcase :: Parser ()
kwTestcase = String -> Parser ()
keyword String
"testcase"
kwTrue :: Parser ()
kwTrue :: Parser ()
kwTrue = String -> Parser ()
keyword String
"true"
kwType :: Parser ()
kwType :: Parser ()
kwType = String -> Parser ()
keyword String
"@type"
kwTypename :: Parser ()
kwTypename :: Parser ()
kwTypename = String -> Parser ()
keyword String
"typename"
kwTypes :: Parser ()
kwTypes :: Parser ()
kwTypes = String -> Parser ()
keyword String
"types"
kwUpdate :: Parser ()
kwUpdate :: Parser ()
kwUpdate = String -> Parser ()
keyword String
"update"
kwValue :: Parser ()
kwValue :: Parser ()
kwValue = String -> Parser ()
keyword String
"@value"
kwWeak :: Parser ()
kwWeak :: Parser ()
kwWeak = String -> Parser ()
keyword String
"weak"
kwWhile :: Parser ()
kwWhile :: Parser ()
kwWhile = String -> Parser ()
keyword String
"while"
operatorSymbol :: Parser Char
operatorSymbol :: Parser Char
operatorSymbol = String -> Parser Char -> Parser Char
forall a. String -> Parser a -> Parser a
labeled String
"operator symbol" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` String -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList String
"+-*/%=!<>&|")
isKeyword :: Parser ()
isKeyword :: Parser ()
isKeyword = (Parser () -> Parser () -> Parser ())
-> Parser () -> [Parser ()] -> Parser ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Parser () -> Parser () -> Parser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) Parser ()
nullParse ([Parser ()] -> Parser ()) -> [Parser ()] -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Parser () -> Parser ()) -> [Parser ()] -> [Parser ()]
forall a b. (a -> b) -> [a] -> [b]
map Parser () -> Parser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try [
Parser ()
kwAll,
Parser ()
kwAllows,
Parser ()
kwAny,
Parser ()
kwBreak,
Parser ()
kwCategory,
Parser ()
kwCleanup,
Parser ()
kwConcrete,
Parser ()
kwContinue,
Parser ()
kwDefine,
Parser ()
kwDefines,
Parser ()
kwElif,
Parser ()
kwElse,
Parser ()
kwEmpty,
Parser ()
kwFail,
Parser ()
kwFalse,
Parser ()
kwIf,
Parser ()
kwIn,
Parser ()
kwIgnore,
Parser ()
kwInterface,
Parser ()
kwOptional,
Parser ()
kwPresent,
Parser ()
kwReduce,
Parser ()
kwRefines,
Parser ()
kwRequire,
Parser ()
kwRequires,
Parser ()
kwReturn,
Parser ()
kwSelf,
Parser ()
kwScoped,
Parser ()
kwStrong,
Parser ()
kwTestcase,
Parser ()
kwTrue,
Parser ()
kwType,
Parser ()
kwTypename,
Parser ()
kwTypes,
Parser ()
kwUpdate,
Parser ()
kwValue,
Parser ()
kwWeak,
Parser ()
kwWhile
]
nullParse :: Parser ()
nullParse :: Parser ()
nullParse = () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
char_ :: Char -> Parser ()
char_ :: Char -> Parser ()
char_ = (Parser Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Parser Char -> Parser ())
-> (Char -> Parser Char) -> Char -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char
string_ :: String -> Parser ()
string_ :: String -> Parser ()
string_ = (Parser String -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Parser String -> Parser ())
-> (String -> Parser String) -> String -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string
lineEnd :: Parser ()
lineEnd :: Parser ()
lineEnd = (Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine Parser Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Parser () -> Parser () -> Parser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ()
endOfDoc
lineComment :: Parser String
= Parser () -> Parser () -> Parser String -> Parser String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (String -> Parser ()
string_ String
"//")
Parser ()
lineEnd
(Parser Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Parser Char -> Parser String) -> Parser Char -> Parser String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser 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
'\n'))
blockComment :: Parser String
= Parser () -> Parser () -> Parser String -> Parser String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (String -> Parser ()
string_ String
"/*")
(String -> Parser ()
string_ String
"*/")
(Parser Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Parser Char -> Parser String) -> Parser Char -> Parser String
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (String -> Parser ()
string_ String
"*/") Parser () -> Parser Char -> Parser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
anyComment :: Parser String
= Parser String -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser String
blockComment Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser String
lineComment
optionalSpace :: Parser ()
optionalSpace :: Parser ()
optionalSpace = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
labeled String
"" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser String -> ParsecT String () Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Parser String
anyComment Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space) ParsecT String () Identity [String] -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
nullParse
requiredSpace :: Parser ()
requiredSpace :: Parser ()
requiredSpace = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
labeled String
"break" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof Parser () -> Parser () -> Parser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Parser String -> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Parser String
anyComment Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space) ParsecT String () Identity [String] -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
nullParse)
sepAfter :: Parser a -> Parser a
sepAfter :: Parser a -> Parser a
sepAfter = Parser () -> Parser () -> Parser a -> Parser a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between Parser ()
nullParse Parser ()
optionalSpace
sepAfter_ :: Parser a -> Parser ()
sepAfter_ :: Parser a -> Parser ()
sepAfter_ = (Parser a -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Parser a -> Parser ())
-> (Parser a -> Parser a) -> Parser a -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Parser () -> Parser a -> Parser a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between Parser ()
nullParse Parser ()
optionalSpace
sepAfter1 :: Parser a -> Parser a
sepAfter1 :: Parser a -> Parser a
sepAfter1 = Parser () -> Parser () -> Parser a -> Parser a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between Parser ()
nullParse Parser ()
requiredSpace
keyword :: String -> Parser ()
keyword :: String -> Parser ()
keyword String
s = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
labeled String
s (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
s Parser String -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
labeled String
"" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser String -> Parser ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Parser Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum))
noKeywords :: Parser ()
noKeywords :: Parser ()
noKeywords = Parser () -> Parser ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy Parser ()
isKeyword
endOfDoc :: Parser ()
endOfDoc :: Parser ()
endOfDoc = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
labeled String
"" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ()
optionalSpace Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
notAllowed :: Parser a -> String -> Parser ()
notAllowed :: Parser a -> String -> Parser ()
notAllowed Parser a
p String
s = (Parser a -> Parser a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser a
p Parser a -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s) Parser () -> Parser () -> Parser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pragmaStart :: Parser ()
pragmaStart :: Parser ()
pragmaStart = String -> Parser ()
string_ String
"$"
pragmaEnd :: Parser ()
pragmaEnd :: Parser ()
pragmaEnd = String -> Parser ()
string_ String
"$"
pragmaArgsStart :: Parser ()
pragmaArgsStart :: Parser ()
pragmaArgsStart = String -> Parser ()
string_ String
"["
pragmaArgsEnd :: Parser ()
pragmaArgsEnd :: Parser ()
pragmaArgsEnd = String -> Parser ()
string_ String
"]"
inferredParam :: Parser ()
inferredParam :: Parser ()
inferredParam = String -> Parser ()
string_ String
"?"
operator :: String -> Parser String
operator :: String -> Parser String
operator String
o = String -> Parser String -> Parser String
forall a. String -> Parser a -> Parser a
labeled String
o (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ do
String -> Parser ()
string_ String
o
Parser Char -> Parser ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy Parser Char
operatorSymbol
Parser ()
optionalSpace
String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
o
stringChar :: Parser Char
stringChar :: Parser Char
stringChar = Parser Char
escaped Parser Char -> Parser Char -> Parser Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Char
forall u. ParsecT String u Identity Char
notEscaped where
escaped :: Parser Char
escaped = String -> Parser Char -> Parser Char
forall a. String -> Parser a -> Parser a
labeled String
"escaped char sequence" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ do
Char -> Parser ()
char_ Char
'\\'
Parser Char
octChar Parser Char -> Parser Char -> Parser Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Char
otherEscape where
otherEscape :: Parser Char
otherEscape = do
Char
v <- Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
case Char
v of
Char
'\'' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\''
Char
'"' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'"'
Char
'?' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'?'
Char
'\\' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\\'
Char
'a' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
7
Char
'b' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
8
Char
'f' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
12
Char
'n' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
10
Char
'r' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
13
Char
't' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
9
Char
'v' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
11
Char
'x' -> Parser Char
hexChar
Char
_ -> String -> Parser Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Char -> String
forall a. Show a => a -> String
show Char
v)
octChar :: Parser Char
octChar = String -> Parser Char -> Parser Char
forall a. String -> Parser a -> Parser a
labeled String
"3 octal chars" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ do
Int
o1 <- Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit Parser Char
-> (Char -> ParsecT String () Identity Int)
-> ParsecT String () Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParsecT String () Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT String () Identity Int)
-> (Char -> Int) -> Char -> ParsecT String () Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitVal
Int
o2 <- Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit Parser Char
-> (Char -> ParsecT String () Identity Int)
-> ParsecT String () Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParsecT String () Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT String () Identity Int)
-> (Char -> Int) -> Char -> ParsecT String () Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitVal
Int
o3 <- Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit Parser Char
-> (Char -> ParsecT String () Identity Int)
-> ParsecT String () Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParsecT String () Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT String () Identity Int)
-> (Char -> Int) -> Char -> ParsecT String () Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitVal
Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
o1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
o2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o3
hexChar :: Parser Char
hexChar = String -> Parser Char -> Parser Char
forall a. String -> Parser a -> Parser a
labeled String
"2 hex chars" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ do
Int
h1 <- Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit Parser Char
-> (Char -> ParsecT String () Identity Int)
-> ParsecT String () Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParsecT String () Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT String () Identity Int)
-> (Char -> Int) -> Char -> ParsecT String () Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitVal
Int
h2 <- Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit Parser Char
-> (Char -> ParsecT String () Identity Int)
-> ParsecT String () Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParsecT String () Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT String () Identity Int)
-> (Char -> Int) -> Char -> ParsecT String () Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitVal
Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
16Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h2
notEscaped :: ParsecT String u Identity Char
notEscaped = String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\""
digitVal :: Char -> Int
digitVal :: Char -> Int
digitVal Char
c
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Char -> Int
ord(Char
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord(Char
'0')
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F' = Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord(Char
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord(Char
'A')
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f' = Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord(Char
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord(Char
'a')
| Bool
otherwise = Int
forall a. HasCallStack => a
undefined
parseDec :: Parser Integer
parseDec :: Parser Integer
parseDec = ((Integer, Integer) -> Integer)
-> ParsecT String () Identity (Integer, Integer) -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, Integer) -> Integer
forall a b. (a, b) -> b
snd (ParsecT String () Identity (Integer, Integer) -> Parser Integer)
-> ParsecT String () Identity (Integer, Integer) -> Parser Integer
forall a b. (a -> b) -> a -> b
$ Integer
-> Parser Char -> ParsecT String () Identity (Integer, Integer)
parseIntCommon Integer
10 Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
parseHex :: Parser Integer
parseHex :: Parser Integer
parseHex = ((Integer, Integer) -> Integer)
-> ParsecT String () Identity (Integer, Integer) -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, Integer) -> Integer
forall a b. (a, b) -> b
snd (ParsecT String () Identity (Integer, Integer) -> Parser Integer)
-> ParsecT String () Identity (Integer, Integer) -> Parser Integer
forall a b. (a -> b) -> a -> b
$ Integer
-> Parser Char -> ParsecT String () Identity (Integer, Integer)
parseIntCommon Integer
16 Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
parseOct :: Parser Integer
parseOct :: Parser Integer
parseOct = ((Integer, Integer) -> Integer)
-> ParsecT String () Identity (Integer, Integer) -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, Integer) -> Integer
forall a b. (a, b) -> b
snd (ParsecT String () Identity (Integer, Integer) -> Parser Integer)
-> ParsecT String () Identity (Integer, Integer) -> Parser Integer
forall a b. (a -> b) -> a -> b
$ Integer
-> Parser Char -> ParsecT String () Identity (Integer, Integer)
parseIntCommon Integer
8 Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit
parseBin :: Parser Integer
parseBin :: Parser Integer
parseBin = ((Integer, Integer) -> Integer)
-> ParsecT String () Identity (Integer, Integer) -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, Integer) -> Integer
forall a b. (a, b) -> b
snd (ParsecT String () Identity (Integer, Integer) -> Parser Integer)
-> ParsecT String () Identity (Integer, Integer) -> Parser Integer
forall a b. (a -> b) -> a -> b
$ Integer
-> Parser Char -> ParsecT String () Identity (Integer, Integer)
parseIntCommon Integer
2 (String -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"01")
parseSubOne :: Parser (Integer,Integer)
parseSubOne :: ParsecT String () Identity (Integer, Integer)
parseSubOne = Integer
-> Parser Char -> ParsecT String () Identity (Integer, Integer)
parseIntCommon Integer
10 Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
parseIntCommon :: Integer -> Parser Char -> Parser (Integer,Integer)
parseIntCommon :: Integer
-> Parser Char -> ParsecT String () Identity (Integer, Integer)
parseIntCommon Integer
b Parser Char
p = do
String
ds <- Parser Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 Parser Char
p
(Integer, Integer) -> ParsecT String () Identity (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, Integer)
-> ParsecT String () Identity (Integer, Integer))
-> (Integer, Integer)
-> ParsecT String () Identity (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ ((Integer, Integer) -> Char -> (Integer, Integer))
-> (Integer, Integer) -> String -> (Integer, Integer)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\(Integer
n,Integer
x) Char
y -> (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1,Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Char -> Int
digitVal Char
y :: Integer))) (Integer
0,Integer
0) String
ds
regexChar :: Parser String
regexChar :: Parser String
regexChar = Parser String
escaped Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
forall u. ParsecT String u Identity String
notEscaped where
escaped :: Parser String
escaped = do
Char -> Parser ()
char_ Char
'\\'
Char
v <- Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
case Char
v of
Char
'"' -> String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"\""
Char
_ -> String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
'\\',Char
v]
notEscaped :: ParsecT String u Identity String
notEscaped = (Char -> String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (ParsecT String u Identity Char
-> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\""
put12 :: (Functor m, Monad m) => m a -> m ([a],[b])
put12 :: m a -> m ([a], [b])
put12 = (a -> ([a], [b])) -> m a -> m ([a], [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ([a], [b])
forall a a. a -> ([a], [a])
put where put :: a -> ([a], [a])
put a
x = ([a
x],[])
put22 :: (Functor m, Monad m) => m b -> m ([a],[b])
put22 :: m b -> m ([a], [b])
put22 = (b -> ([a], [b])) -> m b -> m ([a], [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> ([a], [b])
forall a a. a -> ([a], [a])
put where put :: a -> ([a], [a])
put a
x = ([],[a
x])
merge2 :: (Foldable f, Monoid a, Monoid b) => f (a,b) -> (a,b)
merge2 :: f (a, b) -> (a, b)
merge2 = ((a, b) -> (a, b) -> (a, b)) -> (a, b) -> f (a, b) -> (a, b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a, b) -> (a, b) -> (a, b)
forall a b.
(Semigroup a, Semigroup b) =>
(a, b) -> (a, b) -> (a, b)
merge (a
forall a. Monoid a => a
mempty,b
forall a. Monoid a => a
mempty) where
merge :: (a, b) -> (a, b) -> (a, b)
merge (a
xs1,b
ys1) (a
xs2,b
ys2) = (a
xs1a -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
xs2,b
ys1b -> b -> b
forall a. Semigroup a => a -> a -> a
<>b
ys2)
put13 :: (Functor m, Monad m) => m a -> m ([a],[b],[c])
put13 :: m a -> m ([a], [b], [c])
put13 = (a -> ([a], [b], [c])) -> m a -> m ([a], [b], [c])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ([a], [b], [c])
forall a a a. a -> ([a], [a], [a])
put where put :: a -> ([a], [a], [a])
put a
x = ([a
x],[],[])
put23 :: (Functor m, Monad m) => m b -> m ([a],[b],[c])
put23 :: m b -> m ([a], [b], [c])
put23 = (b -> ([a], [b], [c])) -> m b -> m ([a], [b], [c])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> ([a], [b], [c])
forall a a a. a -> ([a], [a], [a])
put where put :: a -> ([a], [a], [a])
put a
x = ([],[a
x],[])
put33 :: (Functor m, Monad m) => m c -> m ([a],[b],[c])
put33 :: m c -> m ([a], [b], [c])
put33 = (c -> ([a], [b], [c])) -> m c -> m ([a], [b], [c])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> ([a], [b], [c])
forall a a a. a -> ([a], [a], [a])
put where put :: a -> ([a], [a], [a])
put a
x = ([],[],[a
x])
merge3 :: (Foldable f, Monoid a, Monoid b, Monoid c) => f (a,b,c) -> (a,b,c)
merge3 :: f (a, b, c) -> (a, b, c)
merge3 = ((a, b, c) -> (a, b, c) -> (a, b, c))
-> (a, b, c) -> f (a, b, c) -> (a, b, c)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a, b, c) -> (a, b, c) -> (a, b, c)
forall a b c.
(Semigroup a, Semigroup b, Semigroup c) =>
(a, b, c) -> (a, b, c) -> (a, b, c)
merge (a
forall a. Monoid a => a
mempty,b
forall a. Monoid a => a
mempty,c
forall a. Monoid a => a
mempty) where
merge :: (a, b, c) -> (a, b, c) -> (a, b, c)
merge (a
xs1,b
ys1,c
zs1) (a
xs2,b
ys2,c
zs2) = (a
xs1a -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
xs2,b
ys1b -> b -> b
forall a. Semigroup a => a -> a -> a
<>b
ys2,c
zs1c -> c -> c
forall a. Semigroup a => a -> a -> a
<>c
zs2)