module GLL.Combinators.Lexer (
    default_lexer, lexer, lexerEither, LexerSettings(..), emptyLanguage,
    oneOf, manyOf, someOf, baseToDec,
    ) where

import GLL.Types.Grammar (Token(..), SubsumesToken(..))
import Data.List (isPrefixOf)
import Data.Char (isSpace, isDigit, isAlpha, isUpper, isLower)
import Text.Regex.Applicative
import Text.Regex.Applicative.Common (signed)

-- | Settings for changing the behaviour of the builtin lexer 'lexer'.
-- Lexers are built using "Text.Regex.Applicative".
data LexerSettings = LexerSettings {
        -- | Which keychars to recognise? Default: none.
        LexerSettings -> String
keychars        :: [Char]
        -- | Which keywords to recognise? Default: none.
    ,   LexerSettings -> [String]
keywords        :: [String]
        -- | What is considered a whitespace character? Default: 'Data.Char.isSpace'.
    ,   LexerSettings -> Char -> Bool
whitespace      :: Char -> Bool
        -- | How does a line comment start? Default: '"'//'"'.
    ,   LexerSettings -> String
lineComment     :: String
        -- | How does a block comment open? Default: '"'{-'"'. 
    ,   LexerSettings -> String
blockCommentOpen :: String
        -- | How does a block comment close? Default: '"'-}'"'.
    ,   LexerSettings -> String
blockCommentClose :: String
        -- | How to recognise identifiers? Default alphanumerical with lowercase alpha start.
    ,   LexerSettings -> RE Char String
identifiers     :: RE Char String
        -- | How to recognise alternative identifiers? Default alphanumerical with uppercase alpha start.
    ,   LexerSettings -> RE Char String
altIdentifiers  :: RE Char String
        -- | Arbitrary tokens /(a,b)/. /a/ is the token name, /b/ is a regular expression.
    ,   LexerSettings -> [(String, RE Char String)]
tokens          :: [(String, RE Char String)]
        -- | Whether integer literals may be signed positive or negative. Default: 'False'
    ,   LexerSettings -> Bool
signed_int_lits :: Bool
    }

-- | The default 'LexerSettings'.
emptyLanguage :: LexerSettings
emptyLanguage :: LexerSettings
emptyLanguage = String
-> [String]
-> (Char -> Bool)
-> String
-> String
-> String
-> RE Char String
-> RE Char String
-> [(String, RE Char String)]
-> Bool
-> LexerSettings
LexerSettings [] [] Char -> Bool
isSpace String
"//" String
"{-" String
"-}"
    ((:) (Char -> String -> String)
-> RE Char Char -> RE Char (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> RE Char Char
forall s. (s -> Bool) -> RE s s
psym Char -> Bool
isLower RE Char (String -> String) -> RE Char String -> RE Char String
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE Char String
lowercase_id)
    ((:) (Char -> String -> String)
-> RE Char Char -> RE Char (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> RE Char Char
forall s. (s -> Bool) -> RE s s
psym Char -> Bool
isUpper RE Char (String -> String) -> RE Char String -> RE Char String
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE Char String
lowercase_id)
    [] Bool
False
 where lowercase_id :: RE Char String
lowercase_id = RE Char Char -> RE Char String
forall a. RE Char a -> RE Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> RE Char Char
forall s. (s -> Bool) -> RE s s
psym (\Char
c -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c))

-- | A lexer using the default 'LexerSettings'.
default_lexer :: SubsumesToken t => String -> [t]
default_lexer :: forall t. SubsumesToken t => String -> [t]
default_lexer = LexerSettings -> String -> [t]
forall t. SubsumesToken t => LexerSettings -> String -> [t]
lexer LexerSettings
emptyLanguage 

-- | Variant of 'lexerEither' that throws an error or returns the result otherwise
lexer :: SubsumesToken t => LexerSettings -> String -> [t]
lexer :: forall t. SubsumesToken t => LexerSettings -> String -> [t]
lexer LexerSettings
set String
inp = case LexerSettings -> String -> Either String [t]
forall t.
SubsumesToken t =>
LexerSettings -> String -> Either String [t]
lexerEither LexerSettings
set String
inp of
  Left String
err  -> String -> [t]
forall a. HasCallStack => String -> a
error String
err
  Right [t]
ts  -> [t]
ts

-- | A lexer parameterised by 'LexerSettings'.
lexerEither :: SubsumesToken t => LexerSettings -> String -> Either String [t]
lexerEither :: forall t.
SubsumesToken t =>
LexerSettings -> String -> Either String [t]
lexerEither LexerSettings
_ [] = [t] -> Either String [t]
forall a b. b -> Either a b
Right []
lexerEither LexerSettings
lexsets String
s
  | String
start String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" Bool -> Bool -> Bool
&& String
end String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" Bool -> Bool -> Bool
&& String
start String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = Int -> String -> Either String [t]
forall t. SubsumesToken t => Int -> String -> Either String [t]
blockState Int
1 (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
lS String
s)
  | String
lComm String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" Bool -> Bool -> Bool
&& String
lComm String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Char
'\n') String
s of
      []      -> [t] -> Either String [t]
forall a b. b -> Either a b
Right []
      (Char
c:String
cs)  -> LexerSettings -> String -> Either String [t]
forall t.
SubsumesToken t =>
LexerSettings -> String -> Either String [t]
lexerEither LexerSettings
lexsets String
cs
  | Char -> Bool
isWS (String -> Char
forall a. HasCallStack => [a] -> a
head String
s) = LexerSettings -> String -> Either String [t]
forall t.
SubsumesToken t =>
LexerSettings -> String -> Either String [t]
lexerEither LexerSettings
lexsets ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isWS String
s)
  | Bool
otherwise = case RE Char t -> String -> Maybe (t, String)
forall s a. RE s a -> [s] -> Maybe (a, [s])
findLongestPrefix (LexerSettings -> RE Char t
forall t. SubsumesToken t => LexerSettings -> RE Char t
lTokens LexerSettings
lexsets) String
s of
        Just (t
tok, String
rest)   -> ([t] -> [t]) -> Either String [t] -> Either String [t]
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t
tok t -> [t] -> [t]
forall a. a -> [a] -> [a]
:) (Either String [t] -> Either String [t])
-> Either String [t] -> Either String [t]
forall a b. (a -> b) -> a -> b
$ LexerSettings -> String -> Either String [t]
forall t.
SubsumesToken t =>
LexerSettings -> String -> Either String [t]
lexerEither LexerSettings
lexsets String
rest
        Maybe (t, String)
Nothing            -> String -> Either String [t]
forall a b. a -> Either a b
Left (String
"lexical error at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
10 String
s))
  where start :: String
start = LexerSettings -> String
blockCommentOpen LexerSettings
lexsets
        end :: String
end   = LexerSettings -> String
blockCommentClose LexerSettings
lexsets
        isWS :: Char -> Bool
isWS  = LexerSettings -> Char -> Bool
whitespace LexerSettings
lexsets
        lComm :: String
lComm = LexerSettings -> String
lineComment LexerSettings
lexsets
        lS :: Int
lS    = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
start
        lE :: Int
lE    = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
end

        blockState :: SubsumesToken t => Int -> String -> Either String [t] 
        blockState :: forall t. SubsumesToken t => Int -> String -> Either String [t]
blockState Int
n [] = [t] -> Either String [t]
forall a b. b -> Either a b
Right [] 
        blockState Int
0 String
rest = LexerSettings -> String -> Either String [t]
forall t.
SubsumesToken t =>
LexerSettings -> String -> Either String [t]
lexerEither LexerSettings
lexsets String
rest
        blockState Int
