{- -----------------------------------------------------------------------------
Copyright 2019-2021 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

{-# LANGUAGE FlexibleInstances #-}

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,
  kwTraverse,
  kwTrue,
  kwType,
  kwTypename,
  kwTypes,
  kwUnittest,
  kwUpdate,
  kwValue,
  kwWeak,
  kwWhile,
  labeled,
  lineComment,
  lineEnd,
  merge2,
  merge3,
  noKeywords,
  noParamSelf,
  notAllowed,
  nullParse,
  operator,
  optionalSpace,
  paramSelf,
  parseAny2,
  parseAny3,
  parseBin,
  parseDec,
  parseHex,
  parseOct,
  parseSubOne,
  pragmaArgsEnd,
  pragmaArgsStart,
  pragmaEnd,
  pragmaStart,
  put12,
  put13,
  put22,
  put23,
  put33,
  quotedString,
  regexChar,
  sepAfter,
  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 qualified Data.Set as Set

import Base.CompilerError
import Parser.TextParser
import Types.TypeInstance (ParamName(ParamSelf))


class ParseFromSource a where
  -- Always prune whitespace and comments from back, but never from front!
  sourceParser :: TextParser a

labeled :: String -> TextParser a -> TextParser a
labeled :: String -> TextParser a -> TextParser a
labeled = String -> TextParser a -> TextParser a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label

escapeStart :: TextParser ()
escapeStart :: TextParser ()
escapeStart = TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"\\")

statementStart :: TextParser ()
statementStart :: TextParser ()
statementStart = TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"\\")

statementEnd :: TextParser ()
statementEnd :: TextParser ()
statementEnd = TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"")

valueSymbolGet :: TextParser ()
valueSymbolGet :: TextParser ()
valueSymbolGet = TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
".")

categorySymbolGet :: TextParser ()
categorySymbolGet :: TextParser ()
categorySymbolGet = String -> TextParser () -> TextParser ()
forall a. String -> TextParser a -> TextParser a
labeled String
":" (TextParser () -> TextParser ()) -> TextParser () -> TextParser ()
forall a b. (a -> b) -> a -> b
$ TextParser ()
useNewOperators TextParser () -> TextParser () -> TextParser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
":")

typeSymbolGet :: TextParser ()
typeSymbolGet :: TextParser ()
typeSymbolGet = String -> TextParser () -> TextParser ()
forall a. String -> TextParser a -> TextParser a
labeled String
"." (TextParser () -> TextParser ()) -> TextParser () -> TextParser ()
forall a b. (a -> b) -> a -> b
$ TextParser ()
useNewOperators TextParser () -> TextParser () -> TextParser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
".")

-- TODO: Remove this after a reasonable amount of time.
useNewOperators :: TextParser ()
useNewOperators :: TextParser ()
useNewOperators = TextParser ()
forall b. ParsecT CompilerMessage String Identity b
newCategory TextParser () -> TextParser () -> TextParser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ()
forall b. ParsecT CompilerMessage String Identity b
newType where
  newCategory :: ParsecT CompilerMessage String Identity b
newCategory = do
    String -> TextParser ()
string_ String
"$$"
    String -> ParsecT CompilerMessage String Identity b
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"use \":\" instead of \"$$\" to call @category functions"
  newType :: ParsecT CompilerMessage String Identity b
newType = do
    String -> TextParser ()
string_ String
"$"
    String -> ParsecT CompilerMessage String Identity b
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"use \".\" instead of \"$\" to call @type functions"

assignOperator :: TextParser ()
assignOperator :: TextParser ()
assignOperator = String -> TextParser String
operator String
"<-" TextParser String -> TextParser () -> TextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

infixFuncStart :: TextParser ()
infixFuncStart :: TextParser ()
infixFuncStart = TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"`")

infixFuncEnd :: TextParser ()
infixFuncEnd :: TextParser ()
infixFuncEnd = TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"`")

-- TODO: Maybe this should not use strings.
builtinValues :: TextParser String
builtinValues :: TextParser String
builtinValues = (TextParser String -> TextParser String -> TextParser String)
-> TextParser String -> [TextParser String] -> TextParser String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TextParser String -> TextParser String -> TextParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) TextParser String
forall (f :: * -> *) a. Alternative f => f a
empty ([TextParser String] -> TextParser String)
-> [TextParser String] -> TextParser String
forall a b. (a -> b) -> a -> b
$ (TextParser String -> TextParser String)
-> [TextParser String] -> [TextParser String]
forall a b. (a -> b) -> [a] -> [b]
map TextParser String -> TextParser String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try [
    TextParser ()
kwSelf TextParser () -> TextParser String -> TextParser String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> TextParser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"self"
  ]

