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

Conversion from textual representation of @TOML@ values to the Haskell data
types by the given 'TomlCodec'.

This module includes coding functions like 'decode' and 'encode'.
-}

module Toml.Codec.Code
       ( -- * Decode
         decode
       , decodeExact
       , decodeValidation
       , decodeFileEither
       , decodeFile
       , decodeFileExact
         -- * Encode
       , encode
       , encodeToFile
         -- * Run
       , runTomlCodec
       , execTomlCodec
       ) where

import Control.Exception (throwIO)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Text (Text)
import Validation (Validation (..), validationToEither)

import Toml.Codec.Error (LoadTomlException (..), TomlDecodeError (..), prettyTomlDecodeErrors)
import Toml.Codec.Types (Codec (..), TomlCodec, TomlState (..))
import Toml.Parser (parse)
import Toml.Type (TOML (..), tomlDiff)
import Toml.Type.Printer (pretty)

import qualified Data.Text.IO as TIO


{- | Convert textual representation of @TOML@ into user data type by the
provided codec.

@since 1.3.0.0
-}
decodeValidation :: TomlCodec a -> Text -> Validation [TomlDecodeError] a
decodeValidation :: forall a. TomlCodec a -> Text -> Validation [TomlDecodeError] a
decodeValidation TomlCodec a
codec Text
text = case Text -> Either TomlParseError TOML
parse Text
text of
    Left TomlParseError
err   -> [TomlDecodeError] -> Validation [TomlDecodeError] a
forall e a. e -> Validation e a
Failure [TomlParseError -> TomlDecodeError
ParseError TomlParseError
err]
    Right TOML
toml -> TomlCodec a -> TOML -> Validation [TomlDecodeError] a
forall a. TomlCodec a -> TOML -> Validation [TomlDecodeError] a
runTomlCodec TomlCodec a
codec TOML
toml

{- | Convert textual representation of @TOML@ into user data type by the
provided codec.

@since 0.0.0
-}
decode :: TomlCodec a -> Text -> Either [TomlDecodeError] a
decode :: forall a. TomlCodec a -> Text -> Either [TomlDecodeError] a
decode TomlCodec a
codec = Validation [TomlDecodeError] a -> Either [TomlDecodeError] a
forall e a. Validation e a -> Either e a
validationToEither (Validation [TomlDecodeError] a -> Either [TomlDecodeError] a)
-> (Text -> Validation [TomlDecodeError] a)
-> Text
-> Either [TomlDecodeError] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec a -> Text -> Validation [TomlDecodeError] a
forall a. TomlCodec a -> Text -> Validation [TomlDecodeError] a
decodeValidation TomlCodec a
codec

{- | Convert textual representation of @TOML@ into user data type by the
provided codec.

Unlike 'decode', this function returns 'NotExactDecode' error in case if given
@TOML@ has redundant fields and other elements.

@since 1.3.2.0
-}
decodeExact :: TomlCodec a -> Text -> Either [TomlDecodeError] a
decodeExact :: forall a. TomlCodec a -> Text -> Either [TomlDecodeError] a
decodeExact TomlCodec a
codec Text
text = case Text -> Either TomlParseError TOML
parse Text
text of
    Left TomlParseError
err -> [TomlDecodeError] -> Either [TomlDecodeError] a
forall a b. a -> Either a b
Left [TomlParseError -> TomlDecodeError
ParseError TomlParseError
err]
    Right TOML
toml -> case TomlCodec a -> TOML -> Validation [TomlDecodeError] a
forall a. TomlCodec a -> TOML -> Validation [TomlDecodeError] a
runTomlCodec TomlCodec a
codec TOML
toml of
        Failure [TomlDecodeError]
errs -> [TomlDecodeError] -> Either [TomlDecodeError] a
forall a b. a -> Either a b
Left [TomlDecodeError]
errs
        Success a
a ->
            let tomlExpected :: TOML
tomlExpected = TomlCodec a -> a -> TOML
forall a. TomlCodec a -> a -> TOML
execTomlCodec TomlCodec a
codec a
a
                aDiff :: TOML