n String
cs | String
start String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
cs = Int -> String -> Either String [t]
forall t. SubsumesToken t => Int -> String -> Either String [t]
blockState (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
lS String
cs)
                    | String
end String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
cs   = Int -> String -> Either String [t]
forall t. SubsumesToken t => Int -> String -> Either String [t]
blockState (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
lE String
cs) 
                    | Bool
otherwise             = Int -> String -> Either String [t]
forall t. SubsumesToken t => Int -> String -> Either String [t]
blockState Int
n (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
cs)

lTokens :: SubsumesToken t => LexerSettings -> RE Char t 
lTokens :: forall t. SubsumesToken t => LexerSettings -> RE Char t
lTokens LexerSettings
lexsets =
        RE Char t
forall t. SubsumesToken t => RE Char t
lCharacters
    RE Char t -> RE Char t -> RE Char t
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RE Char t
forall t. SubsumesToken t => RE Char t
lKeywords
    RE Char t -> RE Char t -> RE Char t
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token -> t
forall a. SubsumesToken a => Token -> a
upcast (Token -> t) -> (Int -> Token) -> Int -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Token
IntLit (Maybe Int -> Token) -> (Int -> Maybe Int) -> Int -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> t) -> RE Char Int -> RE Char t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> RE Char Int
lIntegers (LexerSettings -> Bool
signed_int_lits LexerSettings
lexsets) 
    RE Char t -> RE Char t -> RE Char t
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token -> t
forall a. SubsumesToken a => Token -> a
upcast (Token -> t) -> (Double -> Token) -> Double -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Double -> Token
FloatLit (Maybe Double -> Token)
-> (Double -> Maybe Double) -> Double -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> t) -> RE Char Double -> RE Char t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE Char Double
lFloats
    RE Char t -> RE Char t -> RE Char t
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token -> t
forall a. SubsumesToken a => Token -> a
upcast (Token -> t) -> (String -> Token) -> String -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Token
IDLit (Maybe String -> Token)
-> (String -> Maybe String) -> String -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> t) -> RE Char String -> RE Char t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LexerSettings -> RE Char String
identifiers LexerSettings
lexsets 
    RE Char t -> RE Char t -> RE Char t
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token -> t
forall a. SubsumesToken a => Token -> a
upcast (Token -> t) -> (String -> Token) -> String -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Token
AltIDLit (Maybe String -> Token)
-> (String -> Maybe String) -> String -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> t) -> RE Char String -> RE Char t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LexerSettings -> RE Char String
altIdentifiers LexerSettings
lexsets
    RE Char t -> RE Char t -> RE Char t
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token -> t
forall a. SubsumesToken a => Token -> a
upcast (Token -> t) -> (Char -> Token) -> Char -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> Token
CharLit (Maybe Char -> Token) -> (Char -> Maybe Char) -> Char -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> t) -> RE Char Char -> RE Char t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE Char Char
lCharLit
    RE Char t -> RE Char t -> RE Char t
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token -> t
forall a. SubsumesToken a => Token -> a
upcast (Token -> t) -> (String -> Token) -> String -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Token
StringLit (Maybe String -> Token)
-> (String -> Maybe String) -> String -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> t) -> RE Char String -> RE Char t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE Char String
lStringLit
    RE Char t -> RE Char t -> RE Char t
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RE Char t
forall t. SubsumesToken t => RE Char t
lMore
  where     lMore :: SubsumesToken t => RE Char t 
            lMore :: forall t. SubsumesToken t => RE Char t