kwAll :: TextParser ()
kwAll :: TextParser ()
kwAll = String -> TextParser ()
keyword String
"all"

kwAllows :: TextParser ()
kwAllows :: TextParser ()
kwAllows = String -> TextParser ()
keyword String
"allows"

kwAny :: TextParser ()
kwAny :: TextParser ()
kwAny = String -> TextParser ()
keyword String
"any"

kwBreak :: TextParser ()
kwBreak :: TextParser ()
kwBreak = String -> TextParser ()
keyword String
"break"

kwCategory :: TextParser ()
kwCategory :: TextParser ()
kwCategory = String -> TextParser ()
keyword String
"@category"

kwCleanup :: TextParser ()
kwCleanup :: TextParser ()
kwCleanup = String -> TextParser ()
keyword String
"cleanup"

kwConcrete :: TextParser ()
kwConcrete :: TextParser ()
kwConcrete = String -> TextParser ()
keyword String
"concrete"

kwContinue :: TextParser ()
kwContinue :: TextParser ()
kwContinue = String -> TextParser ()
keyword String
"continue"

kwDefine :: TextParser ()
kwDefine :: TextParser ()
kwDefine = String -> TextParser ()
keyword String
"define"

kwDefines :: TextParser ()
kwDefines :: TextParser ()
kwDefines = String -> TextParser ()
keyword String
"defines"

kwElif :: TextParser ()
kwElif :: TextParser ()
kwElif = String -> TextParser ()
keyword String
"elif"

kwElse :: TextParser ()
kwElse :: TextParser ()
kwElse = String -> TextParser ()
keyword String
"else"

kwEmpty :: TextParser ()
kwEmpty :: TextParser ()
kwEmpty = String -> TextParser ()
keyword String
"empty"

kwFail :: TextParser ()
kwFail :: TextParser ()
kwFail = String -> TextParser ()
keyword String
"fail"

kwFalse :: TextParser ()
kwFalse :: TextParser ()
kwFalse = String -> TextParser ()
keyword String
"false"

kwIf :: TextParser ()
kwIf :: TextParser ()
kwIf = String -> TextParser ()
keyword String
"if"

kwIn :: TextParser ()
kwIn :: TextParser ()
kwIn = String -> TextParser ()
keyword String
"in"

kwIgnore :: TextParser ()
kwIgnore :: TextParser ()
kwIgnore = String -> TextParser ()
keyword String
"_"

kwInterface :: TextParser ()
kwInterface :: TextParser ()
kwInterface = String -> TextParser ()
keyword String
"interface"

kwOptional :: TextParser ()
kwOptional :: TextParser ()
kwOptional = String -> TextParser ()
keyword String
"optional"

kwPresent :: TextParser ()
kwPresent :: TextParser ()
kwPresent = String -> TextParser ()
keyword String
"present"

kwReduce :: TextParser ()
kwReduce :: TextParser ()
kwReduce = String -> TextParser ()
keyword String
"reduce"

kwRefines :: TextParser ()
kwRefines :: TextParser ()
kwRefines = String -> TextParser ()
keyword String
"refines"

kwRequire :: TextParser ()
kwRequire :: TextParser ()
kwRequire = String -> TextParser ()
keyword String
"require"

kwRequires :: TextParser ()
kwRequires :: TextParser ()
kwRequires = String -> TextParser ()
keyword String
"requires"

kwReturn :: TextParser ()
kwReturn :: TextParser ()
kwReturn = String -> TextParser ()
keyword String
"return"

kwSelf :: TextParser ()
kwSelf :: TextParser ()
kwSelf = String -> TextParser ()
keyword String
"self"

kwScoped :: TextParser ()
kwScoped :: TextParser ()
kwScoped = String -> TextParser ()
keyword String
"scoped"

kwStrong :: TextParser ()
kwStrong :: TextParser ()
kwStrong = String -> TextParser ()
keyword String
"strong"

kwTestcase :: TextParser ()
kwTestcase :: TextParser ()
kwTestcase = String -> TextParser ()
keyword String
"testcase"

kwTraverse :: TextParser ()
kwTraverse :: TextParser ()
kwTraverse = String -> TextParser ()
keyword String
"traverse"

kwTrue :: TextParser ()
kwTrue :: TextParser ()
kwTrue = String -> TextParser ()
keyword String
"true"

