{-# LANGUAGE FlexibleContexts #-}
{- |
Module      :  ./Common/Lexer.hs
Description :  scanner for Casl tokens using Parsec
Copyright   :  (c) Christian Maeder and Uni Bremen 2002-2005
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

Scanner for Casl tokens using Parsec <http://www.cs.uu.nl/~daan/parsec.html>
according to chapter II.4 (Lexical Symbols) of the CASL reference manual
-}

module Common.Lexer where

import Common.Id
import Common.Parsec
import Text.ParserCombinators.Parsec
import qualified Text.ParserCombinators.Parsec.Pos as Pos

import Control.Monad
import qualified Control.Monad.Fail as Fail
import Data.Char
import Data.List

-- * positions from "Text.ParserCombinators.Parsec.Pos" starting at (1,1)

-- | no-bracket-signs (excluding mu!)
isSignChar :: Char -> Bool
isSignChar :: Char -> Bool
isSignChar c :: Char
c = if Char -> Bool
isAscii Char
c then Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c "!#$&*+-./:<=>?@\\^|~" else
  Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSymbol Char
c Bool -> Bool -> Bool
|| Char -> Bool
Data.Char.isNumber Char
c

-- \172 neg \183 middle dot \215 times

-- at least two semicolons
semis :: CharParser st String
semis :: CharParser st [Char]
semis = [Char] -> CharParser st [Char]
forall st. [Char] -> CharParser st [Char]
tryString ";;" CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> ParsecT [Char] st Identity Char -> CharParser st [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ';')

scanAnySigns :: CharParser st String
scanAnySigns :: CharParser st [Char]
scanAnySigns =
    ParsecT [Char] st Identity Char -> CharParser st [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSignChar ParsecT [Char] st Identity Char
-> [Char] -> ParsecT [Char] st Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "casl sign") CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st [Char]
forall st. CharParser st [Char]
semis CharParser st [Char] -> [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "signs"

-- | casl letters (all isAlpha including feminine and masculine ordinal and mu)
caslLetters :: Char -> Bool
caslLetters :: Char -> Bool
caslLetters = Char -> Bool
isAlpha

-- ['A'..'Z'] ++ ['a'..'z'] ++

{- see <http://www.htmlhelp.com/reference/charset/> starting from \192
\208 ETH \215 times \222 THORN \240 eth \247 divide \254 thorn
excluded are:
\170 feminine ordinal \181 micro sign (mu) \186 masculine ordinal
 -}

caslLetter :: CharParser st Char
caslLetter :: CharParser st Char
caslLetter = (Char -> Bool) -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
caslLetters CharParser st Char -> [Char] -> CharParser st Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "casl letter"

scanLPD :: CharParser st Char
scanLPD :: CharParser st Char
scanLPD = CharParser st Char
forall st. CharParser st Char
caslLetter CharParser st Char -> CharParser st Char -> CharParser st Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit CharParser st Char -> CharParser st Char -> CharParser st Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\'' CharParser st Char -> [Char] -> CharParser st Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "casl char"

-- * ParsecCombinator extension

lookaheadPosition :: String
lookaheadPosition :: [Char]
lookaheadPosition = "lookahead position "

myLookAhead :: GenParser tok st a -> GenParser tok st a
myLookAhead :: GenParser tok st a -> GenParser tok st a
myLookAhead parser :: GenParser tok st a
parser = do
    State [tok] st
state <- ParsecT [tok] st Identity (State [tok] st)
forall (m :: * -> *) s u. Monad m => ParsecT s u m (State s u)
getParserState
    Maybe a
x <- (a -> Maybe a)
-> GenParser tok st a -> ParsecT [tok] st Identity (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just GenParser tok st a
parser ParsecT [tok] st Identity (Maybe a)
-> ParsecT [tok] st Identity (Maybe a)
-> ParsecT [tok] st Identity (Maybe a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe a -> ParsecT [tok] st Identity (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    SourcePos
p <- ParsecT [tok] st Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
    State [tok] st
_ <- State [tok] st -> ParsecT [tok] st Identity (State [tok] st)
forall (m :: * -> *) s u.
Monad m =>
State s u -> ParsecT s u m (State s u)
setParserState State [tok] st
state
    case Maybe a
x of
      Nothing -> [Char] -> GenParser tok st a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail ([Char] -> GenParser tok st a) -> [Char] -> GenParser tok st a
forall a b. (a -> b) -> a -> b
$ [Char]
lookaheadPosition [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Pos -> [Char] -> [Char]
showPos
                 (SourcePos -> Pos
fromSourcePos SourcePos
p) { sourceName :: [Char]
Common.Id.sourceName = "" } ")"
      Just y :: a
y -> a -> GenParser tok st a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y

followedWith :: GenParser tok st a -> GenParser tok st b -> GenParser tok st a
followedWith :: GenParser tok st a -> GenParser tok st b -> GenParser tok st a
followedWith p :: GenParser tok st a
p q :: GenParser tok st b
q = GenParser tok st a -> GenParser tok st a
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser tok st a -> GenParser tok st a)
-> GenParser tok st a -> GenParser tok st a
forall a b. (a -> b) -> a -> b
$ GenParser tok st a
p GenParser tok st a -> GenParser tok st b -> GenParser tok st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< GenParser tok st b -> GenParser tok st b
forall tok st a. GenParser tok st a -> GenParser tok st a
myLookAhead GenParser tok st b
q

checkWithUsing :: (a -> String) -> GenParser tok st a -> (a -> Bool)
          -> GenParser tok st a
checkWithUsing :: (a -> [Char])
-> GenParser tok st a -> (a -> Bool) -> GenParser tok st a
checkWithUsing display :: a -> [Char]
display p :: GenParser tok st a
p f :: a -> Bool
f = do
  a
x <- GenParser tok st a
p
  if a -> Bool
f a
x then a -> GenParser tok st a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x else [Char] -> GenParser tok st a
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected (a -> [Char]
display a
x)

checkWith :: Show a => GenParser tok st a -> (a -> Bool) -> GenParser tok st a
checkWith :: GenParser tok st a -> (a -> Bool) -> GenParser tok st a
checkWith = (a -> [Char])
-> GenParser tok st a -> (a -> Bool) -> GenParser tok st a
forall a tok st.
(a -> [Char])
-> GenParser tok st a -> (a -> Bool) -> GenParser tok st a
checkWithUsing a -> [Char]
forall a. Show a => a -> [Char]
show

separatedBy :: GenParser tok st a -> GenParser tok st b
            -> GenParser tok st ([a], [b])
separatedBy :: GenParser tok st a
-> GenParser tok st b -> GenParser tok st ([a], [b])
separatedBy p :: GenParser tok st a
p s :: GenParser tok st b
s = do
  a
r <- GenParser tok st a
p
  ([a], [b])
-> GenParser tok st ([a], [b]) -> GenParser tok st ([a], [b])
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option ([a
r], []) (GenParser tok st ([a], [b]) -> GenParser tok st ([a], [b]))
-> GenParser tok st ([a], [b]) -> GenParser tok st ([a], [b])
forall a b. (a -> b) -> a -> b
$ do
    b
t <- GenParser tok st b
s
    (es :: [a]
es, ts :: [b]
ts) <- GenParser tok st a
-> GenParser tok st b -> GenParser tok st ([a], [b])
forall tok st a b.
GenParser tok st a
-> GenParser tok st b -> GenParser tok st ([a], [b])
separatedBy GenParser tok st a
p GenParser tok st b
s
    ([a], [b]) -> GenParser tok st ([a], [b])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
es, b
t b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ts)

-- * casl words

scanLetterWord :: CharParser st String
scanLetterWord :: CharParser st [Char]
scanLetterWord = CharParser st Char
forall st. CharParser st Char
caslLetter CharParser st Char -> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> CharParser st Char -> CharParser st [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many CharParser st Char
forall st. CharParser st Char
scanLPD CharParser st [Char] -> [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "letter word"

singleUnderline :: CharParser st Char
singleUnderline :: CharParser st Char
singleUnderline = Char -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '_' CharParser st Char -> CharParser st Char -> CharParser st Char
forall tok st a b.
GenParser tok st a -> GenParser tok st b -> GenParser tok st a
`followedWith` CharParser st Char
forall st. CharParser st Char
scanLPD

scanUnderlineWord :: CharParser st String
scanUnderlineWord :: CharParser st [Char]
scanUnderlineWord = CharParser st Char
forall st. CharParser st Char
singleUnderline CharParser st Char -> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> CharParser st Char -> CharParser st [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 CharParser st Char
forall st. CharParser st Char
scanLPD

scanAnyWords :: CharParser st String
scanAnyWords :: CharParser st [Char]
scanAnyWords = ParsecT [Char] st Identity [[Char]] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (CharParser st [Char]
forall st. CharParser st [Char]
scanLetterWord CharParser st [Char]
-> ParsecT [Char] st Identity [[Char]]
-> ParsecT [Char] st Identity [[Char]]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> CharParser st [Char] -> ParsecT [Char] st Identity [[Char]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many CharParser st [Char]
forall st. CharParser st [Char]
scanUnderlineWord) CharParser st [Char] -> [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "words"

scanDot :: CharParser st Char
scanDot :: CharParser st Char
scanDot = Char -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '.' CharParser st Char -> CharParser st Char -> CharParser st Char
forall tok st a b.
GenParser tok st a -> GenParser tok st b -> GenParser tok st a
`followedWith` CharParser st Char
forall st. CharParser st Char
caslLetter

scanDotWords :: CharParser st String
scanDotWords :: CharParser st [Char]
scanDotWords = CharParser st Char
forall st. CharParser st Char
scanDot CharParser st Char -> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> CharParser st [Char]
forall st. CharParser st [Char]
scanAnyWords

-- * casl escape chars for quoted chars and literal strings

-- see ParsecToken.number
value :: Int -> String -> Int
value :: Int -> [Char] -> Int
value base :: Int
base = (Int -> Char -> Int) -> Int -> [Char] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ x :: Int
x d :: Char
d -> Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
d) 0

digits :: Int -> Int -> Int
digits :: Int -> Int -> Int
digits b :: Int
b n :: Int
n = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 0 else 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
digits Int
b (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
n Int
b)

valueCheck :: Int -> String -> Bool
valueCheck :: Int -> [Char] -> Bool
valueCheck b :: Int
b s :: [Char]
s = let
  n :: Int
n = [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s
  m :: Int
m = Char -> Int
ord Char
forall a. Bounded a => a
maxBound
  in Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int -> Int
digits Int
b 255 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int -> Int
digits Int
b Int
m Bool -> Bool -> Bool
&& Int -> [Char] -> Int
value Int
b [Char]
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
m

simpleEscape :: CharParser st String
simpleEscape :: CharParser st [Char]
simpleEscape = ParsecT [Char] st Identity Char -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a]
single ([Char] -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf "'\"\\ntrvbfa?")

decEscape :: CharParser st String
decEscape :: CharParser st [Char]
decEscape = ParsecT [Char] st Identity Char -> CharParser st [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit CharParser st [Char] -> ([Char] -> Bool) -> CharParser st [Char]
forall a tok st.
Show a =>
GenParser tok st a -> (a -> Bool) -> GenParser tok st a
`checkWith` Int -> [Char] -> Bool
valueCheck 10

hexEscape :: CharParser st String
hexEscape :: CharParser st [Char]
hexEscape = Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'x' ParsecT [Char] st Identity Char
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT [Char] st Identity Char -> CharParser st [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit CharParser st [Char] -> ([Char] -> Bool) -> CharParser st [Char]
forall a tok st.
Show a =>
GenParser tok st a -> (a -> Bool) -> GenParser tok st a
`checkWith` Int -> [Char] -> Bool
valueCheck 16

octEscape :: CharParser st String
octEscape :: CharParser st [Char]
octEscape = Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'o' ParsecT [Char] st Identity Char
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT [Char] st Identity Char -> CharParser st [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit CharParser st [Char] -> ([Char] -> Bool) -> CharParser st [Char]
forall a tok st.
Show a =>
GenParser tok st a -> (a -> Bool) -> GenParser tok st a
`checkWith` Int -> [Char] -> Bool
valueCheck 8

escapeChar :: CharParser st String
escapeChar :: CharParser st [Char]
escapeChar = Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\\' ParsecT [Char] st Identity Char
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:>
             (CharParser st [Char]
forall st. CharParser st [Char]
simpleEscape CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st [Char]
forall st. CharParser st [Char]
decEscape CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st [Char]
forall st. CharParser st [Char]
hexEscape CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st [Char]
forall st. CharParser st [Char]
octEscape)

-- * chars for quoted chars and literal strings

printable :: CharParser st String
printable :: CharParser st [Char]
printable = ParsecT [Char] st Identity Char -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a]
single (ParsecT [Char] st Identity Char -> CharParser st [Char])
-> ParsecT [Char] st Identity Char -> CharParser st [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool) -> ParsecT [Char] st Identity Char)
-> (Char -> Bool) -> ParsecT [Char] st Identity Char
forall a b. (a -> b) -> a -> b
$ \ c :: Char
c -> Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Char
c "'\"\\" Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> '\026'

caslChar :: CharParser st String
caslChar :: CharParser st [Char]
caslChar = CharParser st [Char]
forall st. CharParser st [Char]
escapeChar CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st [Char]
forall st. CharParser st [Char]
printable

scanQuotedChar :: CharParser st String
scanQuotedChar :: CharParser st [Char]
scanQuotedChar = CharParser st [Char]
-> ParsecT [Char] st Identity Char -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m a -> m [a]
enclosedBy (CharParser st [Char]
forall st. CharParser st [Char]
caslChar CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '"' ParsecT [Char] st Identity Char
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return "\\\""))
    (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\'') CharParser st [Char] -> [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "quoted char"

-- convert '"' to '\"' and "'" to "\'" (no support for ''')

scanString :: CharParser st String
scanString :: CharParser st [Char]
scanString = ParsecT [Char] st Identity [[Char]] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (CharParser st [Char] -> ParsecT [Char] st Identity [[Char]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (CharParser st [Char]
forall st. CharParser st [Char]
caslChar CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\'' ParsecT [Char] st Identity Char
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return "\\\'")))
    CharParser st [Char]
-> ParsecT [Char] st Identity Char -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m a -> m [a]
`enclosedBy` Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '"' CharParser st [Char] -> [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "literal string"

isString :: Token -> Bool
isString :: Token -> Bool
isString = [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf "\"" ([Char] -> Bool) -> (Token -> [Char]) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> [Char]
tokStr

parseString :: CharParser () a -> String -> a
parseString :: CharParser () a -> [Char] -> a
parseString p :: CharParser () a
p s :: [Char]
s = case CharParser () a -> [Char] -> [Char] -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse CharParser () a
p "" [Char]
s of
                  Left _ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ "parseString: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s
                  Right x :: a
x -> a
x

splitString :: CharParser () a -> String -> (a, String)
splitString :: CharParser () a -> [Char] -> (a, [Char])
splitString p :: CharParser () a
p = CharParser () (a, [Char]) -> [Char] -> (a, [Char])
forall a. CharParser () a -> [Char] -> a
parseString (CharParser () (a, [Char]) -> [Char] -> (a, [Char]))
-> CharParser () (a, [Char]) -> [Char] -> (a, [Char])
forall a b. (a -> b) -> a -> b
$ do
  a
hd <- CharParser () a
p
  [Char]
tl <- ParsecT [Char] () Identity [Char]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  (a, [Char]) -> CharParser () (a, [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
hd, [Char]
tl)

-- * digit, number, fraction, float

getNumber :: CharParser st String
getNumber :: CharParser st [Char]
getNumber = ParsecT [Char] st Identity Char -> CharParser st [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

getSignedNumber :: CharParser st String
getSignedNumber :: CharParser st [Char]
getSignedNumber = CharParser st [Char] -> CharParser st [Char]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL ([Char] -> CharParser st [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string "-") CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> CharParser st [Char]
forall st. CharParser st [Char]
getNumber

scanFloat :: CharParser st String
scanFloat :: CharParser st [Char]
scanFloat = CharParser st [Char]
forall st. CharParser st [Char]
getNumber
  CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> (CharParser st [Char] -> CharParser st [Char]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (CharParser st [Char] -> CharParser st [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser st [Char] -> CharParser st [Char])
-> CharParser st [Char] -> CharParser st [Char]
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '.' ParsecT [Char] st Identity Char
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> CharParser st [Char]
forall st. CharParser st [Char]
getNumber)
        CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> CharParser st [Char] -> CharParser st [Char]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'E' ParsecT [Char] st Identity Char
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> CharParser st [Char] -> CharParser st [Char]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (ParsecT [Char] st Identity Char -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a]
single (ParsecT [Char] st Identity Char -> CharParser st [Char])
-> ParsecT [Char] st Identity Char -> CharParser st [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf "+-")
                        CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> CharParser st [Char]
forall st. CharParser st [Char]
getNumber))


{- | In addition to scanFloat, also '1.', '.1' and '2.e-13' are recognized
as well as preceding signs '+-'. -}
scanFloatExt :: CharParser st String
scanFloatExt :: CharParser st [Char]
scanFloatExt =
    let -- the 'E' component
        compE :: ParsecT [Char] u Identity [Char]
compE = [Char] -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf "eE" ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT [Char] u Identity [Char]
forall st. CharParser st [Char]
getSNum
        -- the '.' component
        compD :: ParsecT s u m [Char] -> ParsecT s u m [Char]
compD n :: ParsecT s u m [Char]
n = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '.' ParsecT s u m Char -> ParsecT s u m [Char] -> ParsecT s u m [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT s u m [Char]
n
        -- an optional number
        getNum' :: ParsecT [Char] u Identity [Char]
getNum' = [Char]
-> ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "0" ParsecT [Char] u Identity [Char]
forall st. CharParser st [Char]
getNumber
        checkSign' :: Char -> [Char]
checkSign' '-' = "-"
        checkSign' _ = ""
        checkSp' :: [Char] -> [Char]
checkSp' = ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "0.") ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char]
checkSign' (Char -> [Char]) -> ([Char] -> Char) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Char
forall a. [a] -> a
head
        getSNum :: ParsecT [Char] st Identity [Char]
getSNum = ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL ([Char] -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf "+-" ParsecT [Char] st Identity Char
-> (Char -> [Char]) -> ParsecT [Char] st Identity [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> b) -> m b
>-> Char -> [Char]
checkSign') ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> ParsecT [Char] st Identity [Char]
forall st. CharParser st [Char]
getNumber
    in -- '1.' or '2.e-13' or '1.213'
      CharParser st [Char] -> CharParser st [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser st [Char]
forall st. CharParser st [Char]
getSNum CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> (CharParser st [Char] -> CharParser st [Char]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (CharParser st [Char] -> CharParser st [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser st [Char] -> CharParser st [Char])
-> CharParser st [Char] -> CharParser st [Char]
forall a b. (a -> b) -> a -> b
$ CharParser st [Char] -> CharParser st [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [Char] -> ParsecT s u m [Char]
compD CharParser st [Char]
forall st. CharParser st [Char]
getNum') CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> CharParser st [Char] -> CharParser st [Char]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL CharParser st [Char]
forall st. CharParser st [Char]
compE))
      -- everything starting with a dot
      CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([CharParser st [Char]] -> CharParser st [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (([Char] -> CharParser st [Char])
-> [[Char]] -> [CharParser st [Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> CharParser st [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string ["+.", "-.", "."]) CharParser st [Char] -> ([Char] -> [Char]) -> CharParser st [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> b) -> m b
>-> [Char] -> [Char]
checkSp') CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> CharParser st [Char]
forall st. CharParser st [Char]
getNumber
              CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> CharParser st [Char] -> CharParser st [Char]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL CharParser st [Char]
forall st. CharParser st [Char]
compE

scanDigit :: CharParser st String
scanDigit :: CharParser st [Char]
scanDigit = ParsecT [Char] st Identity Char -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a]
single ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

isNumber :: Token -> Bool
isNumber :: Token -> Bool
isNumber t :: Token
t = case Token -> [Char]
tokStr Token
t of
  c :: Char
c : _ : _ -> Char -> Bool
isDigit Char
c
  _ -> Bool
False

isFloating :: Token -> Bool
-- precondition: isNumber
isFloating :: Token -> Bool
isFloating = (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ".eE") ([Char] -> Bool) -> (Token -> [Char]) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> [Char]
tokStr

-- * skip whitespaces and nested comment out

nestCommentOut :: CharParser st ()
nestCommentOut :: CharParser st ()
nestCommentOut = ParsecT [Char] st Identity [Char] -> CharParser st ()
forall (m :: * -> *) a. Monad m => m a -> m ()
forget (ParsecT [Char] st Identity [Char] -> CharParser st ())
-> ParsecT [Char] st Identity [Char] -> CharParser st ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> ParsecT [Char] st Identity [Char]
forall st. [Char] -> [Char] -> CharParser st [Char]
nestedComment "%[" "]%"

skip :: CharParser st ()
skip :: CharParser st ()
skip = CharParser st () -> CharParser st ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT [Char] st Identity Char -> CharParser st ()
forall (m :: * -> *) a. Monad m => m a -> m ()
forget ((Char -> Bool) -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpace) CharParser st () -> CharParser st () -> CharParser st ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st ()
forall st. CharParser st ()
nestCommentOut CharParser st () -> [Char] -> CharParser st ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "")

fromSourcePos :: Pos.SourcePos -> Pos
fromSourcePos :: SourcePos -> Pos
fromSourcePos p :: SourcePos
p =
    [Char] -> Int -> Int -> Pos
newPos (SourcePos -> [Char]
Pos.sourceName SourcePos
p) (SourcePos -> Int
Pos.sourceLine SourcePos
p) (SourcePos -> Int
Pos.sourceColumn SourcePos
p)

getPos :: GenParser tok st Pos
getPos :: GenParser tok st Pos
getPos = (SourcePos -> Pos)
-> ParsecT [tok] st Identity SourcePos -> GenParser tok st Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourcePos -> Pos
fromSourcePos ParsecT [tok] st Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition

-- only skip to an annotation if it's on the same or next line
skipSmart :: CharParser st ()
skipSmart :: CharParser st ()
skipSmart = do
  SourcePos
p <- ParsecT [Char] st Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  CharParser st () -> CharParser st ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
      CharParser st ()
forall st. CharParser st ()
skip
      SourcePos
q <- ParsecT [Char] st Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
      Bool -> CharParser st () -> CharParser st ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SourcePos -> Int
Pos.sourceLine SourcePos
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= SourcePos -> Int
Pos.sourceLine SourcePos
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
        (CharParser st () -> CharParser st ())
-> CharParser st () -> CharParser st ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] st Identity Char -> CharParser st ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '%') CharParser st () -> CharParser st () -> CharParser st ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> CharParser st ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    CharParser st () -> CharParser st () -> CharParser st ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> () -> CharParser st ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * keywords WORDS or NO-BRACKET-SIGNS

keyWord :: CharParser st a -> CharParser st a
keyWord :: CharParser st a -> CharParser st a
keyWord = CharParser st a -> CharParser st a
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser st a -> CharParser st a)
-> (CharParser st a -> CharParser st a)
-> CharParser st a
-> CharParser st a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CharParser st a -> ParsecT [Char] st Identity () -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (ParsecT [Char] st Identity Char
forall st. CharParser st Char
scanLPD ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] st Identity Char
forall st. CharParser st Char
singleUnderline))

keySign :: CharParser st a -> CharParser st a
keySign :: CharParser st a -> CharParser st a
keySign = CharParser st a -> CharParser st a
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser st a -> CharParser st a)
-> (CharParser st a -> CharParser st a)
-> CharParser st a
-> CharParser st a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CharParser st a -> ParsecT [Char] st Identity () -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ((Char -> Bool) -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSignChar))

-- * lexical tokens with position

parseToken :: CharParser st String -> CharParser st Token
parseToken :: CharParser st [Char] -> CharParser st Token
parseToken = (Pos -> [Char] -> Token)
-> ParsecT [Char] st Identity Pos
-> CharParser st [Char]
-> CharParser st Token
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\ p :: Pos
p s :: [Char]
s -> [Char] -> Range -> Token
Token [Char]
s (Range -> Token) -> Range -> Token
forall a b. (a -> b) -> a -> b
$ [Pos] -> Range
Range [Pos
p]) ParsecT [Char] st Identity Pos
forall tok st. GenParser tok st Pos
getPos

pToken :: CharParser st String -> CharParser st Token
pToken :: CharParser st [Char] -> CharParser st Token
pToken = CharParser st [Char] -> CharParser st Token
forall st. CharParser st [Char] -> CharParser st Token
parseToken (CharParser st [Char] -> CharParser st Token)
-> (CharParser st [Char] -> CharParser st [Char])
-> CharParser st [Char]
-> CharParser st Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CharParser st [Char]
-> ParsecT [Char] st Identity () -> CharParser st [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT [Char] st Identity ()
forall st. CharParser st ()
skipSmart)

pluralKeyword :: String -> CharParser st Token
pluralKeyword :: [Char] -> CharParser st Token
pluralKeyword s :: [Char]
s = CharParser st [Char] -> CharParser st Token
forall st. CharParser st [Char] -> CharParser st Token
pToken (CharParser st [Char] -> CharParser st [Char]
forall st a. CharParser st a -> CharParser st a
keyWord ([Char] -> CharParser st [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
s CharParser st [Char]
-> CharParser st [Char] -> CharParser st [Char]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> CharParser st [Char] -> CharParser st [Char]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL ([Char] -> CharParser st [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string "s")))
  CharParser st Token -> [Char] -> CharParser st Token
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s

-- | check for keywords (depending on lexem class)
toKey :: String -> CharParser st String
toKey :: [Char] -> CharParser st [Char]
toKey s :: [Char]
s = let p :: ParsecT [Char] u Identity [Char]
p = [Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
s in
  if [Char] -> Char
forall a. [a] -> a
last [Char]
s Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "[]{}(),;" then CharParser st [Char]
forall st. CharParser st [Char]
p
  else if Char -> Bool
isSignChar (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Char
forall a. [a] -> a
last [Char]
s then CharParser st [Char] -> CharParser st [Char]
forall st a. CharParser st a -> CharParser st a
keySign CharParser st [Char]
forall st. CharParser st [Char]
p
       else CharParser st [Char] -> CharParser st [Char]
forall st a. CharParser st a -> CharParser st a
keyWord CharParser st [Char]
forall st. CharParser st [Char]
p

-- * some separator parsers

asSeparator :: String -> CharParser st Token
asSeparator :: [Char] -> CharParser st Token
asSeparator = CharParser st [Char] -> CharParser st Token
forall st. CharParser st [Char] -> CharParser st Token
pToken (CharParser st [Char] -> CharParser st Token)
-> ([Char] -> CharParser st [Char])
-> [Char]
-> CharParser st Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> CharParser st [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string

commaT :: CharParser st Token
commaT :: CharParser st Token
commaT = [Char] -> CharParser st Token
forall st. [Char] -> CharParser st Token
asSeparator ","

-- a single semicolon
semiT :: CharParser st Token
semiT :: CharParser st Token
semiT = CharParser st [Char] -> CharParser st Token
forall st. CharParser st [Char] -> CharParser st Token
pToken (CharParser st [Char] -> CharParser st Token)
-> CharParser st [Char] -> CharParser st Token
forall a b. (a -> b) -> a -> b
$ [Char] -> CharParser st [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string ";" CharParser st [Char]
-> ParsecT [Char] st Identity () -> CharParser st [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ';')

oBraceT :: CharParser st Token
oBraceT :: CharParser st Token
oBraceT = [Char] -> CharParser st Token
forall st. [Char] -> CharParser st Token
asSeparator "{"

cBraceT :: CharParser st Token
cBraceT :: CharParser st Token
cBraceT = [Char] -> CharParser st Token
forall st. [Char] -> CharParser st Token
asSeparator "}"

oBracketT :: CharParser st Token
oBracketT :: CharParser st Token
oBracketT = [Char] -> CharParser st Token
forall st. [Char] -> CharParser st Token
asSeparator "["

cBracketT :: CharParser st Token
cBracketT :: CharParser st Token
cBracketT = ([Char] -> CharParser st [Char]
forall st. [Char] -> CharParser st [Char]
tryString "]%" CharParser st [Char] -> CharParser st Token -> CharParser st Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> CharParser st Token
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected "block-comment-end ]%" CharParser st Token -> [Char] -> CharParser st Token
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "")
    CharParser st Token -> CharParser st Token -> CharParser st Token
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> CharParser st Token
forall st. [Char] -> CharParser st Token
asSeparator "]"

oParenT :: CharParser st Token
oParenT :: CharParser st Token
oParenT = [Char] -> CharParser st Token
forall st. [Char] -> CharParser st Token
asSeparator "("

cParenT :: CharParser st Token
cParenT :: CharParser st Token
cParenT = [Char] -> CharParser st Token
forall st. [Char] -> CharParser st Token
asSeparator ")"

braces :: CharParser st a -> CharParser st a
braces :: CharParser st a -> CharParser st a
braces p :: CharParser st a
p = CharParser st Token
forall st. CharParser st Token
oBraceT CharParser st Token -> CharParser st a -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser st a
p CharParser st a -> CharParser st Token -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< CharParser st Token
forall st. CharParser st Token
cBraceT

brackets :: CharParser st a -> CharParser st a
brackets :: CharParser st a -> CharParser st a
brackets p :: CharParser st a
p = CharParser st Token
forall st. CharParser st Token
oBracketT CharParser st Token -> CharParser st a -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser st a
p CharParser st a -> CharParser st Token -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< CharParser st Token
forall st. CharParser st Token
cBracketT

parens :: CharParser st a -> CharParser st a
parens :: CharParser st a -> CharParser st a
parens p :: CharParser st a
p = CharParser st Token
forall st. CharParser st Token
oParenT CharParser st Token -> CharParser st a -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser st a
p CharParser st a -> CharParser st Token -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< CharParser st Token
forall st. CharParser st Token
cParenT

commaSep1 :: CharParser st a -> CharParser st [a]
commaSep1 :: CharParser st a -> CharParser st [a]
commaSep1 p :: CharParser st a
p = (([a], [Token]) -> [a])
-> ParsecT [Char] st Identity ([a], [Token]) -> CharParser st [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a], [Token]) -> [a]
forall a b. (a, b) -> a
fst (ParsecT [Char] st Identity ([a], [Token]) -> CharParser st [a])
-> ParsecT [Char] st Identity ([a], [Token]) -> CharParser st [a]
forall a b. (a -> b) -> a -> b
$ CharParser st a
-> GenParser Char st Token
-> ParsecT [Char] st Identity ([a], [Token])
forall tok st a b.
GenParser tok st a
-> GenParser tok st b -> GenParser tok st ([a], [b])
separatedBy CharParser st a
p GenParser Char st Token
forall st. CharParser st Token
commaT

placeS :: CharParser st String
placeS :: CharParser st [Char]
placeS = [Char] -> CharParser st [Char]
forall st. [Char] -> CharParser st [Char]
tryString [Char]
place

placeT :: CharParser st Token
placeT :: CharParser st Token
placeT = CharParser st [Char] -> CharParser st Token
forall st. CharParser st [Char] -> CharParser st Token
pToken CharParser st [Char]
forall st. CharParser st [Char]
placeS

{- ParsecCombinator.notFollowedBy only allows to check for a single "tok"
thus a single Char. -}

notFollowedWith :: GenParser tok st a -> GenParser tok st b
                -> GenParser tok st a
notFollowedWith :: GenParser tok st a -> GenParser tok st b -> GenParser tok st a
notFollowedWith p1 :: GenParser tok st a
p1 p2 :: GenParser tok st b
p2 =
  GenParser tok st a -> GenParser tok st a
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser tok st a -> GenParser tok st a)
-> GenParser tok st a -> GenParser tok st a
forall a b. (a -> b) -> a -> b
$ ParsecT [tok] st Identity (GenParser tok st a)
-> GenParser tok st a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ParsecT [tok] st Identity (GenParser tok st a)
 -> GenParser tok st a)
-> ParsecT [tok] st Identity (GenParser tok st a)
-> GenParser tok st a
forall a b. (a -> b) -> a -> b
$ (GenParser tok st b -> GenParser tok st b
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser tok st a
p1 GenParser tok st a -> GenParser tok st b -> GenParser tok st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser tok st b
p2) GenParser tok st b
-> ParsecT [tok] st Identity (GenParser tok st a)
-> ParsecT [tok] st Identity (GenParser tok st a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser tok st a
-> ParsecT [tok] st Identity (GenParser tok st a)
forall (m :: * -> *) a. Monad m => a -> m a
return GenParser tok st a
forall tok st a. GenParser tok st a
pzero) ParsecT [tok] st Identity (GenParser tok st a)
-> ParsecT [tok] st Identity (GenParser tok st a)
-> ParsecT [tok] st Identity (GenParser tok st a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser tok st a
-> ParsecT [tok] st Identity (GenParser tok st a)
forall (m :: * -> *) a. Monad m => a -> m a
return GenParser tok st a
p1
{- see http://www.mail-archive.com/haskell@haskell.org/msg14388.html
by Andrew Pimlott -}