lMore = ((String, RE Char String) -> RE Char t -> RE Char t)
-> RE Char t -> [(String, RE Char String)] -> RE Char t
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (RE Char t -> RE Char t -> RE Char t
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (RE Char t -> RE Char t -> RE Char t)
-> ((String, RE Char String) -> RE Char t)
-> (String, RE Char String)
-> RE Char t
-> RE Char t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> RE Char String -> RE Char t)
-> (String, RE Char String) -> RE Char t
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> RE Char String -> RE Char t
forall {f :: * -> *} {b}.
(Functor f, SubsumesToken b) =>
String -> f String -> f b
lToken) RE Char t
forall a. RE Char a
forall (f :: * -> *) a. Alternative f => f a
empty (LexerSettings -> [(String, RE Char String)]
tokens LexerSettings
lexsets)

            lChar :: Char -> RE Char a
lChar Char
c = Token -> a
forall a. SubsumesToken a => Token -> a
upcast (Char -> Token
Char Char
c) a -> RE Char Char -> RE Char a
forall a b. a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
c
            lCharacters :: SubsumesToken t => RE Char t
            lCharacters :: forall t. SubsumesToken t => RE Char t
lCharacters = (Char -> RE Char t -> RE Char t)
-> RE Char t -> String -> RE Char t
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (RE Char t -> RE Char t -> RE Char t
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (RE Char t -> RE Char t -> RE Char t)
-> (Char -> RE Char t) -> Char -> RE Char t -> RE Char t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> RE Char t
forall {a}. SubsumesToken a => Char -> RE Char a
lChar) RE Char t
forall a. RE Char a
forall (f :: * -> *) a. Alternative f => f a
empty (LexerSettings -> String
keychars LexerSettings
lexsets)

            lKeyword :: String -> RE Char a
lKeyword String
k  = Token -> a
forall a. SubsumesToken a => Token -> a
upcast (String -> Token
Keyword String
k) a -> RE Char String -> RE Char a
forall a b. a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
string String
k
            lKeywords :: SubsumesToken t => RE Char t
            lKeywords :: forall t. SubsumesToken t => RE Char t
lKeywords = (String -> RE Char t -> RE Char t)
-> RE Char t -> [String] -> RE Char t
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (RE Char t -> RE Char t -> RE Char t
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (RE Char t -> RE Char t -> RE Char t)
-> (String -> RE Char t) -> String -> RE Char t -> RE Char t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RE Char t
forall {a}. SubsumesToken a => String -> RE Char a
lKeyword) RE Char t
forall a. RE Char a
forall (f :: * -> *) a. Alternative f => f a
empty (LexerSettings -> [String]
keywords LexerSettings
lexsets)

lToken :: String -> f String -> f b
lToken String
t f String
re = Token -> b
forall a. SubsumesToken a => Token -> a
upcast (Token -> b) -> (String -> Token) -> String -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> Token
Token String
t (Maybe String -> Token)
-> (String -> Maybe String) -> String -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> b) -> f String -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f String
re

lStringLit :: RE Char String 
lStringLit :: RE Char String
lStringLit = String -> String
forall {a}. Read a => String -> a
toString (String -> String) -> RE Char Char -> RE Char (String -> String)
forall a b. a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'\"' RE Char (String -> String) -> RE Char String -> RE Char String
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE Char Char -> RE Char String
forall a. RE Char a -> RE Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many RE Char Char
strChar RE Char String -> RE Char Char -> RE Char String
forall a b. RE Char a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'\"'
 where strChar :: RE Char Char
strChar =  Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'\\' RE Char Char -> RE Char Char -> RE Char Char
forall a b. RE Char a -> RE Char b -> RE Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'\"'
                  RE Char Char -> RE Char Char -> RE Char Char
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> RE Char Char
forall s. (s -> Bool) -> RE s s
psym (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Char
'\"')
       toString :: String -> a
toString String
inner = String -> a
forall {a}. Read a => String -> a
read (String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
inner String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"")

lCharLit :: RE Char Char
lCharLit = Char -> Char
forall a. a -> a
id (Char -> Char) -> RE Char Char -> RE Char (Char -> Char)
forall a b. a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'\'' RE Char (Char -> Char) -> RE Char Char -> RE Char Char
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE Char Char
charChar RE Char Char -> RE Char Char -> RE Char Char
forall a b. RE Char a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'\''
  where charChar :: RE Char Char
charChar = Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'\\' RE Char Char -> RE Char Char -> RE Char Char
forall a b. RE Char a -> RE Char b -> RE Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'\''
                    RE Char Char -> RE Char Char -> RE Char Char
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> RE Char Char
forall s. (s -> Bool) -> RE s s
psym (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Char
'\'')

lFloats :: RE Char Double
lFloats :: RE Char Double
lFloats = RE Char Double -> RE Char Double
forall a. Num a => RE Char a -> RE Char a
signed ( String -> Double
forall {a}. Read a => String -> a
read (String -> Double) -> RE Char String -> RE Char Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (
        String -> Char -> String -> Maybe String -> String
forall {p}. String -> p -> String -> Maybe String -> String
mkDP (String -> Char -> String -> Maybe String -> String)
-> RE Char String
-> RE Char (Char -> String -> Maybe String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE Char String
decimal RE Char (Char -> String -> Maybe String -> String)
-> RE Char Char -> RE Char (String -> Maybe String -> String)
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'.' RE Char (String -> Maybe String -> String)
-> RE Char String -> RE Char (Maybe String -> String)
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE Char String
decimal RE Char (Maybe String -> String)
-> RE Char (Maybe String) -> RE Char String
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE Char String -> RE Char (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional RE Char String
exponent 
    RE Char String -> RE Char String -> RE Char String
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> String -> String
forall a. [a] -> [a] -> [a]
mkEP (String -> String -> String)
-> RE Char String -> RE Char (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE Char String
decimal RE Char (String -> String) -> RE Char String -> RE Char String
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE Char String
exponent
  ))
  where mkDP :: String -> p -> String -> Maybe String -> String
mkDP String
pre p
_ String
post Maybe String
mexp = String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
post String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
forall a. a -> a
id Maybe String
mexp
        mkEP :: [a] -> [a] -> [a]
mkEP [a]
pre [a]
exp = [a]
pre [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
exp

        exponent :: RE Char String
exponent = Char -> Maybe Char -> String -> String
mk (Char -> Maybe Char -> String -> String)
-> RE Char Char -> RE Char (Maybe Char -> String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'e' RE Char Char -> RE Char Char -> RE Char Char
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'E') 
                      RE Char (Maybe Char -> String -> String)
-> RE Char (Maybe Char) -> RE Char (String -> String)
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE Char Char -> RE Char (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'+' RE Char Char -> RE Char Char -> RE Char Char
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> RE Char Char
forall s. Eq s => s -> RE s s
sym Char
'-')
                      RE Char (String -> String) -> RE Char String -> RE Char String
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE Char String
decimal
         where mk :: Char -> Maybe Char -> String -> String
mk Char
pre Maybe Char
sign String
dec = Char
pre Char -> String -> String
forall a. a -> [a] -> [a]
: String -> (Char -> String) -> Maybe Char -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) Maybe Char
sign String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dec

lIntegers :: Bool -> RE Char Int
lIntegers :: Bool -> RE Char Int
lIntegers Bool
True = RE Char Int -> RE Char Int
forall a. Num a => RE Char a -> RE Char a
signed RE Char Int
lNaturals
lIntegers Bool
False = RE Char Int
lNaturals

lNaturals :: RE Char Int 
lNaturals :: RE Char Int
lNaturals = 
      (String -> Int
forall {a}. Read a => String -> a
read (String -> Int) -> RE Char String -> RE Char Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE Char String
decimal)
  RE Char Int -> RE Char Int -> RE Char Int
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> String -> Int
baseToDec Int
16 (String -> Int) -> RE Char String -> RE Char (String -> Int)
forall a b. a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RE Char String
hexPrefix RE Char (String -> Int) -> RE Char String -> RE Char Int
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
someOf ([Char
'0'..Char
'9']String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
'A'..Char
'F']String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
'a'..Char
'f']))
  RE Char Int -> RE Char Int -> RE Char Int
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> String -> Int
baseToDec Int
8  (String -> Int) -> RE Char String -> RE Char (String -> Int)
forall a b. a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RE Char String
octPrefix RE Char (String -> Int) -> RE Char String -> RE Char Int
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
someOf [Char
'0'..Char
'7'])
  RE Char Int -> RE Char Int -> RE Char Int
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> String -> Int
baseToDec Int
2  (String -> Int) -> RE Char String -> RE Char (String -> Int)
forall a b. a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RE Char String
binPrefix RE Char (String -> Int) -> RE Char String -> RE Char Int
forall a b. RE Char (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
someOf [Char
'0',Char
'1'])
  where hexPrefix :: RE Char String