kwType :: TextParser ()
kwType :: TextParser ()
kwType = String -> TextParser ()
keyword String
"@type"

kwTypename :: TextParser ()
kwTypename :: TextParser ()
kwTypename = String -> TextParser ()
keyword String
"typename"

kwTypes :: TextParser ()
kwTypes :: TextParser ()
kwTypes = String -> TextParser ()
keyword String
"types"

kwUnittest :: TextParser ()
kwUnittest :: TextParser ()
kwUnittest = String -> TextParser ()
keyword String
"unittest"

kwUpdate :: TextParser ()
kwUpdate :: TextParser ()
kwUpdate = String -> TextParser ()
keyword String
"update"

kwValue :: TextParser ()
kwValue :: TextParser ()
kwValue = String -> TextParser ()
keyword String
"@value"

kwWeak :: TextParser ()
kwWeak :: TextParser ()
kwWeak = String -> TextParser ()
keyword String
"weak"

kwWhile :: TextParser ()
kwWhile :: TextParser ()
kwWhile = String -> TextParser ()
keyword String
"while"

paramSelf :: TextParser ()
paramSelf :: TextParser ()
paramSelf = String -> TextParser ()
keyword (ParamName -> String
forall a. Show a => a -> String
show ParamName
ParamSelf)

noParamSelf :: TextParser ()
noParamSelf :: TextParser ()
noParamSelf = (TextParser () -> TextParser () -> TextParser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> TextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (TextParser () -> TextParser ()) -> TextParser () -> TextParser ()
forall a b. (a -> b) -> a -> b
$ do
  -- NOTE: This preserves the trailing whitespace so that the error context
  -- doesn't skip over whitespace or comments.
  TextParser () -> TextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (TextParser () -> TextParser ()) -> TextParser () -> TextParser ()
forall a b. (a -> b) -> a -> b
$ do
    String -> TextParser ()
string_ (ParamName -> String
forall a. Show a => a -> String
show ParamName
ParamSelf)
    ParsecT CompilerMessage String Identity Char -> TextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String
-> ParsecT CompilerMessage String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_')
  String -> TextParser ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"#self is not allowed here"

operatorSymbol :: TextParser Char
operatorSymbol :: ParsecT CompilerMessage String Identity Char
operatorSymbol = String
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall a. String -> TextParser a -> TextParser a
labeled String
"operator symbol" (ParsecT CompilerMessage String Identity Char
 -> ParsecT CompilerMessage String Identity Char)
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall a b. (a -> b) -> a -> b
$ (Token String -> Bool)
-> ParsecT CompilerMessage String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
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 :: TextParser ()
isKeyword :: TextParser ()
isKeyword = (TextParser () -> TextParser () -> TextParser ())
-> TextParser () -> [TextParser ()] -> TextParser ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TextParser () -> TextParser () -> TextParser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) TextParser ()
forall (f :: * -> *) a. Alternative f => f a
empty ([TextParser ()] -> TextParser ())
-> [TextParser ()] -> TextParser ()
forall a b. (a -> b) -> a -> b
$ (TextParser () -> TextParser ())
-> [TextParser ()] -> [TextParser ()]
forall a b. (a -> b) -> [a] -> [b]
map TextParser () -> TextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try [
    TextParser ()
kwAll,
    TextParser ()
kwAllows,
    TextParser ()
kwAny,
    TextParser ()
kwBreak,
    TextParser ()
kwCategory,
    TextParser ()
kwCleanup,
    TextParser ()
kwConcrete,
    TextParser ()
kwContinue,
    TextParser ()
kwDefine,
    TextParser ()
kwDefines,
    TextParser ()
kwElif,
    TextParser ()
kwElse,
    TextParser ()
kwEmpty,
    TextParser ()
kwFail,
    TextParser ()
kwFalse,
    TextParser ()
kwIf,
    TextParser ()
kwIn,
    TextParser ()
kwIgnore,
    TextParser ()
kwInterface,
    TextParser ()
kwOptional,
    TextParser ()
kwPresent,
    TextParser ()
kwReduce,
    TextParser ()
kwRefines,
    TextParser ()
kwRequire,
    TextParser ()
kwRequires,
    TextParser ()
kwReturn,
    TextParser ()
kwSelf,
    TextParser ()
kwScoped,
    TextParser ()
kwStrong,
    TextParser ()
kwTestcase,
    TextParser ()
kwTraverse,
    TextParser ()
kwTrue,
    TextParser ()
kwType,
    TextParser ()
kwTypename,
    TextParser ()
kwTypes,
    TextParser ()
kwUnittest,
    TextParser ()
kwUpdate,
    TextParser ()
kwValue,
    TextParser ()
kwWeak,
    TextParser ()
kwWhile
  ]

