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

Contains TOML-specific custom combinators for converting between TOML and
special user data types.

See examples below of the situations you may need the following combinators.

@since 1.3.0.0
-}

module Toml.Codec.Combinator.Custom
    ( -- * 'Text' combinators
      textBy
    , read
    , enumBounded
    , hardcoded

      -- * Validation
    , validate
    , validateIf
    ) where

import Prelude hiding (read)

import Control.Category ((>>>))
import Data.Text (Text)

import Toml.Codec.BiMap (TomlBiMap)
import Toml.Codec.BiMap.Conversion (_EnumBounded, _Read, _TextBy, _Validate, _Hardcoded)
import Toml.Codec.Combinator.Common (match)
import Toml.Codec.Types (TomlCodec)
import Toml.Type.AnyValue (AnyValue)
import Toml.Type.Key (Key)
import Toml.Type.Printer (prettyKey)


{- | Codec for text values with custom error messages for parsing.

__Example:__

We have the following type that represents the image format:

@
__data__ Format
    = Jpeg
    | Png
    | Gif
    __deriving__ ('Show', 'Read', 'Enum')
@

But we want to be able to decode and encode this data type through the custom
text representation, that can be formilised in the following functions:

@
showFormat :: Format -> 'Text'
showFormat = \case
    Jpeg -> ".jpeg"
    Png  -> ".png"
    Gif  -> ".gif"

parseFormat :: 'Text' -> 'Either' 'Text' Format
parseFormat = __\case__
    ".jpeg" -> 'Right' Jpeg
    ".png"  -> 'Right' Png
    ".gif"  -> 'Right' Gif
    other   -> 'Left' $ "Unsupported format: " <> other
@

To write the codec for @Format@ data type using the above rules we can use
'textBy' combinator:

@
formatCodec :: 'Key' -> 'TomlCodec' Format
formatCodec = 'textBy' showFormat parseFormat
@

And now with the @formatCodec "foo"@ we can have the following line in our
@TOML@ perfectly encoded:

@
foo = ".gif"
@

But the @foo = "jif"@ will lead to the following error:

@
tomland decode error:  Unsupported format: jif
@

@since 1.0.0
-}
textBy :: (a -> Text) -> (Text -> Either Text a) -> Key -> TomlCodec a
textBy :: forall a.
(a -> Text) -> (Text -> Either Text a) -> Key -> TomlCodec a
textBy a -> Text
to Text -> Either Text a
from = TomlBiMap a AnyValue -> Key -> TomlCodec a
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match ((a -> Text) -> (Text -> Either Text a) -> TomlBiMap a AnyValue
forall a.
(a -> Text) -> (Text -> Either Text a) -> TomlBiMap a AnyValue
_TextBy a -> Text
to Text -> Either Text a
from)
{-# INLINE textBy #-}


{- | Codec for values with a 'Read' and 'Show' instance.

__Example:__

We have the following type that represents the image format:

@
__data__ Format
    = Jpeg
    | Png
    | Gif
    deriving (Show, Read, Enum)
@

And we want to be able to decode and encode this data type through the 'Show'
and 'Read' instances.

To write the codec for @Format@ data type using the existing instances we can
use 'read' combinator. And now with the @Toml.'read' "foo"@ we can have the
following line in our @TOML@ perfectly encoded:

@
foo = "Gif"
@

But the @foo = ".gif"@ will lead to the following error:

@
tomland decode error:  Prelude.read: no parse
@

@since 0.5.0
-}
read :: (Show a, Read a) => Key -> TomlCodec a
read :: forall a. (Show a, Read a) => Key -> TomlCodec a
read = TomlBiMap a AnyValue -> Key -> TomlCodec a
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap a AnyValue
forall a. (Show a, Read a) => TomlBiMap a AnyValue
_Read
{-# INLINE read #-}

{- | Codec for general nullary sum data types with a 'Bounded', 'Enum', and
'Show' instance. This codec is similar to 'read' but provides much better error
messages than 'read' for nullary sum types.

E.g. for the same @Format@ example from 'read' function, but with the
@Toml.'enumBounded' "foo"@ codec the error for @foo = \"Jif\"@ in the @TOML@ file
will look like this:

@
tomland decode error:  Value is 'Jif' but expected one of: Jpeg, Png, Gif
@

@since 1.1.0.0
-}
enumBounded :: (Bounded a, Enum a, Show a) => Key -> TomlCodec a
enumBounded :: forall a. (Bounded a, Enum a, Show a) => Key -> TomlCodec a
enumBounded = TomlBiMap a AnyValue -> Key -> TomlCodec a
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap a AnyValue
forall a. (Show a, Enum a, Bounded a) => TomlBiMap a AnyValue
_EnumBounded
{-# INLINE enumBounded #-}

{- | Codec for hardcoded provided values and its 'BiMap'.

If you want to decode a single key-value pair where only one value is allowed.
Like in the example below:

@
scope = "all"
@

To decode that you could use the following function:

@
Toml.hardcoded "all" Toml._Text "scope"
@

in case if the value in @TOML@ is not the same as hardcoded, you will get the following error:

@
tomland decode error:  BiMap error in key 'scope' : Value '"foo"' doesn't align with the hardcoded value '"all"'
@

@since 1.3.2.0
-}
hardcoded :: (Show a, Eq a) => a -> TomlBiMap a AnyValue -> Key -> TomlCodec a
hardcoded :: forall a.
(Show a, Eq a) =>
a -> TomlBiMap a AnyValue -> Key -> TomlCodec a
hardcoded a
a TomlBiMap a AnyValue
aBm = TomlBiMap a AnyValue -> Key -> TomlCodec a
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match (a -> TomlBiMap a a
forall a. (Show a, Eq a) => a -> TomlBiMap a a
_Hardcoded a
a TomlBiMap a a -> TomlBiMap a AnyValue -> TomlBiMap a AnyValue
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TomlBiMap a AnyValue
aBm)

{- | Codec that checks the 'BiMap' on the given predicate.
The predicate function returns the value, if the validation is successful, or
the 'Text' of the error that should be returned in case of validation failure.

__Example:__

Let's imagine that we want to have the list in @TOML@ that could only
have even 'Int's inside. In this case, you can write the following codec:

@
allEven :: ['Int'] -> 'Either' 'Text' ['Int']
allEven xs =
    if all even xs
    then 'Right' xs
    else 'Left' "This is wrong, I asked you for even only :("

allEvenCodec :: 'TomlCodec' ['Int']
allEvenCodec = Toml.'validate' allEven (Toml._Array Toml._Int) \"myEvenList\"
@

Then in your @TOML@ file you can have:

@
myEvenList = [2, 4, 6]
@

But the following one will lead to the error:

@
myEvenList = [1, 2, 3]
@

@
tomland decode error:  This is wrong, I asked you for even only :(
@

@since 1.3.0.0
-}
validate :: (a -> Either Text a) -> TomlBiMap a AnyValue -> Key -> TomlCodec a
validate :: forall a.
(a -> Either Text a) -> TomlBiMap a AnyValue -> Key -> TomlCodec a
validate a -> Either Text a
p TomlBiMap a AnyValue
biMap = TomlBiMap a AnyValue -> Key -> TomlCodec a
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match ((a -> Either Text a)
-> TomlBiMap a AnyValue -> TomlBiMap a AnyValue
forall a.
(a -> Either Text a)
-> TomlBiMap a AnyValue -> TomlBiMap a AnyValue
_Validate a -> Either Text a
p TomlBiMap a AnyValue
biMap)
{-# INLINE validate #-}

{- | Similar to 'validate' but takes the predicate that returnes 'Bool'.
The error in case of the validation failure looks like this:

@
Value does not pass the validation for key: KEY_NAME
@

__Example:__

Let's imagine that we want to have the 'Text' field in @TOML@ that could only
have 3 chars in it. In this case, you can write the following codec:

@
my3charTextCodec :: TomlCodec Text
my3CharTextCodec = Toml.'validateIf' ((==) 3 . Text.length) Toml._Text "myKeyName"
@

The in your @TOML@ file you can have:

@
myKeyName = "abc"
@

But the following one will lead to the error:

@
myKeyName = "I have more than enough"
@

@
tomland decode error:  Value does not pass the validation for key: myKeyName
@

@since 1.3.0.0
-}
validateIf :: forall a . (a -> Bool) -> TomlBiMap a AnyValue -> Key -> TomlCodec a
validateIf :: forall a. (a -> Bool) -> TomlBiMap a AnyValue -> Key -> TomlCodec a
validateIf a -> Bool
p TomlBiMap a AnyValue
biMap Key
k = (a -> Either Text a) -> TomlBiMap a AnyValue -> Key -> TomlCodec a
forall a.
(a -> Either Text a) -> TomlBiMap a AnyValue -> Key -> TomlCodec a
validate a -> Either Text a
validateEither TomlBiMap a AnyValue
biMap Key
k
  where
    validateEither :: a -> Either Text a
    validateEither :: a -> Either Text a
validateEither a
a =
        if a -> Bool
p a
a
        then a -> Either Text a
forall a b. b -> Either a b
Right a
a
        else Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text
"Value does not pass the validation for key: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
prettyKey Key
k