{-# LANGUAGE PatternSynonyms #-}
{-|
Module      : Toml
Description : TOML parsing, printing, and codecs
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

This is the high-level interface to the toml-parser library.
It enables parsing, printing, and conversion into and out of
application-specific representations.

This parser implements TOML 1.0.0 <https://toml.io/en/v1.0.0>
as carefully as possible.

Use "Toml.Schema" to implement functions mapping between TOML
values and your application types.

Use "Toml.Syntax" and "Toml.Semantics" for low-level TOML syntax
processing and semantic validation. Most applications will not
need to use these modules directly unless the application is
about TOML itself.

The types and functions of this package are parameterized over
an annotation type in order to allow applications to provide
detailed feedback messages tracked back to specific source
locations in an original TOML file. While the default annotation
is a simple file position, some applications might upgrade this
annotation to track multiple file names or synthetically generated
sources. Other applications won't need source location and can
replace annotations with a simple unit type.

-}
module Toml (

    -- * Types
    Table,
    Value,

    -- * Located types
    Located(..),
    Position(..),
    Table'(..),
    Value'(..),
    valueAnn,
    valueType,
    forgetTableAnns,
    forgetValueAnns,

    -- * Parsing
    decode',
    decode,
    parse,
    DecodeError,
    Result(..),

    -- * Printing
    encode,
    prettyToml,
    DocClass(..),

    -- * Error rendering
    prettyDecodeError,
    prettyLocated,
    prettyMatchMessage,
    prettySemanticError,
    ) where

import Data.Text (Text)
import Text.Printf (printf)
import Toml.Pretty
import Toml.Schema
import Toml.Semantics
import Toml.Syntax

-- | Parse a TOML formatted 'String' or report a structured error message.
parse' :: Text -> Either DecodeError (Table' Position)
parse' :: Text -> Either DecodeError (Table' Position)
parse' Text
str =
    case Text -> Either (Located String) [Expr Position]
parseRawToml Text
str of
        Left Located String