nullParse :: TextParser ()
nullParse :: TextParser ()
nullParse = () -> TextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

char_ :: Char -> TextParser ()
char_ :: Char -> TextParser ()
char_ = (ParsecT CompilerMessage String Identity Char
-> TextParser () -> TextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (ParsecT CompilerMessage String Identity Char -> TextParser ())
-> (Char -> ParsecT CompilerMessage String Identity Char)
-> Char
-> TextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char

string_ :: String -> TextParser ()
string_ :: String -> TextParser ()
string_ = (TextParser String -> TextParser () -> TextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (TextParser String -> TextParser ())
-> (String -> TextParser String) -> String -> TextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TextParser String
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string

lineEnd :: TextParser ()
lineEnd :: TextParser ()
lineEnd = (TextParser String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol TextParser String -> TextParser () -> TextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) TextParser () -> TextParser () -> TextParser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

lineComment :: TextParser String
lineComment :: TextParser String
lineComment = String -> TextParser String -> TextParser String
forall a. String -> TextParser a -> TextParser a
labeled String
"line comment" (TextParser String -> TextParser String)
-> TextParser String -> TextParser String
forall a b. (a -> b) -> a -> b
$
  TextParser ()
-> TextParser () -> TextParser String -> TextParser String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> TextParser ()
string_ String
"//")
          TextParser ()
lineEnd
          (ParsecT CompilerMessage String Identity Char -> TextParser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CompilerMessage String Identity Char -> TextParser String)
-> ParsecT CompilerMessage String Identity Char
-> TextParser String
forall a b. (a -> b) -> a -> b
$ (Token String -> Bool)
-> ParsecT CompilerMessage String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'))

blockComment :: TextParser String
blockComment :: TextParser String
blockComment = String -> TextParser String -> TextParser String
forall a. String -> TextParser a -> TextParser a
labeled String
"block comment" (TextParser String -> TextParser String)
-> TextParser String -> TextParser String
forall a b. (a -> b) -> a -> b
$
  TextParser ()
-> TextParser () -> TextParser String -> TextParser String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> TextParser ()
string_ String
"/*")
          (String -> TextParser ()
string_ String
"*/")
          (ParsecT CompilerMessage String Identity Char -> TextParser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CompilerMessage String Identity Char -> TextParser String)
-> ParsecT CompilerMessage String Identity Char
-> TextParser String
forall a b. (a -> b) -> a -> b
$ TextParser () -> TextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (String -> TextParser ()
string_ String
"*/") TextParser ()
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
asciiChar)

anyComment :: TextParser ()
anyComment :: TextParser ()
anyComment = String -> TextParser () -> TextParser ()
forall a. String -> TextParser a -> TextParser a
labeled String
"comment" (TextParser () -> TextParser ()) -> TextParser () -> TextParser ()
forall a b. (a -> b) -> a -> b
$ (TextParser String
blockComment TextParser String -> TextParser String -> TextParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser String
lineComment) TextParser String -> () -> TextParser ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