hexPrefix = String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
string String
"0x" RE Char String -> RE Char String -> RE Char String
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
string String
"0X"
        octPrefix :: RE Char String
octPrefix = String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
string String
"0o" RE Char String -> RE Char String -> RE Char String
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
string String
"0O"
        binPrefix :: RE Char String
binPrefix = String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
string String
"0b" RE Char String -> RE Char String -> RE Char String
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
string String
"0B" 
    
decimal :: RE Char String
decimal :: RE Char String
decimal = String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
someOf [Char
'0'..Char
'9'] 
 
-- | Convert numerical representation in a given base 
--  (max base = 16, written as string)
--  into decimal representation (returned as Int)
baseToDec :: Int -> String -> Int
baseToDec :: Int -> String -> Int
baseToDec Int
base = Int -> Int -> [Int] -> Int
forall {t}. Num t => t -> t -> [t] -> t
baseToDec' Int
0 Int
base ([Int] -> Int) -> (String -> [Int]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
forall {a}. (Num a, Read a) => Char -> a
toInt
  where baseToDec' :: t -> t -> [t] -> t
baseToDec' t
acc t
base [] = t
acc
        baseToDec' t
acc t
base (t
d:[t]
ds) = t -> t -> [t] -> t
baseToDec' (t
acc t -> t -> t
forall a. Num a => a -> a -> a
* t
base t -> t -> t
forall a. Num a => a -> a -> a
+ t
d) t
base [t]
ds
        toInt :: Char -> a
toInt Char
c | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'A' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a' = a
10
                | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'B' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'b' = a
11
                | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'C' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'c' = a
12
                | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'D' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'd' = a
13
                | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' = a
14
                | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'F' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'f' = a
15
                | Bool
otherwise = String -> a
forall {a}. Read a => String -> a
read [Char
c]
 
oneOf :: Eq t => [t] -> RE t t       
oneOf :: forall t. Eq t => [t] -> RE t t
oneOf [t]
ts = (t -> Bool) -> RE t t
forall s. (s -> Bool) -> RE s s
psym (\t
t -> t
t t -> [t] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [t]
ts)

manyOf :: Eq t => [t] -> RE t [t]
manyOf :: forall a. Eq a => [a] -> RE a [a]
manyOf [t]
ts = RE t t -> RE t [t]
forall a. RE t a -> RE t [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ([t] -> RE t t
forall t. Eq t => [t] -> RE t t
oneOf [t]
ts) 

someOf :: Eq t => [t] -> RE t [t]
someOf :: forall a. Eq a => [a] -> RE a [a]
someOf [t]
ts = RE t t -> RE t [t]
forall a. RE t a -> RE t [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ([t] -> RE t t
forall t. Eq t => [t] -> RE t t
oneOf [t]
ts) 

{-

manyOf :: Eq t => [t] -> RE t [t]
manyOf ts = empty <|> someOf ts

someOf :: Eq t => [t] -> RE t [t]
someOf ts = (:) <$> oneOf ts <*> manyOf ts

-}