{-# LANGUAGE OverloadedStrings #-}

module Data.EDN.AST.Lexer
  ( dropWS
  , lexeme
  , symbol
  , integer
  , hexadecimal
  , floating
  ) where

import Data.Text (Text)

import qualified Control.Monad.Combinators as P
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Char as P
import qualified Text.Megaparsec.Char.Lexer as L

import Data.EDN.AST.Types (Parser)

dropWS :: Parser ()
dropWS :: Parser ()
dropWS = Parser () -> Parser ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
P.skipMany (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ [Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
  [ Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.hidden Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space1
  , Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.hidden (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ () () -> ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
','
  , Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.hidden (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens Text
";"
  ]

-- | Whitespace will be consumed after every lexeme automatically, but not before it.
lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme = Parser () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parser ()
dropWS

symbol :: Text -> Parser Text
symbol :: Text -> Parser Text
symbol = Parser ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser ()
dropWS

integer :: Parser Int
integer :: Parser Int
integer = Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser Int -> Parser Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed (() -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Parser Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

hexadecimal :: Parser Int
hexadecimal :: Parser Int
hexadecimal = Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme Parser Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.hexadecimal

floating :: Parser Double
floating :: Parser Double
floating = Parser Double -> Parser Double
forall a. Parser a -> Parser a
lexeme (Parser Double -> Parser Double) -> Parser Double -> Parser Double
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser Double -> Parser Double
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed (() -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Parser Double
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
L.float