optionalSpace :: TextParser ()
optionalSpace :: TextParser ()
optionalSpace = TextParser () -> TextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (TextParser () -> TextParser ()) -> TextParser () -> TextParser ()
forall a b. (a -> b) -> a -> b
$ TextParser () -> ParsecT CompilerMessage String Identity [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (TextParser ()
anyComment TextParser () -> TextParser () -> TextParser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1) ParsecT CompilerMessage String Identity [()] -> () -> TextParser ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

sepAfter :: TextParser a -> TextParser a
sepAfter :: TextParser a -> TextParser a
sepAfter = TextParser () -> TextParser () -> TextParser a -> TextParser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between TextParser ()
nullParse TextParser ()
optionalSpace

sepAfter_ :: TextParser a -> TextParser ()
sepAfter_ :: TextParser a -> TextParser ()
sepAfter_ = (TextParser a -> TextParser () -> TextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (TextParser a -> TextParser ())
-> (TextParser a -> TextParser a) -> TextParser a -> TextParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextParser () -> TextParser () -> TextParser a -> TextParser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between TextParser ()
nullParse TextParser ()
optionalSpace

keyword :: String -> TextParser ()
keyword :: String -> TextParser ()
keyword String
s = String -> TextParser () -> TextParser ()
forall a. String -> TextParser a -> TextParser a
labeled String
s (TextParser () -> TextParser ()) -> TextParser () -> TextParser ()
forall a b. (a -> b) -> a -> b
$ TextParser () -> TextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (TextParser () -> TextParser ()) -> TextParser () -> TextParser ()
forall a b. (a -> b) -> a -> b
$ do
  String -> TextParser ()
string_ String
s
  ParsecT CompilerMessage String Identity Char -> TextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String
-> ParsecT CompilerMessage String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_')
  TextParser ()
optionalSpace

noKeywords :: TextParser ()
noKeywords :: TextParser ()
noKeywords = TextParser () -> TextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy TextParser ()
isKeyword

endOfDoc :: TextParser ()
endOfDoc :: TextParser ()
endOfDoc = String -> TextParser () -> TextParser ()
forall a. String -> TextParser a -> TextParser a
labeled String
"end of input" (TextParser () -> TextParser ()) -> TextParser () -> TextParser ()
forall a b. (a -> b) -> a -> b
$ TextParser ()
optionalSpace TextParser () -> TextParser () -> TextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

notAllowed :: TextParser a -> String -> TextParser ()
-- Based on implementation of notFollowedBy.
notAllowed :: TextParser a -> String -> TextParser ()
notAllowed TextParser a
p String
s = (TextParser a -> TextParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try TextParser a
p TextParser a -> TextParser () -> TextParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> TextParser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s) TextParser () -> TextParser () -> TextParser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> TextParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

pragmaStart :: TextParser ()
pragmaStart :: TextParser ()
pragmaStart = String -> TextParser ()
string_ String
"$"

pragmaEnd :: TextParser ()
pragmaEnd :: TextParser ()
pragmaEnd = String -> TextParser ()
string_ String
"$"

pragmaArgsStart :: TextParser ()
pragmaArgsStart :: TextParser ()
pragmaArgsStart = String -> TextParser ()
string_ String
"["

pragmaArgsEnd :: TextParser ()
pragmaArgsEnd :: TextParser ()
pragmaArgsEnd = String -> TextParser ()
string_ String
"]"

inferredParam :: TextParser ()
inferredParam :: TextParser ()
inferredParam = String -> TextParser ()
string_ String
"?"

operator :: String -> TextParser String
operator :: String -> TextParser String
operator String
o = String -> TextParser String -> TextParser String
forall a. String -> TextParser a -> TextParser a
labeled String
o (TextParser String -> TextParser String)
-> TextParser String -> TextParser String
forall a b. (a -> b) -> a -> b
$ do
  String -> TextParser ()
string_ String
o
  ParsecT CompilerMessage String Identity Char -> TextParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT CompilerMessage String Identity Char
operatorSymbol
  TextParser ()
optionalSpace
  String -> TextParser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
o

stringChar :: TextParser Char
stringChar :: ParsecT CompilerMessage String Identity Char
stringChar = ParsecT CompilerMessage String Identity Char
escaped ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CompilerMessage String Identity Char
ParsecT CompilerMessage String Identity (Token String)
notEscaped where
  escaped :: ParsecT CompilerMessage String Identity Char
escaped = String
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall a. String -> TextParser a -> TextParser a
labeled String
"escaped char sequence" (ParsecT CompilerMessage String Identity Char
 -> ParsecT CompilerMessage String Identity Char)
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall a b. (a -> b) -> a -> b
$ do
    Char -> TextParser ()
char_ Char
'\\'
    ParsecT CompilerMessage String Identity Char
octChar ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CompilerMessage String Identity Char
otherEscape where
      otherEscape :: ParsecT CompilerMessage String Identity Char
otherEscape = do
        Char
v <- ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
asciiChar
        case Char
v of
            Char
'\'' -> Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\''
            Char
'"' -> Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'"'
            Char
'?' -> Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'?'
            Char
'\\' -> Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\\'
            Char
'a' -> Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ParsecT CompilerMessage String Identity Char)
-> Char -> ParsecT CompilerMessage String Identity Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
7
            Char
'b' -> Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ParsecT CompilerMessage String Identity Char)
-> Char -> ParsecT CompilerMessage String Identity Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
8
            Char
'f' -> Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ParsecT CompilerMessage String Identity Char)
-> Char -> ParsecT CompilerMessage String Identity Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
12
            Char
'n' -> Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ParsecT CompilerMessage String Identity Char)
-> Char -> ParsecT CompilerMessage String Identity Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
10
            Char
