{- |
Module                  : Toml.Parser.Item
Copyright               : (c) 2018-2021 Kowainik
SPDX-License-Identifier : MPL-2.0
Maintainer              : Kowainik <xrom.xkov@gmail.com>
Stability               : Stable
Portability             : Portable

This module contains the definition of the 'TomlItem' data type which
represents either key-value pair or table name. This data type serves the
purpose to be the intermediate representation of parsing a TOML file which will
be assembled to TOML AST later.

@since 1.2.0.0
-}

module Toml.Parser.Item
       ( TomlItem (..)
       , Table (..)
       , setTableName

       , tomlP
       , keyValP
       ) where

import Control.Applicative (liftA2, many)
import Control.Applicative.Combinators.NonEmpty (sepEndBy1)
import Control.Monad.Combinators (between, sepEndBy)
import Data.Foldable (asum)
import Data.List.NonEmpty (NonEmpty)

import Toml.Parser.Core (Parser, eof, sc, text, try, (<?>))
import Toml.Parser.Key (keyP, tableArrayNameP, tableNameP)
import Toml.Parser.Value (anyValueP)
import Toml.Type.AnyValue (AnyValue)
import Toml.Type.Key (Key)


{- | One item of a TOML file. It could be either:

* A name of a table
* A name of a table array
* Key-value pair
* Inline table
* Inline array of tables

Knowing a list of 'TomlItem's, it's possible to construct 'Toml.Type.TOML.TOML'
from this information.
-}
data TomlItem
    = TableName !Key
    | TableArrayName !Key
    | KeyVal !Key !AnyValue
    | InlineTable !Key !Table
    | InlineTableArray !Key !(NonEmpty Table)
    deriving stock (Int -> TomlItem -> ShowS
[TomlItem] -> ShowS
TomlItem -> String
(Int -> TomlItem -> ShowS)
-> (TomlItem -> String) -> ([TomlItem] -> ShowS) -> Show TomlItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TomlItem] -> ShowS
$cshowList :: [TomlItem] -> ShowS
show :: TomlItem -> String
$cshow :: TomlItem -> String
showsPrec :: Int -> TomlItem -> ShowS
$cshowsPrec :: Int -> TomlItem -> ShowS
Show, TomlItem -> TomlItem -> Bool
(TomlItem -> TomlItem -> Bool)
-> (TomlItem -> TomlItem -> Bool) -> Eq TomlItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TomlItem -> TomlItem -> Bool
$c/= :: TomlItem -> TomlItem -> Bool
== :: TomlItem -> TomlItem -> Bool
$c== :: TomlItem -> TomlItem -> Bool
Eq)

{- | Changes name of table to a new one. Works only for 'TableName' and
'TableArrayName' constructors.
-}
setTableName :: Key -> TomlItem -> TomlItem
setTableName :: Key -> TomlItem -> TomlItem
setTableName Key
new = \case
    TableName Key
_ -> Key -> TomlItem
TableName Key
new
    TableArrayName Key
_ -> Key -> TomlItem
TableArrayName Key
new
    TomlItem
item -> TomlItem
item

{- | Table that contains only @key = val@ pairs.
-}
newtype Table = Table
    { Table -> [(Key, AnyValue)]
unTable :: [(Key, AnyValue)]
    } deriving stock (Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show)
      deriving newtype (Table -> Table -> Bool
(Table -> Table -> Bool) -> (Table -> Table -> Bool) -> Eq Table
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c== :: Table -> Table -> Bool
Eq)

----------------------------------------------------------------------------
-- Parser
----------------------------------------------------------------------------

-- | Parser for inline tables.
inlineTableP :: Parser Table
inlineTableP :: Parser Table
inlineTableP =
    ([(Key, AnyValue)] -> Table)
-> ParsecT Void Text Identity [(Key, AnyValue)] -> Parser Table
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Key, AnyValue)] -> Table
Table
    (ParsecT Void Text Identity [(Key, AnyValue)] -> Parser Table)
-> ParsecT Void Text Identity [(Key, AnyValue)] -> Parser Table
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [(Key, AnyValue)]
-> ParsecT Void Text Identity [(Key, AnyValue)]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> ParsecT Void Text Identity Text
text Text
"{") (Text -> ParsecT Void Text Identity Text
text Text
"}")
    (ParsecT Void Text Identity [(Key, AnyValue)]
 -> ParsecT Void Text Identity [(Key, AnyValue)])