aDiff = TOML -> TOML -> TOML
tomlDiff TOML
toml TOML
tomlExpected in
            if TOML
aDiff TOML -> TOML -> Bool
forall a. Eq a => a -> a -> Bool
== TOML
forall a. Monoid a => a
mempty
            then a -> Either [TomlDecodeError] a
forall a b. b -> Either a b
Right a
a
            else [TomlDecodeError] -> Either [TomlDecodeError] a
forall a b. a -> Either a b
Left [TOML -> TomlDecodeError
NotExactDecode TOML
aDiff]

{- | Similar to 'decodeValidation', but takes a path to a file with textual @TOML@
values from which it decodes them with the provided codec.

@since 1.3.0.0
-}
decodeFileValidation
    :: forall a m . (MonadIO m)
    => TomlCodec a
    -> FilePath
    -> m (Validation [TomlDecodeError] a)
decodeFileValidation :: forall a (m :: * -> *).
MonadIO m =>
TomlCodec a -> FilePath -> m (Validation [TomlDecodeError] a)
decodeFileValidation TomlCodec a
codec = (Text -> Validation [TomlDecodeError] a)
-> m Text -> m (Validation [TomlDecodeError] a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TomlCodec a -> Text -> Validation [TomlDecodeError] a
forall a. TomlCodec a -> Text -> Validation [TomlDecodeError] a
decodeValidation TomlCodec a
codec) (m Text -> m (Validation [TomlDecodeError] a))
-> (FilePath -> m Text)
-> FilePath
-> m (Validation [TomlDecodeError] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> (FilePath -> IO Text) -> FilePath -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Text
TIO.readFile

{- | Similar to 'decode', but takes a path to a file with textual @TOML@
values from which it decodes them with the provided codec.

@since 1.3.0.0
-}
decodeFileEither
    :: forall a m . (MonadIO m)
    => TomlCodec a
    -> FilePath
    -> m (Either [TomlDecodeError] a)
decodeFileEither :: forall a (m :: * -> *).
MonadIO m =>
TomlCodec a -> FilePath -> m (Either [TomlDecodeError] a)
decodeFileEither TomlCodec a
codec = (Validation [TomlDecodeError] a -> Either [TomlDecodeError] a)
-> m (Validation [TomlDecodeError] a)
-> m (Either [TomlDecodeError] a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Validation [TomlDecodeError] a -> Either [TomlDecodeError] a
forall e a. Validation e a -> Either e a
validationToEither (m (Validation [TomlDecodeError] a)
 -> m (Either [TomlDecodeError] a))
-> (FilePath -> m (Validation [TomlDecodeError] a))
-> FilePath
-> m (Either [TomlDecodeError] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec a -> FilePath -> m (Validation [TomlDecodeError] a)
forall a (m :: * -> *).
MonadIO m =>
TomlCodec a -> FilePath -> m (Validation [TomlDecodeError] a)
decodeFileValidation TomlCodec a
codec

{- | Similar to 'decodeExact', but takes a path to a file with textual @TOML@
values from which it decodes them with the provided codec.

@since 1.3.2.0
-}
decodeFileExact
    :: forall a m . (MonadIO m)
    => TomlCodec a
    -> FilePath
    -> m (Either [TomlDecodeError] a)
decodeFileExact :: forall a (m :: * -> *).
MonadIO m =>
TomlCodec a -> FilePath -> m (Either [TomlDecodeError] a)
decodeFileExact TomlCodec a
codec = (Text -> Either [TomlDecodeError] a)
-> m Text -> m (Either [TomlDecodeError] a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TomlCodec a -> Text -> Either [TomlDecodeError] a
forall a. TomlCodec a -> Text -> Either [TomlDecodeError] a
decodeExact TomlCodec a
codec) (m Text -> m (Either [TomlDecodeError] a))
-> (FilePath -> m Text)
-> FilePath
-> m (Either [TomlDecodeError] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> (FilePath -> IO Text) -> FilePath -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Text
TIO.readFile

{- | Similar to 'decodeFileEither', throws 'LoadTomlException' in case of parse
errors ('TomlDecodeError').

@since 0.3.1
-}
decodeFile :: forall a m . (MonadIO m) => TomlCodec a -> FilePath -> m a
decodeFile :: forall a (m :: * -> *). MonadIO m => TomlCodec a -> FilePath -> m a
decodeFile TomlCodec a
codec FilePath
filePath = TomlCodec a -> FilePath -> m (Either [TomlDecodeError] a)
forall a (m :: * -> *).
MonadIO m =>
TomlCodec a -> FilePath -> m (Either [TomlDecodeError] a)
decodeFileEither TomlCodec a
codec FilePath
filePath m (Either [TomlDecodeError] a)
-> (Either [TomlDecodeError] a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either [TomlDecodeError] a -> m a
errorWhenLeft
  where
    errorWhenLeft :: Either [TomlDecodeError] a -> m a
    errorWhenLeft :: Either [TomlDecodeError] a -> m a
errorWhenLeft (Left [TomlDecodeError]
errs) =
        IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ LoadTomlException -> IO a
forall e a. Exception e => e -> IO a
throwIO
        (LoadTomlException -> IO a) -> LoadTomlException -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> LoadTomlException
LoadTomlException FilePath
filePath
        (Text -> LoadTomlException) -> Text -> LoadTomlException
forall a b. (a -> b) -> a -> b
$ [TomlDecodeError] -> Text
prettyTomlDecodeErrors [TomlDecodeError]
errs
    errorWhenLeft (Right a
pc) = a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
pc

{- | Convert data type to the textual representation of @TOML@ values.

@since 0.0.0
-}
encode :: TomlCodec a -> a -> Text
encode :: forall a. TomlCodec a -> a -> Text
encode TomlCodec a
codec a
obj = TOML -> Text
pretty (TOML -> Text) -> TOML -> Text
forall a b. (a -> b) -> a -> b
$ TomlCodec a -> a -> TOML
forall a. TomlCodec a -> a -> TOML
execTomlCodec TomlCodec a
codec a
obj

{- | Convert data type to the textual representation of @TOML@ values.
and write it info the given file.

@since 1.3.0.0
-}
encodeToFile :: forall a m . (MonadIO m) => TomlCodec a -> FilePath -> a -> m Text
encodeToFile :: forall a (m :: * -> *).
MonadIO m =>
TomlCodec a -> FilePath -> a -> m Text
encodeToFile TomlCodec a
codec FilePath
filePath a
obj = Text
content Text -> m () -> m Text
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> Text -> IO ()
TIO.writeFile FilePath
filePath Text
content)
  where
    content :: Text
    content :: Text
content = TomlCodec a -> a -> Text
forall a. TomlCodec a -> a -> Text
encode TomlCodec a
codec a
obj

-- | Convert toml into user data type.
runTomlCodec :: TomlCodec a -> TOML -> Validation [TomlDecodeError] a
runTomlCodec :: forall a. TomlCodec a -> TOML -> Validation [TomlDecodeError] a
runTomlCodec = Codec a a -> TomlEnv a
forall i o. Codec i o -> TomlEnv o
codecRead

-- | Runs 'codecWrite' of 'TomlCodec' and returns intermediate TOML AST.
execTomlCodec :: TomlCodec a -> a -> TOML
execTomlCodec :: forall a. TomlCodec a -> a -> TOML
execTomlCodec TomlCodec a
codec a
obj = (Maybe a, TOML) -> TOML
forall a b. (a, b) -> b
snd ((Maybe a, TOML) -> TOML) -> (Maybe a, TOML) -> TOML
forall a b. (a -> b) -> a -> b
$ TomlState a -> TOML -> (Maybe a, TOML)
forall a. TomlState a -> TOML -> (Maybe a, TOML)
unTomlState (TomlCodec a -> a -> TomlState a
forall i o. Codec i o -> i -> TomlState o
codecWrite TomlCodec a
codec a
obj) TOML
forall a. Monoid a => a
mempty