{- |
Copyright: (c) 2018-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Core functions for TOML parser.
-}

module Toml.Parser.Core
       ( -- * Reexports from @megaparsec@
         module Text.Megaparsec
       , module Text.Megaparsec.Char
       , module Text.Megaparsec.Char.Lexer

         -- * Core parsers for TOML
       , Parser
       , lexeme
       , sc
       , text
       ) where

import Control.Applicative (Alternative (empty))

import Data.Text (Text)
import Data.Void (Void)

import Text.Megaparsec (Parsec, anySingle, eof, errorBundlePretty, match, parse, satisfy, try,
                        (<?>))
import Text.Megaparsec.Char (alphaNumChar, char, digitChar, eol, hexDigitChar, octDigitChar, binDigitChar, space, space1,
                             string, tab)
import Text.Megaparsec.Char.Lexer (binary, float, hexadecimal, octal, signed, skipLineComment,
                                   symbol)
import qualified Text.Megaparsec.Char.Lexer as L (lexeme, space)


-- | The parser
type Parser = Parsec Void Text

-- | Space and comment consumer. Currently also consumes newlines.
sc :: Parser ()
sc :: Parser ()
sc = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 Parser ()
lineComment Parser ()
forall a. ParsecT Void Text Identity a
blockComment
  where
    lineComment :: Parser ()
lineComment  = Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
skipLineComment "#"
    blockComment :: ParsecT Void Text Identity a
blockComment = ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

{- | Wrapper for consuming spaces after every lexeme (not before it!). Consumes
all characters according to 'sc' parser.
-}
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 ()
sc

-- | 'Parser' for "fixed" string.
text :: Text -> Parser Text
text :: Text -> Parser Text
text = Parser ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
symbol Parser ()
sc