-> ParsecT Void Text Identity [(Key, AnyValue)]
-> ParsecT Void Text Identity [(Key, AnyValue)]
forall a b. (a -> b) -> a -> b
$ (Key -> AnyValue -> (Key, AnyValue))
-> ParsecT Void Text Identity Key
-> ParsecT Void Text Identity AnyValue
-> ParsecT Void Text Identity (Key, AnyValue)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (ParsecT Void Text Identity Key
keyP ParsecT Void Text Identity Key
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Key
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParsecT Void Text Identity Text
text Text
"=") ParsecT Void Text Identity AnyValue
anyValueP ParsecT Void Text Identity (Key, AnyValue)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [(Key, AnyValue)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy` Text -> ParsecT Void Text Identity Text
text Text
","

-- | Parser for inline arrays of tables.
inlineTableArrayP :: Parser (NonEmpty Table)
inlineTableArrayP :: Parser (NonEmpty Table)
inlineTableArrayP = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> Parser (NonEmpty Table)
-> Parser (NonEmpty Table)
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> ParsecT Void Text Identity Text
text Text
"[") (Text -> ParsecT Void Text Identity Text
text Text
"]")
    (Parser (NonEmpty Table) -> Parser (NonEmpty Table))
-> Parser (NonEmpty Table) -> Parser (NonEmpty Table)
forall a b. (a -> b) -> a -> b
$ Parser Table
inlineTableP Parser Table
-> ParsecT Void Text Identity Text -> Parser (NonEmpty Table)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`sepEndBy1` Text -> ParsecT Void Text Identity Text
text Text
","

-- | Parser for a single item in the TOML file.
tomlItemP :: Parser TomlItem
tomlItemP :: Parser TomlItem
tomlItemP = [Parser TomlItem] -> Parser TomlItem
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Key -> TomlItem
TableName (Key -> TomlItem)
-> ParsecT Void Text Identity Key -> Parser TomlItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Key -> ParsecT Void Text Identity Key
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Key
tableNameP Parser TomlItem -> String -> Parser TomlItem
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"table name"
    , Key -> TomlItem
TableArrayName (Key -> TomlItem)
-> ParsecT Void Text Identity Key -> Parser TomlItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Key
tableArrayNameP Parser TomlItem -> String -> Parser TomlItem
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"array of tables name"
    , Parser TomlItem
keyValP
    ]

{- | parser for @"key = val"@ pairs; can be one of three forms:

1. key = { ... }
2. key = [ {...}, {...}, ... ]
3. key = ...
-}
keyValP :: Parser TomlItem
keyValP :: Parser TomlItem
keyValP = do
    Key
key <- ParsecT Void Text Identity Key
keyP ParsecT Void Text Identity Key
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Key
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParsecT Void Text Identity Text
text Text
"="
    [Parser TomlItem] -> Parser TomlItem
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ Key -> Table -> TomlItem
InlineTable Key
key (Table -> TomlItem) -> Parser Table -> Parser TomlItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Table
inlineTableP Parser TomlItem -> String -> Parser TomlItem
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"inline table"
        , Key -> NonEmpty Table -> TomlItem
InlineTableArray Key
key (NonEmpty Table -> TomlItem)
-> Parser (NonEmpty Table) -> Parser TomlItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (NonEmpty Table) -> Parser (NonEmpty Table)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (NonEmpty Table)
inlineTableArrayP Parser TomlItem -> String -> Parser TomlItem
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"inline array of tables"
        , Key -> AnyValue -> TomlItem
KeyVal Key
key (AnyValue -> TomlItem)
-> ParsecT Void Text Identity AnyValue -> Parser TomlItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity AnyValue
anyValueP Parser TomlItem -> String -> Parser TomlItem
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"key-value pair"
        ]

-- | Parser for the full content of the .toml file.
tomlP :: Parser [TomlItem]
tomlP :: Parser [TomlItem]
tomlP = Parser ()
sc Parser () -> Parser [TomlItem] -> Parser [TomlItem]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TomlItem -> Parser [TomlItem]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TomlItem
tomlItemP Parser [TomlItem] -> Parser () -> Parser [TomlItem]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof