{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Duet syntax tokenizer.

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)

-- | Consume the given predicate from the token stream.
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)

-- | The parser @anyToken@ accepts any kind of token. It is for example
-- used to implement 'eof'. Returns the accepted token.
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

-- | Consume the given predicate from the token stream.
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)

-- | Make a string out of the token, for error message purposes.
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
":"

-- | Update the position by the token.
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 p@ only succeeds when parser @p@ fails. This parser
-- does not consume any input. This parser can be used to implement the
-- \'longest match\' rule. For example, when recognizing keywords (for
-- example @let@), we want to make sure that a keyword is not followed
-- by a legal identifier character, in which case the keyword is
-- actually an identifier (for example @lets@). We can program this
-- behaviour as follows:
--
-- >  keywordLet  = try (do{ string "let"
-- >                       ; notFollowedBy alphaNum
-- >                       })
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 ())

-- | This parser only succeeds at the end of the input. This is not a
-- primitive parser but it is defined using 'notFollowedBy'.
--
-- >  eof  = notFollowedBy anyToken <?> "end of input"
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
"’"