{- | Parsers for keys and table names.

@since 1.2.0.0
-}

module Toml.Parser.Key
       ( keyP
       , tableNameP
       , tableArrayNameP
       ) where

import Control.Applicative (Alternative (..))
import Control.Applicative.Combinators.NonEmpty (sepBy1)
import Control.Monad.Combinators (between)
import Data.Semigroup ((<>))
import Data.Text (Text)

import Toml.Parser.Core (Parser, alphaNumChar, char, lexeme, text)
import Toml.Parser.String (basicStringP, literalStringP)
import Toml.PrefixTree (Key (..), Piece (..))

import qualified Data.Text as Text


-- | Parser for bare key piece, like @foo@.
bareKeyPieceP :: Parser Text
bareKeyPieceP :: Parser Text
bareKeyPieceP = Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity String
bareStrP
  where
    bareStrP :: Parser String
    bareStrP :: ParsecT Void Text Identity String
bareStrP = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> 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)
char Token Text
'_' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> 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)
char Token Text
'-'

-- | Parser for 'Piece'.
keyComponentP :: Parser Piece
keyComponentP :: Parser Piece
keyComponentP = Text -> Piece
Piece (Text -> Piece) -> Parser Text -> Parser Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Parser Text
bareKeyPieceP Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Text -> Text
quote "\"" (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
basicStringP) Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Text -> Text
quote "'" (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
literalStringP))
  where
    -- adds " or ' to both sides
    quote :: Text -> Text -> Text
    quote :: Text -> Text -> Text
quote q :: Text
q t :: Text
t = Text
q Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

-- | Parser for 'Key': dot-separated list of 'Piece'.
keyP :: Parser Key
keyP :: Parser Key
keyP = NonEmpty Piece -> Key
Key (NonEmpty Piece -> Key)
-> ParsecT Void Text Identity (NonEmpty Piece) -> Parser Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Piece
keyComponentP Parser Piece
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (NonEmpty Piece)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`sepBy1` Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'.'

-- | Parser for table name: 'Key' inside @[]@.
tableNameP :: Parser Key
tableNameP :: Parser Key
tableNameP = Parser Text -> Parser Text -> Parser Key -> Parser Key
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
text "[") (Text -> Parser Text
text "]") Parser Key
keyP

-- | Parser for array of tables name: 'Key' inside @[[]]@.
tableArrayNameP :: Parser Key
tableArrayNameP :: Parser Key
tableArrayNameP = Parser Text -> Parser Text -> Parser Key -> Parser Key
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
text "[[") (Text -> Parser Text
text "]]") Parser Key
keyP