{-# LANGUAGE DeriveAnyClass #-}

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

Parser for text to TOML AST.
-}

module Toml.Parser
       ( ParseException (..)
       , parse
       ) where

import Control.DeepSeq (NFData)
import Data.Text (Text)
import GHC.Generics (Generic)

import Toml.Parser.Item (tomlP)
import Toml.Parser.Validate (validateItems)
import Toml.Type (TOML)

import qualified Data.Text as T
import qualified Toml.Parser.Core as P (errorBundlePretty, parse)


-- | Pretty parse exception for parsing toml.
newtype ParseException = ParseException
    { ParseException -> Text
unParseException :: Text
    } deriving stock (Int -> ParseException -> ShowS
[ParseException] -> ShowS
ParseException -> String
(Int -> ParseException -> ShowS)
-> (ParseException -> String)
-> ([ParseException] -> ShowS)
-> Show ParseException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseException] -> ShowS
$cshowList :: [ParseException] -> ShowS
show :: ParseException -> String
$cshow :: ParseException -> String
showsPrec :: Int -> ParseException -> ShowS
$cshowsPrec :: Int -> ParseException -> ShowS
Show, (forall x. ParseException -> Rep ParseException x)
-> (forall x. Rep ParseException x -> ParseException)
-> Generic ParseException
forall x. Rep ParseException x -> ParseException
forall x. ParseException -> Rep ParseException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParseException x -> ParseException
$cfrom :: forall x. ParseException -> Rep ParseException x
Generic)
      deriving newtype (ParseException -> ParseException -> Bool
(ParseException -> ParseException -> Bool)
-> (ParseException -> ParseException -> Bool) -> Eq ParseException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseException -> ParseException -> Bool
$c/= :: ParseException -> ParseException -> Bool
== :: ParseException -> ParseException -> Bool
$c== :: ParseException -> ParseException -> Bool
Eq, ParseException -> ()
(ParseException -> ()) -> NFData ParseException
forall a. (a -> ()) -> NFData a
rnf :: ParseException -> ()
$crnf :: ParseException -> ()
NFData)

{- | Parses 'Text' as 'TOML' AST object. If you want to convert 'Text' to your
custom haskell data type, use 'Toml.Bi.Code.decode' or 'Toml.Bi.Code.decodeFile'
functions.
-}
parse :: Text -> Either ParseException TOML
parse :: Text -> Either ParseException TOML
parse t :: Text
t = case Parsec Void Text [TomlItem]
-> String -> Text -> Either (ParseErrorBundle Text Void) [TomlItem]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.parse Parsec Void Text [TomlItem]
tomlP "" Text
t of
    Left err :: ParseErrorBundle Text Void
err    -> ParseException -> Either ParseException TOML
forall a b. a -> Either a b
Left (ParseException -> Either ParseException TOML)
-> ParseException -> Either ParseException TOML
forall a b. (a -> b) -> a -> b
$ Text -> ParseException
ParseException (Text -> ParseException) -> Text -> ParseException
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> String
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
P.errorBundlePretty ParseErrorBundle Text Void
err
    Right items :: [TomlItem]
items -> case [TomlItem] -> Either ValidationError TOML
validateItems [TomlItem]
items of
        Left err :: ValidationError
err   -> ParseException -> Either ParseException TOML
forall a b. a -> Either a b
Left (ParseException -> Either ParseException TOML)
-> ParseException -> Either ParseException TOML
forall a b. (a -> b) -> a -> b
$ Text -> ParseException
ParseException (Text -> ParseException) -> Text -> ParseException
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ValidationError -> String
forall a. Show a => a -> String
show ValidationError
err
        Right toml :: TOML
toml -> TOML -> Either ParseException TOML
forall a b. b -> Either a b
Right TOML
toml