e -> DecodeError -> Either DecodeError (Table' Position)
forall a b. a -> Either a b
Left (Located String -> DecodeError
ErrSyntax Located String
e)
        Right [Expr Position]
exprs ->
            case [Expr Position]
-> Either (SemanticError Position) (Table' Position)
forall a. [Expr a] -> Either (SemanticError a) (Table' a)
semantics [Expr Position]
exprs of
                Left SemanticError Position
e -> DecodeError -> Either DecodeError (Table' Position)
forall a b. a -> Either a b
Left (SemanticError Position -> DecodeError
ErrSemantics SemanticError Position
e)
                Right Table' Position
tab -> Table' Position -> Either DecodeError (Table' Position)
forall a b. b -> Either a b
Right Table' Position
tab

-- | Parse a TOML formatted 'String' or report a human-readable error message.
parse :: Text -> Either String (Table' Position)
parse :: Text -> Either String (Table' Position)
parse Text
str =
    case Text -> Either DecodeError (Table' Position)
parse' Text
str of
        Left DecodeError
e -> String -> Either String (Table' Position)
forall a b. a -> Either a b
Left (DecodeError -> String
prettyDecodeError DecodeError
e)
        Right Table' Position
x -> Table' Position -> Either String (Table' Position)
forall a b. b -> Either a b
Right Table' Position
x

-- | Sum of errors that can occur during TOML decoding
data DecodeError
    = ErrSyntax    (Located String)         -- ^ Error during the lexer/parser phase
    | ErrSemantics (SemanticError Position) -- ^ Error during TOML validation
    | ErrSchema    (MatchMessage Position)  -- ^ Error during schema matching

-- | Decode TOML syntax into an application value.
decode' :: FromValue a => Text -> Result DecodeError a
decode' :: forall a. FromValue a => Text -> Result DecodeError a
decode' Text
str =
    case Text -> Either DecodeError (Table' Position)
parse' Text
str of
        Left DecodeError
e -> [DecodeError] -> Result DecodeError a
forall e a. [e] -> Result e a
Failure [DecodeError
e]
        Right Table' Position
tab ->
            case Matcher Position a -> Result (MatchMessage Position) a
forall l a. Matcher l a -> Result (MatchMessage l) a
runMatcher (Value' Position -> Matcher Position a
forall l. Value' l -> Matcher l a
forall a l. FromValue a => Value' l -> Matcher l a
fromValue (Position -> Table' Position -> Value' Position
forall a. a -> Table' a -> Value' a
Table' Position
startPos Table' Position
tab)) of
                Failure [MatchMessage Position]
es -> [DecodeError] -> Result DecodeError a
forall e a. [e] -> Result e a
Failure (MatchMessage Position -> DecodeError
ErrSchema (MatchMessage Position -> DecodeError)
-> [MatchMessage Position] -> [DecodeError]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchMessage Position]
es)
                Success [MatchMessage Position]
ws a
x -> [DecodeError] -> a -> Result DecodeError a
forall e a. [e] -> a -> Result e a
Success (MatchMessage Position -> DecodeError
ErrSchema (MatchMessage Position -> DecodeError)
-> [MatchMessage Position] -> [DecodeError]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchMessage Position]
ws) a
x

-- | Wrapper rending error and warning messages into human-readable strings.
decode :: FromValue a => Text -> Result String a
decode :: forall a. FromValue a => Text -> Result String a
decode Text
str =
    case Text -> Result DecodeError a
forall a. FromValue a => Text -> Result DecodeError a
decode' Text
str of
        Failure [DecodeError]
e -> [String] -> Result String a
forall e a. [e] -> Result e a
Failure ((DecodeError -> String) -> [DecodeError] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map DecodeError -> String
prettyDecodeError [DecodeError]
e)
        Success [DecodeError]
w a
x -> [String] -> a -> Result String a
forall e a. [e] -> a -> Result e a
Success ((DecodeError -> String) -> [DecodeError] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map DecodeError -> String
prettyDecodeError [DecodeError]
w) a
x

-- | Use the 'ToTable' instance to encode a value to a TOML string.
encode :: ToTable a => a -> TomlDoc
encode :: forall a. ToTable a => a -> TomlDoc
encode = Table' () -> TomlDoc
forall a. Table' a -> TomlDoc
prettyToml (Table' () -> TomlDoc) -> (a -> Table' ()) -> a -> TomlDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Table' ()
forall a. ToTable a => a -> Table' ()
toTable

-- | Human-readable representation of a 'DecodeError'
prettyDecodeError :: DecodeError -> String
prettyDecodeError :: DecodeError -> String
prettyDecodeError = \case
    ErrSyntax Located String
e -> Located String -> String
prettyLocated Located String
e
    ErrSemantics SemanticError Position
e -> SemanticError Position -> String
prettySemanticError SemanticError Position
e
    ErrSchema MatchMessage Position
e -> MatchMessage Position -> String
prettyMatchMessage MatchMessage Position
e

-- | Render a TOML decoding error as a human-readable string.
prettyMatchMessage :: MatchMessage Position -> String
prettyMatchMessage :: MatchMessage Position -> String
prettyMatchMessage (MatchMessage Maybe Position
loc [Scope]
scope String
msg) = String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path
    where
        prefix :: String
prefix =
            case Maybe Position
loc of
                Maybe Position
Nothing -> String
""
                Just Position
l -> Position -> String
prettyPosition Position
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": "
        path :: String
path =
            case [Scope]
scope of
                [] -> String
"<top-level>"
                ScopeKey Text
key : [Scope]
scope' -> Doc Any -> String -> String
forall a. Show a => a -> String -> String
shows (Text -> Doc Any
forall a. Text -> Doc a
prettySimpleKey Text
key) ((Scope -> String -> String) -> String -> [Scope] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Scope -> String -> String
f String
"" [Scope]
scope')
                ScopeIndex Int
i : [Scope]
scope' -> (Scope -> String -> String) -> String -> [Scope] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Scope -> String -> String
f String
"" (Int -> Scope
ScopeIndex Int
i Scope -> [Scope] -> [Scope]
forall a. a -> [a] -> [a]
: [Scope]
scope') -- should be impossible

        f :: Scope -> String -> String
f (ScopeIndex Int
i) = Char -> String -> String
showChar Char
'[' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Show a => a -> String -> String
shows Int
i (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
']'
        f (ScopeKey Text
key) = Char -> String -> String
showChar Char
'.' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String -> String
forall a. Show a => a -> String -> String
shows (Text -> Doc Any
forall a. Text -> Doc a
prettySimpleKey Text
key)

-- | Render a semantic TOML error in a human-readable string.
prettySemanticError :: SemanticError Position -> String
prettySemanticError :: SemanticError Position -> String
prettySemanticError (SemanticError Position
a Text
key SemanticErrorKind
kind) =
    String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s: key error: %s %s" (Position -> String
prettyPosition Position
a) (Doc Any -> String
forall a. Show a => a -> String
show (Text -> Doc Any
forall a. Text -> Doc a
prettySimpleKey Text
key))
    case SemanticErrorKind
kind of
        SemanticErrorKind
AlreadyAssigned -> String
"is already assigned" :: String
        SemanticErrorKind
ClosedTable     -> String
"is a closed table"
        SemanticErrorKind
ImplicitlyTable -> String
"is already implicitly defined to be a table"