'r' -> Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ParsecT CompilerMessage String Identity Char)
-> Char -> ParsecT CompilerMessage String Identity Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
13
            Char
't' -> Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ParsecT CompilerMessage String Identity Char)
-> Char -> ParsecT CompilerMessage String Identity Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
9
            Char
'v' -> Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ParsecT CompilerMessage String Identity Char)
-> Char -> ParsecT CompilerMessage String Identity Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
11
            Char
'x' -> ParsecT CompilerMessage String Identity Char
hexChar
            Char
_ -> String -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Char -> String
forall a. Show a => a -> String
show Char
v)
      octChar :: ParsecT CompilerMessage String Identity Char
octChar = String
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall a. String -> TextParser a -> TextParser a
labeled String
"3 octal chars" (ParsecT CompilerMessage String Identity Char
 -> ParsecT CompilerMessage String Identity Char)
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall a b. (a -> b) -> a -> b
$ do
        Int
o1 <- ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
octDigitChar ParsecT CompilerMessage String Identity Char
-> (Char -> ParsecT CompilerMessage String Identity Int)
-> ParsecT CompilerMessage String Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParsecT CompilerMessage String Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT CompilerMessage String Identity Int)
-> (Char -> Int)
-> Char
-> ParsecT CompilerMessage String Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitCharVal
        Int
o2 <- ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
octDigitChar ParsecT CompilerMessage String Identity Char
-> (Char -> ParsecT CompilerMessage String Identity Int)
-> ParsecT CompilerMessage String Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParsecT CompilerMessage String Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT CompilerMessage String Identity Int)
-> (Char -> Int)
-> Char
-> ParsecT CompilerMessage String Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitCharVal
        Int
o3 <- ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
octDigitChar ParsecT CompilerMessage String Identity Char
-> (Char -> ParsecT CompilerMessage String Identity Int)
-> ParsecT CompilerMessage String Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParsecT CompilerMessage String Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT CompilerMessage String Identity Int)
-> (Char -> Int)
-> Char
-> ParsecT CompilerMessage String Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitCharVal
        Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ParsecT CompilerMessage String Identity Char)
-> Char -> ParsecT CompilerMessage String Identity 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 :: ParsecT CompilerMessage String Identity Char
hexChar = String
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall a. String -> TextParser a -> TextParser a
labeled String
"2 hex chars" (ParsecT CompilerMessage String Identity Char
 -> ParsecT CompilerMessage String Identity Char)
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall a b. (a -> b) -> a -> b
$ do
        Int
h1 <- ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar ParsecT CompilerMessage String Identity Char
-> (Char -> ParsecT CompilerMessage String Identity Int)
-> ParsecT CompilerMessage String Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParsecT CompilerMessage String Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT CompilerMessage String Identity Int)
-> (Char -> Int)
-> Char
-> ParsecT CompilerMessage String Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitCharVal
        Int
h2 <- ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar ParsecT CompilerMessage String Identity Char
-> (Char -> ParsecT CompilerMessage String Identity Int)
-> ParsecT CompilerMessage String Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParsecT CompilerMessage String Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT CompilerMessage String Identity Int)
-> (Char -> Int)
-> Char
-> ParsecT CompilerMessage String Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitCharVal
        Char -> ParsecT CompilerMessage String Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ParsecT CompilerMessage String Identity Char)
-> Char -> ParsecT CompilerMessage String Identity 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 CompilerMessage String Identity (Token String)
notEscaped = [Token String]
-> ParsecT CompilerMessage String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
[Token String]
"\""

quotedString :: TextParser String
quotedString :: TextParser String
quotedString = do
  String -> TextParser ()
string_ String
"\""
  ParsecT CompilerMessage String Identity Char
-> TextParser () -> TextParser String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT CompilerMessage String Identity Char
stringChar (String -> TextParser ()
string_ String
"\"")

digitCharVal :: Char -> Int
digitCharVal :: Char -> Int
digitCharVal 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 :: TextParser Integer
parseDec :: TextParser Integer
parseDec = String -> TextParser Integer -> TextParser Integer
forall a. String -> TextParser a -> TextParser a
labeled String
"base-10" (TextParser Integer -> TextParser Integer)
-> TextParser Integer -> TextParser Integer
forall a b. (a -> b) -> a -> b
$ ((Integer, Integer) -> Integer)
-> ParsecT CompilerMessage String Identity (Integer, Integer)
-> TextParser 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 CompilerMessage String Identity (Integer, Integer)
 -> TextParser Integer)
-> ParsecT CompilerMessage String Identity (Integer, Integer)
-> TextParser Integer
forall a b. (a -> b) -> a -> b
$ Integer
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity (Integer, Integer)
parseIntCommon Integer
10 ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

parseHex :: TextParser Integer
parseHex :: TextParser Integer
parseHex = String -> TextParser Integer -> TextParser Integer
forall a. String -> TextParser a -> TextParser a
labeled String
"base-16" (TextParser Integer -> TextParser Integer)
-> TextParser Integer -> TextParser Integer
forall a b. (a -> b) -> a -> b
$ ((Integer, Integer) -> Integer)
-> ParsecT CompilerMessage String Identity (Integer, Integer)
-> TextParser 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 CompilerMessage String Identity (Integer, Integer)
 -> TextParser Integer)
-> ParsecT CompilerMessage String Identity (Integer, Integer)
-> TextParser Integer
forall a b. (a -> b) -> a -> b
$ Integer
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity (Integer, Integer)
parseIntCommon Integer
16 ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar

parseOct :: TextParser Integer
parseOct :: TextParser Integer
parseOct = String -> TextParser Integer -> TextParser Integer
forall a. String -> TextParser a -> TextParser a
labeled String
"base-8" (TextParser Integer -> TextParser Integer)
-> TextParser Integer -> TextParser Integer
forall a b. (a -> b) -> a -> b
$ ((Integer, Integer) -> Integer)
-> ParsecT CompilerMessage String Identity (Integer, Integer)
-> TextParser 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 CompilerMessage String Identity (Integer, Integer)
 -> TextParser Integer)
-> ParsecT CompilerMessage String Identity (Integer, Integer)
-> TextParser Integer
forall a b. (a -> b) -> a -> b
$ Integer
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity (Integer, Integer)
parseIntCommon Integer
8 ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
octDigitChar

parseBin :: TextParser Integer
parseBin :: TextParser Integer
parseBin = String -> TextParser Integer -> TextParser Integer
forall a. String -> TextParser a -> TextParser a
labeled String
"base-2" (TextParser Integer -> TextParser Integer)
-> TextParser Integer -> TextParser Integer
forall a b. (a -> b) -> a -> b
$ ((Integer, Integer) -> Integer)
-> ParsecT CompilerMessage String Identity (Integer, Integer)
-> TextParser 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 CompilerMessage String Identity (Integer, Integer)
 -> TextParser Integer)
-> ParsecT CompilerMessage String Identity (Integer, Integer)
-> TextParser Integer
forall a b. (a -> b) -> a -> b
$ Integer
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity (Integer, Integer)
parseIntCommon Integer
2 ([Token String]
-> ParsecT CompilerMessage String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
[Token String]
"01")

parseSubOne :: TextParser (Integer,Integer)
parseSubOne :: ParsecT CompilerMessage String Identity (Integer, Integer)
parseSubOne = Integer
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity (Integer, Integer)
parseIntCommon Integer
10 ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

parseIntCommon :: Integer -> TextParser Char -> TextParser (Integer,Integer)
parseIntCommon :: Integer
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity (Integer, Integer)
parseIntCommon Integer
b ParsecT CompilerMessage String Identity Char
p = do
  String
ds <- ParsecT CompilerMessage String Identity Char -> TextParser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CompilerMessage String Identity Char
p
  (Integer, Integer)
-> ParsecT CompilerMessage String Identity (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, Integer)
 -> ParsecT CompilerMessage String Identity (Integer, Integer))
-> (Integer, Integer)
-> ParsecT CompilerMessage 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
digitCharVal Char
y :: Integer))) (Integer
0,Integer
0) String
ds

regexChar :: TextParser String
regexChar :: TextParser String
regexChar = TextParser String
escaped TextParser String -> TextParser String -> TextParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser String
notEscaped where
  escaped :: TextParser String
escaped = do
    Char -> TextParser ()
char_ Char
'\\'
    Char
v <- ParsecT CompilerMessage String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
asciiChar
    case Char
v of
         Char
'"' -> String -> TextParser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"\""
         Char
_ -> String -> TextParser String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
'\\',Char
v]
  notEscaped :: TextParser String
notEscaped = (Char -> String)
-> ParsecT CompilerMessage String Identity Char
-> TextParser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (ParsecT CompilerMessage String Identity Char -> TextParser String)
-> ParsecT CompilerMessage String Identity Char
-> TextParser String
forall a b. (a -> b) -> a -> b
$ [Token String]
-> ParsecT CompilerMessage String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
[Token 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)

