{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module JL.Tokenizer where
import Control.Monad
import Data.Char
import Data.List
import Data.Text (Text)
import qualified Data.Text as T
import JL.Types
import Text.Parsec hiding (anyToken)
import Text.Parsec.Text
import Text.Printf
tokenize :: FilePath -> Text -> Either ParseError [(Token, Location)]
tokenize :: [Char] -> Text -> Either ParseError [(Token, Location)]
tokenize [Char]
fp Text
t = Parsec Text () [(Token, Location)]
-> [Char] -> Text -> Either ParseError [(Token, Location)]
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse Parsec Text () [(Token, Location)]
tokensTokenizer [Char]
fp Text
t
tokensTokenizer :: Parser [(Token, Location)]
tokensTokenizer :: Parsec Text () [(Token, Location)]
tokensTokenizer =
ParsecT Text () Identity (Token, Location)
-> ParsecT Text () Identity ()
-> Parsec Text () [(Token, Location)]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT Text () Identity [Char]
-> ([Char] -> ParsecT Text () Identity (Token, Location))
-> ParsecT Text () Identity (Token, Location)
forall a b.
ParsecT Text () Identity a
-> (a -> ParsecT Text () Identity b) -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> ParsecT Text () Identity (Token, Location)
tokenTokenizer) (ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity ()
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof))
tokenTokenizer :: [Char] -> Parser (Token, Location)
tokenTokenizer :: [Char] -> ParsecT Text () Identity (Token, Location)
tokenTokenizer [Char]
prespaces =
[ParsecT Text () Identity (Token, Location)]
-> ParsecT Text () Identity (Token, Location)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ if [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [Char]
"\n" [Char]
prespaces
then do
SourcePos
pos <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(Token, Location) -> ParsecT Text () Identity (Token, Location)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Token
NonIndentedNewline
, Int -> Int -> Int -> Int -> Location
Location
(SourcePos -> Int
sourceLine SourcePos
pos)
(SourcePos -> Int
sourceColumn SourcePos
pos)
(SourcePos -> Int
sourceLine SourcePos
pos)
(SourcePos -> Int
sourceColumn SourcePos
pos))
else [Char] -> ParsecT Text () Identity (Token, Location)
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected [Char]
"indented newline"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atomThenSpace Token
If [Char]
"if"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atomThenSpace Token
Then [Char]
"then"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atomThenSpace Token
Else [Char]
"else"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atomThenSpace Token
Case [Char]
"case"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atomThenSpace Token
Of [Char]
"of"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
RightArrow [Char]
"->"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
Period [Char]
"."
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
Colon [Char]
":"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
Backslash [Char]
"\\"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
OpenParen [Char]
"("
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
CloseParen [Char]
")"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
OpenBrace [Char]
"{"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
CloseBrace [Char]
"}"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
OpenBracket [Char]
"["
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
CloseBracket [Char]
"]"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
Dollar [Char]
"$"
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
Comma [Char]
","
, do (Token, Location)
tok <-
(Text -> Token)
-> Parser Text
-> [Char]
-> ParsecT Text () Identity (Token, Location)
forall t.
(Text -> t) -> Parser Text -> [Char] -> Parser (t, Location)
parsing
Text -> Token
Operator
(([Char] -> Text) -> ParsecT Text () Identity [Char] -> Parser Text
forall a b.
(a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
[Char] -> Text
T.pack
([ParsecT Text () Identity [Char]]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ [Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"*"
, [Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"+"
, ParsecT Text () Identity [Char] -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
">=")
, ParsecT Text () Identity [Char] -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<=")
, ParsecT Text () Identity [Char] -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"/=")
, [Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
">"
, [Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<"
, [Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"/"
, [Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"="
, [Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"&&"
, ParsecT Text () Identity [Char] -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"||")
]))
[Char]
"operator (e.g. *, <, +, =, etc.)"
Bool -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
prespaces)
([Char] -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected
((Token, Location) -> [Char]
tokenString (Token, Location)
tok [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
", there should be spaces before and after operators."))
ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text () Identity ()
spaces1 ParsecT Text () Identity ()
-> [Char] -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> ([Char]
"space after " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Token, Location) -> [Char]
tokenString (Token, Location)
tok)
(Token, Location) -> ParsecT Text () Identity (Token, Location)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token, Location)
tok
, Token -> [Char] -> ParsecT Text () Identity (Token, Location)
forall t. t -> [Char] -> Parser (t, Location)
atom Token
Bar [Char]
"|"
, (Text -> Token)
-> Parser Text
-> [Char]
-> ParsecT Text () Identity (Token, Location)
forall t.
(Text -> t) -> Parser Text -> [Char] -> Parser (t, Location)
parsing
Text -> Token
StringToken
(do [Char]
_ <- [Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\""
[Char]
chars <- ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Char -> Bool) -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'))
Bool -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
((Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') [Char]
chars)
([Char] -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected [Char]
"\\ character, not allowed inside a string.")
Bool -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
((Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') [Char]
chars)
([Char] -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected [Char]
"newline character, not allowed inside a string.")
[Char]
_ <- [Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\"" ParsecT Text () Identity [Char]
-> [Char] -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"double quotes (\") to close the string"
Text -> Parser Text
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Text
T.pack [Char]
chars))
[Char]
"string (e.g. \"hello\", \"123\", etc.)"
, do (Token
var, Location
loc) <-
(Text -> Token)
-> Parser Text
-> [Char]
-> ParsecT Text () Identity (Token, Location)
forall t.
(Text -> t) -> Parser Text -> [Char] -> Parser (t, Location)
parsing
Text -> Token
VariableToken
(do [Char]
variable <-
do [Char]
start <- ParsecT Text () Identity Char -> ParsecT Text () Identity [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 Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
isLetter Char
c))
[Char]
end <-
ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many
((Char -> Bool) -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy
(\Char
c -> Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c))
[Char] -> ParsecT Text () Identity [Char]
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
start [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
end)
Text -> Parser Text
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Text
T.pack [Char]
variable))
[Char]
"variable (e.g. “elephant”, “age”, “t2”, etc.)"
(Token, Location) -> ParsecT Text () Identity (Token, Location)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( case Token
var of
VariableToken Text
"null" -> Token
NullToken
VariableToken Text
"true" -> Token
TrueToken
VariableToken Text
"false" -> Token
FalseToken
Token
_ -> Token
var
, Location
loc)
, [Char] -> ParsecT Text () Identity (Token, Location)
forall a. [a] -> ParsecT Text () Identity (Token, Location)
parseNumbers [Char]
prespaces
]
where
spaces1 :: Parser ()
spaces1 :: ParsecT Text () Identity ()
spaces1 = ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
ellipsis :: Int -> [Char] -> [Char]
ellipsis :: Int -> [Char] -> [Char]
ellipsis Int
n [Char]
text =
if [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
text Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2
then Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
n [Char]
text [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"…"
else [Char]
text
specialParsing :: (t1 -> t) -> Parser t1 -> String -> Parser (t, Location)
specialParsing :: forall t1 t.
(t1 -> t) -> Parser t1 -> [Char] -> Parser (t, Location)
specialParsing t1 -> t
constructor Parser t1
parser [Char]
description = do
SourcePos
start <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
t1
thing <- Parser t1
parser Parser t1 -> [Char] -> Parser t1
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
description
SourcePos
end <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(t, Location) -> Parser (t, Location)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( t1 -> t
constructor t1
thing
, Int -> Int -> Int -> Int -> Location
Location
(SourcePos -> Int
sourceLine SourcePos
start)
(SourcePos -> Int
sourceColumn SourcePos
start)
(SourcePos -> Int
sourceLine SourcePos
end)
(SourcePos -> Int
sourceColumn SourcePos
end))
atom :: t -> String -> Parser (t, Location)
atom :: forall t. t -> [Char] -> Parser (t, Location)
atom t
constructor [Char]
text = do
SourcePos
start <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
[Char]
_ <- ParsecT Text () Identity [Char] -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
text) ParsecT Text () Identity [Char]
-> [Char] -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char] -> [Char]
smartQuotes [Char]
text
SourcePos
end <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(t, Location) -> Parser (t, Location)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( t
constructor
, Int -> Int -> Int -> Int -> Location
Location
(SourcePos -> Int
sourceLine SourcePos
start)
(SourcePos -> Int
sourceColumn SourcePos
start)
(SourcePos -> Int
sourceLine SourcePos
end)
(SourcePos -> Int
sourceColumn SourcePos
end))
atomThenSpace :: t -> String -> Parser (t, Location)
atomThenSpace :: forall t. t -> [Char] -> Parser (t, Location)
atomThenSpace t
constructor [Char]
text = do
SourcePos
start <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
[Char]
_ <-
ParsecT Text () Identity [Char] -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (([Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
text ParsecT Text () Identity [Char]
-> [Char] -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char] -> [Char]
smartQuotes [Char]
text) ParsecT Text () Identity [Char]
-> ParsecT Text () Identity () -> ParsecT Text () Identity [Char]
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
(ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text () Identity ()
spaces1 ParsecT Text () Identity ()
-> [Char] -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> ([Char]
"space or newline after " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
smartQuotes [Char]
text)))
SourcePos
end <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(t, Location) -> Parser (t, Location)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( t
constructor
, Int -> Int -> Int -> Int -> Location
Location
(SourcePos -> Int
sourceLine SourcePos
start)
(SourcePos -> Int
sourceColumn SourcePos
start)
(SourcePos -> Int
sourceLine SourcePos
end)
(SourcePos -> Int
sourceColumn SourcePos
end))
parsing :: (Text -> t) -> Parser Text -> String -> Parser (t, Location)
parsing :: forall t.
(Text -> t) -> Parser Text -> [Char] -> Parser (t, Location)
parsing Text -> t
constructor Parser Text
parser [Char]
description = do
SourcePos
start <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Text
text <- Parser Text
parser Parser Text -> [Char] -> Parser Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
description
SourcePos
end <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(t, Location) -> Parser (t, Location)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Text -> t
constructor Text
text
, Int -> Int -> Int -> Int -> Location
Location
(SourcePos -> Int
sourceLine SourcePos
start)
(SourcePos -> Int
sourceColumn SourcePos
start)
(SourcePos -> Int
sourceLine SourcePos
end)
(SourcePos -> Int
sourceColumn SourcePos
end))
parseNumbers :: [a] -> Parser (Token, Location)
parseNumbers :: forall a. [a] -> ParsecT Text () Identity (Token, Location)
parseNumbers [a]
prespaces = ParsecT Text () Identity (Token, Location)
parser ParsecT Text () Identity (Token, Location)
-> [Char] -> ParsecT Text () Identity (Token, Location)
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"number (e.g. 42, 3.141, etc.)"
where
parser :: ParsecT Text () Identity (Token, Location)
parser = do
SourcePos
start <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Maybe Char
neg <- (Char -> Maybe Char)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (Maybe Char)
forall a b.
(a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') ParsecT Text () Identity (Maybe Char)
-> ParsecT Text () Identity (Maybe Char)
-> ParsecT Text () Identity (Maybe Char)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe Char -> ParsecT Text () Identity (Maybe Char)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Char
forall a. Maybe a
Nothing
let operator :: ParsecT s u Identity (Token, Location)
operator = do
SourcePos
end <- ParsecT s u Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(Token, Location) -> ParsecT s u Identity (Token, Location)
forall a. a -> ParsecT s u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Text -> Token
Operator Text
"-"
, Int -> Int -> Int -> Int -> Location
Location
(SourcePos -> Int
sourceLine SourcePos
start)
(SourcePos -> Int
sourceColumn SourcePos
start)
(SourcePos -> Int
sourceLine SourcePos
end)
(SourcePos -> Int
sourceColumn SourcePos
end))
number
:: (forall a. (Num a) =>
a -> a)
-> Parser (Token, Location)
number :: (forall a. Num a => a -> a)
-> ParsecT Text () Identity (Token, Location)
number forall a. Num a => a -> a
f = do
[Char]
x <- ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
(do Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
[Char]
y <- ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT Text () Identity [Char]
-> [Char] -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> ([Char]
"decimal component, e.g. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".0")
SourcePos
end <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(Token, Location) -> ParsecT Text () Identity (Token, Location)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Double -> Token
Decimal (Double -> Double
forall a. Num a => a -> a
f ([Char] -> Double
forall a. Read a => [Char] -> a
read ([Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
y)))
, Int -> Int -> Int -> Int -> Location
Location
(SourcePos -> Int
sourceLine SourcePos
start)
(SourcePos -> Int
sourceColumn SourcePos
start)
(SourcePos -> Int
sourceLine SourcePos
end)
(SourcePos -> Int
sourceColumn SourcePos
end))) ParsecT Text () Identity (Token, Location)
-> ParsecT Text () Identity (Token, Location)
-> ParsecT Text () Identity (Token, Location)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(do SourcePos
end <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(Token, Location) -> ParsecT Text () Identity (Token, Location)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Integer -> Token
Integer (Integer -> Integer
forall a. Num a => a -> a
f ([Char] -> Integer
forall a. Read a => [Char] -> a
read [Char]
x))
, Int -> Int -> Int -> Int -> Location
Location
(SourcePos -> Int
sourceLine SourcePos
start)
(SourcePos -> Int
sourceColumn SourcePos
start)
(SourcePos -> Int
sourceLine SourcePos
end)
(SourcePos -> Int
sourceColumn SourcePos
end)))
case Maybe Char
neg of
Maybe Char
Nothing -> (forall a. Num a => a -> a)
-> ParsecT Text () Identity (Token, Location)
number a -> a
forall a. a -> a
forall a. Num a => a -> a
id
Just {} -> do
Bool -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
prespaces)
([Char] -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected
([Char] -> [Char]
curlyQuotes [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", there should be a space before it."))
((forall a. Num a => a -> a)
-> ParsecT Text () Identity (Token, Location)
number (a -> a -> a
forall a. Num a => a -> a -> a
* (-a
1)) ParsecT Text () Identity (Token, Location)
-> [Char] -> ParsecT Text () Identity (Token, Location)
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"number (e.g. 123)") ParsecT Text () Identity (Token, Location)
-> ParsecT Text () Identity (Token, Location)
-> ParsecT Text () Identity (Token, Location)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
ParsecT Text () Identity (Token, Location)
forall {s} {u}. ParsecT s u Identity (Token, Location)
operator ParsecT Text () Identity (Token, Location)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (Token, Location)
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT Text () Identity Char
-> [Char] -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> ([Char]
"space after operator " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
curlyQuotes [Char]
"-"))
smartQuotes :: [Char] -> [Char]
smartQuotes :: [Char] -> [Char]
smartQuotes [Char]
t = [Char]
"“" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
t [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"”"
equalToken :: Token -> TokenParser Location
equalToken :: Token -> TokenParser Location
equalToken Token
p = ((Token, Location) -> Location)
-> ParsecT s Int m (Token, Location) -> ParsecT s Int m Location
forall a b. (a -> b) -> ParsecT s Int m a -> ParsecT s Int m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Token, Location) -> Location
forall a b. (a, b) -> b
snd ((Token -> Bool) -> TokenParser (Token, Location)
satisfyToken (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
==Token
p) ParsecT s Int m (Token, Location)
-> [Char] -> ParsecT s Int m (Token, Location)
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> Token -> [Char]
tokenStr Token
p)
satisfyToken :: (Token -> Bool) -> TokenParser (Token, Location)
satisfyToken :: (Token -> Bool) -> TokenParser (Token, Location)
satisfyToken Token -> Bool
p =
(Token -> Maybe Token) -> TokenParser (Token, Location)
forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken (\Token
tok -> if Token -> Bool
p Token
tok
then Token -> Maybe Token
forall a. a -> Maybe a
Just Token
tok
else Maybe Token
forall a. Maybe a
Nothing)
anyToken :: TokenParser (Token, Location)
anyToken :: TokenParser (Token, Location)
anyToken = (Token -> Maybe Token) -> TokenParser (Token, Location)
forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken Token -> Maybe Token
forall a. a -> Maybe a
Just
consumeToken :: (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken :: forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken Token -> Maybe a
f = do
Int
u <- ParsecT s Int m Int
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
((Token, Location) -> [Char])
-> (SourcePos -> (Token, Location) -> s -> SourcePos)
-> ((Token, Location) -> Maybe (a, Location))
-> ParsecT s Int m (a, Location)
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> [Char])
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim
(Token, Location) -> [Char]
tokenString
SourcePos -> (Token, Location) -> s -> SourcePos
forall t. SourcePos -> (Token, Location) -> t -> SourcePos
tokenPosition
(\(Token
tok, Location
loc) ->
if Location -> Int
locationStartColumn Location
loc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
u
then (a -> (a, Location)) -> Maybe a -> Maybe (a, Location)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Location
loc) (Token -> Maybe a
f Token
tok)
else Maybe (a, Location)
forall a. Maybe a
Nothing)
tokenString :: (Token, Location) -> [Char]
tokenString :: (Token, Location) -> [Char]
tokenString = Token -> [Char]
tokenStr (Token -> [Char])
-> ((Token, Location) -> Token) -> (Token, Location) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token, Location) -> Token
forall a b. (a, b) -> a
fst
tokenStr :: Token -> [Char]
tokenStr :: Token -> [Char]
tokenStr Token
tok =
case Token
tok of
Token
If -> [Char] -> [Char]
curlyQuotes [Char]
"if"
Token
Then -> [Char] -> [Char]
curlyQuotes [Char]
"then"
Token
RightArrow -> [Char] -> [Char]
curlyQuotes [Char]
"->"
Token
Else -> [Char] -> [Char]
curlyQuotes [Char]
"else"
Token
Case -> [Char] -> [Char]
curlyQuotes [Char]
"case"
Token
Of -> [Char] -> [Char]
curlyQuotes [Char]
"of"
Token
NonIndentedNewline -> [Char]
"non-indented newline"
Token
Backslash -> [Char] -> [Char]
curlyQuotes ([Char]
"backslash " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
curlyQuotes [Char]
"\\")
Token
OpenParen -> [Char]
"opening parenthesis " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
curlyQuotes [Char]
"("
Token
CloseParen -> [Char]
"closing parenthesis " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
curlyQuotes [Char]
")"
VariableToken Text
t -> [Char]
"variable " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
curlyQuotes (Text -> [Char]
T.unpack Text
t)
StringToken !Text
t -> [Char]
"string " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t
Operator !Text
t -> [Char]
"operator " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
curlyQuotes (Text -> [Char]
T.unpack Text
t)
Token
Comma -> [Char] -> [Char]
curlyQuotes [Char]
","
Integer !Integer
i -> [Char]
"integer " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i
Decimal !Double
d -> [Char]
"decimal " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%f" Double
d
Token
Bar -> [Char] -> [Char]
curlyQuotes [Char]
"|"
Token
Dollar -> [Char] -> [Char]
curlyQuotes [Char]
"$"
Token
Period -> [Char] -> [Char]
curlyQuotes [Char]
"."
Token
TrueToken -> [Char] -> [Char]
curlyQuotes [Char]
"true"
Token
FalseToken -> [Char] -> [Char]
curlyQuotes [Char]
"false"
Token
NullToken -> [Char] -> [Char]
curlyQuotes [Char]
"null"
Token
CloseBrace -> [Char] -> [Char]
curlyQuotes [Char]
"}"
Token
OpenBrace -> [Char] -> [Char]
curlyQuotes [Char]
"{"
Token
CloseBracket -> [Char] -> [Char]
curlyQuotes [Char]
"]"
Token
OpenBracket -> [Char] -> [Char]
curlyQuotes [Char]
"["
Token
Colon -> [Char] -> [Char]
curlyQuotes [Char]
":"
tokenPosition :: SourcePos -> (Token, Location) -> t -> SourcePos
tokenPosition :: forall t. SourcePos -> (Token, Location) -> t -> SourcePos
tokenPosition SourcePos
pos (Token
_, Location
l) t
_ =
SourcePos -> Int -> SourcePos
setSourceColumn (SourcePos -> Int -> SourcePos
setSourceLine SourcePos
pos Int
line) Int
col
where (Int
line,Int
col) = (Location -> Int
locationStartLine Location
l, Location -> Int
locationStartColumn Location
l)
type TokenParser e = forall s m. Stream s m (Token, Location) => ParsecT s Int m e
notFollowedBy' :: TokenParser (Token, Location) -> TokenParser ()
notFollowedBy' :: TokenParser (Token, Location) -> TokenParser ()
notFollowedBy' TokenParser (Token, Location)
p =
ParsecT s Int m () -> ParsecT s Int m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((do (Token, Location)
c <- ParsecT s Int m (Token, Location)
-> ParsecT s Int m (Token, Location)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s Int m (Token, Location)
TokenParser (Token, Location)
p
[Char] -> ParsecT s Int m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected ((Token, Location) -> [Char]
tokenString (Token, Location)
c)) ParsecT s Int m () -> ParsecT s Int m () -> ParsecT s Int m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
() -> ParsecT s Int m ()
forall a. a -> ParsecT s Int m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
endOfTokens :: TokenParser ()
endOfTokens :: TokenParser ()
endOfTokens = TokenParser (Token, Location) -> TokenParser ()
notFollowedBy' ParsecT s Int m (Token, Location)
TokenParser (Token, Location)
anyToken ParsecT s Int m () -> [Char] -> ParsecT s Int m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"end of input"
curlyQuotes :: [Char] -> [Char]
curlyQuotes :: [Char] -> [Char]
curlyQuotes [Char]
t = [Char]
"‘" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
t [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"’"