{-# 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 :: FilePath -> Text -> Either ParseError [(Token, Location)]
tokenize FilePath
fp Text
t = Parsec Text () [(Token, Location)]
-> FilePath -> Text -> Either ParseError [(Token, Location)]
forall s t a.
Stream s Identity t =>
Parsec s () a -> FilePath -> s -> Either ParseError a
parse Parsec Text () [(Token, Location)]
tokensTokenizer FilePath
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 FilePath
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 FilePath
-> (FilePath -> ParsecT Text () Identity (Token, Location))
-> ParsecT Text () Identity (Token, Location)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> 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 (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 :: FilePath -> ParsecT Text () Identity (Token, Location)
tokenTokenizer FilePath
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 FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
"\n" FilePath
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 (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 FilePath -> ParsecT Text () Identity (Token, Location)
forall s (m :: * -> *) t u a.
Stream s m t =>
FilePath -> ParsecT s u m a
unexpected FilePath
"indented newline"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atomThenSpace Token
If FilePath
"if"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atomThenSpace Token
Then FilePath
"then"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atomThenSpace Token
Else FilePath
"else"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atomThenSpace Token
Case FilePath
"case"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atomThenSpace Token
Of FilePath
"of"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
RightArrow FilePath
"->"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
Period FilePath
"."
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
Colon FilePath
":"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
Backslash FilePath
"\\"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
OpenParen FilePath
"("
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
CloseParen FilePath
")"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
OpenBrace FilePath
"{"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
CloseBrace FilePath
"}"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
OpenBracket FilePath
"["
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
CloseBracket FilePath
"]"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
Dollar FilePath
"$"
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
Comma FilePath
","
, do (Token, Location)
tok <-
(Text -> Token)
-> Parser Text
-> FilePath
-> ParsecT Text () Identity (Token, Location)
forall t.
(Text -> t) -> Parser Text -> FilePath -> Parser (t, Location)
parsing
Text -> Token
Operator
((FilePath -> Text)
-> ParsecT Text () Identity FilePath -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
FilePath -> Text
T.pack
([ParsecT Text () Identity FilePath]
-> ParsecT Text () Identity FilePath
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"*"
, FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"+"
, ParsecT Text () Identity FilePath
-> ParsecT Text () Identity FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
">=")
, ParsecT Text () Identity FilePath
-> ParsecT Text () Identity FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"<=")
, ParsecT Text () Identity FilePath
-> ParsecT Text () Identity FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"/=")
, FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
">"
, FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"<"
, FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"/"
, FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"="
, FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"&&"
, ParsecT Text () Identity FilePath
-> ParsecT Text () Identity FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"||")
]))
FilePath
"operator (e.g. *, <, +, =, etc.)"
Bool -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
(FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
prespaces)
(FilePath -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
FilePath -> ParsecT s u m a
unexpected
((Token, Location) -> FilePath
tokenString (Token, Location)
tok FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
", 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 ()
-> FilePath -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> (FilePath
"space after " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Token, Location) -> FilePath
tokenString (Token, Location)
tok)
(Token, Location) -> ParsecT Text () Identity (Token, Location)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token, Location)
tok
, Token -> FilePath -> ParsecT Text () Identity (Token, Location)
forall t. t -> FilePath -> Parser (t, Location)
atom Token
Bar FilePath
"|"
, (Text -> Token)
-> Parser Text
-> FilePath
-> ParsecT Text () Identity (Token, Location)
forall t.
(Text -> t) -> Parser Text -> FilePath -> Parser (t, Location)
parsing
Text -> Token
StringToken
(do FilePath
_ <- FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"\""
FilePath
chars <- ParsecT Text () Identity Char -> ParsecT Text () Identity FilePath
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) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') FilePath
chars)
(FilePath -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
FilePath -> ParsecT s u m a
unexpected FilePath
"\\ character, not allowed inside a string.")
Bool -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
((Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') FilePath
chars)
(FilePath -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
FilePath -> ParsecT s u m a
unexpected FilePath
"newline character, not allowed inside a string.")
FilePath
_ <- FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"\"" ParsecT Text () Identity FilePath
-> FilePath -> ParsecT Text () Identity FilePath
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> FilePath
"double quotes (\") to close the string"
Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Text
T.pack FilePath
chars))
FilePath
"string (e.g. \"hello\", \"123\", etc.)"
, do (Token
var, Location
loc) <-
(Text -> Token)
-> Parser Text
-> FilePath
-> ParsecT Text () Identity (Token, Location)
forall t.
(Text -> t) -> Parser Text -> FilePath -> Parser (t, Location)
parsing
Text -> Token
VariableToken
(do FilePath
variable <-
do FilePath
start <- ParsecT Text () Identity Char -> ParsecT Text () Identity FilePath
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))
FilePath
end <-
ParsecT Text () Identity Char -> ParsecT Text () Identity FilePath
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))
FilePath -> ParsecT Text () Identity FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
start FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
end)
Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Text
T.pack FilePath
variable))
FilePath
"variable (e.g. “elephant”, “age”, “t2”, etc.)"
(Token, Location) -> ParsecT Text () Identity (Token, Location)
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)
, FilePath -> ParsecT Text () Identity (Token, Location)
forall a. [a] -> ParsecT Text () Identity (Token, Location)
parseNumbers FilePath
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 (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 -> FilePath -> FilePath
ellipsis Int
n FilePath
text =
if FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
text Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2
then Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
n FilePath
text FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"…"
else FilePath
text
specialParsing :: (t1 -> t) -> Parser t1 -> String -> Parser (t, Location)
specialParsing :: (t1 -> t) -> Parser t1 -> FilePath -> Parser (t, Location)
specialParsing t1 -> t
constructor Parser t1
parser FilePath
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 -> FilePath -> Parser t1
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> FilePath
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 (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 :: t -> FilePath -> Parser (t, Location)
atom t
constructor FilePath
text = do
SourcePos
start <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
FilePath
_ <- ParsecT Text () Identity FilePath
-> ParsecT Text () Identity FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
text) ParsecT Text () Identity FilePath
-> FilePath -> ParsecT Text () Identity FilePath
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> FilePath -> FilePath
smartQuotes FilePath
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 (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 :: t -> FilePath -> Parser (t, Location)
atomThenSpace t
constructor FilePath
text = do
SourcePos
start <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
FilePath
_ <-
ParsecT Text () Identity FilePath
-> ParsecT Text () Identity FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((FilePath -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
text ParsecT Text () Identity FilePath
-> FilePath -> ParsecT Text () Identity FilePath
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> FilePath -> FilePath
smartQuotes FilePath
text) ParsecT Text () Identity FilePath
-> ParsecT Text () Identity () -> ParsecT Text () Identity FilePath
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 ()
-> FilePath -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> (FilePath
"space or newline after " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
smartQuotes FilePath
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 (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 :: (Text -> t) -> Parser Text -> FilePath -> Parser (t, Location)
parsing Text -> t
constructor Parser Text
parser FilePath
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 -> FilePath -> Parser Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> FilePath
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 (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 :: [a] -> ParsecT Text () Identity (Token, Location)
parseNumbers [a]
prespaces = ParsecT Text () Identity (Token, Location)
parser ParsecT Text () Identity (Token, Location)
-> FilePath -> ParsecT Text () Identity (Token, Location)
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> FilePath
"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 (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 (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 (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
FilePath
x <- ParsecT Text () Identity Char -> ParsecT Text () Identity FilePath
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
'.'
FilePath
y <- ParsecT Text () Identity Char -> ParsecT Text () Identity FilePath
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 FilePath
-> FilePath -> ParsecT Text () Identity FilePath
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> (FilePath
"decimal component, e.g. " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".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 (f :: * -> *) a. Applicative f => a -> f a
pure
( Double -> Token
Decimal (Double -> Double
forall a. Num a => a -> a
f (FilePath -> Double
forall a. Read a => FilePath -> a
read (FilePath
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
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 (f :: * -> *) a. Applicative f => a -> f a
pure
( Integer -> Token
Integer (Integer -> Integer
forall a. Num a => a -> a
f (FilePath -> Integer
forall a. Read a => FilePath -> a
read FilePath
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 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
prespaces)
(FilePath -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
FilePath -> ParsecT s u m a
unexpected
(FilePath -> FilePath
curlyQuotes FilePath
"-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", 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)
-> FilePath -> ParsecT Text () Identity (Token, Location)
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> FilePath
"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 (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
-> FilePath -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> (FilePath
"space after operator " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
curlyQuotes FilePath
"-"))
smartQuotes :: [Char] -> [Char]
smartQuotes :: FilePath -> FilePath
smartQuotes FilePath
t = FilePath
"“" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
t FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"”"
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 (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)
-> FilePath -> ParsecT s Int m (Token, Location)
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> Token -> FilePath
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 :: ParsecT s Int m (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 :: (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) -> FilePath)
-> (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 -> FilePath)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim
(Token, Location) -> FilePath
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 (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) -> FilePath
tokenString = Token -> FilePath
tokenStr (Token -> FilePath)
-> ((Token, Location) -> Token) -> (Token, Location) -> FilePath
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 -> FilePath
tokenStr Token
tok =
case Token
tok of
Token
If -> FilePath -> FilePath
curlyQuotes FilePath
"if"
Token
Then -> FilePath -> FilePath
curlyQuotes FilePath
"then"
Token
RightArrow -> FilePath -> FilePath
curlyQuotes FilePath
"->"
Token
Else -> FilePath -> FilePath
curlyQuotes FilePath
"else"
Token
Case -> FilePath -> FilePath
curlyQuotes FilePath
"case"
Token
Of -> FilePath -> FilePath
curlyQuotes FilePath
"of"
Token
NonIndentedNewline -> FilePath
"non-indented newline"
Token
Backslash -> FilePath -> FilePath
curlyQuotes (FilePath
"backslash " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
curlyQuotes FilePath
"\\")
Token
OpenParen -> FilePath
"opening parenthesis " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
curlyQuotes FilePath
"("
Token
CloseParen -> FilePath
"closing parenthesis " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
curlyQuotes FilePath
")"
VariableToken Text
t -> FilePath
"variable " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
curlyQuotes (Text -> FilePath
T.unpack Text
t)
StringToken !Text
t -> FilePath
"string " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
forall a. Show a => a -> FilePath
show Text
t
Operator !Text
t -> FilePath
"operator " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
curlyQuotes (Text -> FilePath
T.unpack Text
t)
Token
Comma -> FilePath -> FilePath
curlyQuotes FilePath
","
Integer !Integer
i -> FilePath
"integer " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i
Decimal !Double
d -> FilePath
"decimal " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> Double -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%f" Double
d
Token
Bar -> FilePath -> FilePath
curlyQuotes FilePath
"|"
Token
Dollar -> FilePath -> FilePath
curlyQuotes FilePath
"$"
Token
Period -> FilePath -> FilePath
curlyQuotes FilePath
"."
Token
TrueToken -> FilePath -> FilePath
curlyQuotes FilePath
"true"
Token
FalseToken -> FilePath -> FilePath
curlyQuotes FilePath
"false"
Token
NullToken -> FilePath -> FilePath
curlyQuotes FilePath
"null"
Token
CloseBrace -> FilePath -> FilePath
curlyQuotes FilePath
"}"
Token
OpenBrace -> FilePath -> FilePath
curlyQuotes FilePath
"{"
Token
CloseBracket -> FilePath -> FilePath
curlyQuotes FilePath
"]"
Token
OpenBracket -> FilePath -> FilePath
curlyQuotes FilePath
"["
Token
Colon -> FilePath -> FilePath
curlyQuotes FilePath
":"
tokenPosition :: SourcePos -> (Token, Location) -> t -> SourcePos
tokenPosition :: 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
FilePath -> ParsecT s Int m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
FilePath -> ParsecT s u m a
unexpected ((Token, Location) -> FilePath
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 (m :: * -> *) a. Monad m => a -> m a
return ())
endOfTokens :: TokenParser ()
endOfTokens :: ParsecT s Int m ()
endOfTokens = TokenParser (Token, Location) -> TokenParser ()
notFollowedBy' TokenParser (Token, Location)
anyToken ParsecT s Int m () -> FilePath -> ParsecT s Int m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
<?> FilePath
"end of input"
curlyQuotes :: [Char] -> [Char]
curlyQuotes :: FilePath -> FilePath
curlyQuotes FilePath
t = FilePath
"‘" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
t FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"’"