parseAny2 :: TextParser a -> TextParser b -> TextParser ([a],[b])
parseAny2 :: TextParser a -> TextParser b -> TextParser ([a], [b])
parseAny2 TextParser a
p1 TextParser b
p2 = TextParser ([a], [b])
-> TextParser ()
-> ParsecT CompilerMessage String Identity [([a], [b])]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy TextParser ([a], [b])
anyType TextParser ()
optionalSpace ParsecT CompilerMessage String Identity [([a], [b])]
-> ([([a], [b])] -> TextParser ([a], [b])) -> TextParser ([a], [b])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([a], [b]) -> TextParser ([a], [b])
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], [b]) -> TextParser ([a], [b]))
-> ([([a], [b])] -> ([a], [b]))
-> [([a], [b])]
-> TextParser ([a], [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([a], [b])] -> ([a], [b])
forall (f :: * -> *) a b.
(Foldable f, Monoid a, Monoid b) =>
f (a, b) -> (a, b)
merge2 where
  anyType :: TextParser ([a], [b])
anyType = TextParser ([a], [b])
forall a. ParsecT CompilerMessage String Identity ([a], [a])
p1' TextParser ([a], [b])
-> TextParser ([a], [b]) -> TextParser ([a], [b])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ([a], [b])
forall a. ParsecT CompilerMessage String Identity ([a], [b])
p2'
  p1' :: ParsecT CompilerMessage String Identity ([a], [a])
p1' = do
    a
x <- TextParser a
p1
    ([a], [a]) -> ParsecT CompilerMessage String Identity ([a], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([a
x],[])
  p2' :: ParsecT CompilerMessage String Identity ([a], [b])
p2' = do
    b
y <- TextParser b
p2
    ([a], [b]) -> ParsecT CompilerMessage String Identity ([a], [b])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[b
y])

parseAny3 :: TextParser a -> TextParser b -> TextParser c -> TextParser ([a],[b],[c])
parseAny3 :: TextParser a
-> TextParser b -> TextParser c -> TextParser ([a], [b], [c])
parseAny3 TextParser a
p1 TextParser b
p2 TextParser c
p3 = TextParser ([a], [b], [c])
-> TextParser ()
-> ParsecT CompilerMessage String Identity [([a], [b], [c])]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy TextParser ([a], [b], [c])
anyType TextParser ()
optionalSpace ParsecT CompilerMessage String Identity [([a], [b], [c])]
-> ([([a], [b], [c])] -> TextParser ([a], [b], [c]))
-> TextParser ([a], [b], [c])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([a], [b], [c]) -> TextParser ([a], [b], [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], [b], [c]) -> TextParser ([a], [b], [c]))
-> ([([a], [b], [c])] -> ([a], [b], [c]))
-> [([a], [b], [c])]
-> TextParser ([a], [b], [c])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([a], [b], [c])] -> ([a], [b], [c])
forall (f :: * -> *) a b c.
(Foldable f, Monoid a, Monoid b, Monoid c) =>
f (a, b, c) -> (a, b, c)
merge3 where
  anyType :: TextParser ([a], [b], [c])
anyType = TextParser ([a], [b], [c])
forall a a. ParsecT CompilerMessage String Identity ([a], [a], [a])
p1' TextParser ([a], [b], [c])
-> TextParser ([a], [b], [c]) -> TextParser ([a], [b], [c])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ([a], [b], [c])
forall a a. ParsecT CompilerMessage String Identity ([a], [b], [a])
p2' TextParser ([a], [b], [c])
-> TextParser ([a], [b], [c]) -> TextParser ([a], [b], [c])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ([a], [b], [c])
forall a a. ParsecT CompilerMessage String Identity ([a], [a], [c])
p3'
  p1' :: ParsecT CompilerMessage String Identity ([a], [a], [a])
p1' = do
    a
x <- TextParser a
p1
    ([a], [a], [a])
-> ParsecT CompilerMessage String Identity ([a], [a], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([a
x],[],[])
  p2' :: ParsecT CompilerMessage String Identity ([a], [b], [a])
p2' = do
    b
y <- TextParser b
p2
    ([a], [b], [a])
-> ParsecT CompilerMessage String Identity ([a], [b], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[b
y],[])
  p3' :: ParsecT CompilerMessage String Identity ([a], [a], [c])
p3' = do
    c
z <- TextParser c
p3
    ([a], [a], [c])
-> ParsecT CompilerMessage String Identity ([a], [a], [c])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[],[c
z])