{- |
Module:      PFile.Aeson
Copyright:   (c) 2024 Illia Shkroba
License:     BSD3
Maintainer:  Illia Shkroba <is@pjwstk.edu.pl>
Stability:   unstable
Portability: non-portable (Non-Unix systems are not supported)

Helper functions for 'Data.Aeson'.
-}

{-# LANGUAGE OverloadedStrings #-}

module PFile.Aeson
  ( encodePretty
  ) where

import           Data.Aeson               (ToJSON)
import qualified Data.Aeson.Encode.Pretty as Aeson
import           Protolude

-- | Wrapper over 'Data.Aeson.Encode.Pretty.encodePretty' that returns 'Text'
-- instead of 'ByteString'.
--
-- @since 0.1.0.0
encodePretty :: ToJSON a => a -> Text
encodePretty :: forall a. ToJSON a => a -> Text
encodePretty
  = (UnicodeException -> Text)
-> (Text -> Text) -> Either UnicodeException Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\UnicodeException
error -> Text
"<Utf8 decoding error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UnicodeException -> Text
forall a b. (Show a, StringConv String b) => a -> b
show UnicodeException
error Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">") Text -> Text
forall a. a -> a
identity
  (Either UnicodeException Text -> Text)
-> (a -> Either UnicodeException Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (a -> ByteString) -> a -> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a b. ConvertText a b => a -> b
toS (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty