{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- | This module enables debugging all 'ByteString' to 'Text' to 'String' conversions.
-- This is an internal module.
--
-- @since 0.5.67
module B9.Text
  ( Text,
    LazyText,
    ByteString,
    LazyByteString,
    Textual (..),
    writeTextFile,
    unsafeRenderToText,
    unsafeParseFromText,
    parseFromTextWithErrorMessage,
    encodeAsUtf8LazyByteString,
  )
where

import Control.Exception (displayException)
-- import qualified Data.ByteString               as Strict

-- import qualified Data.Text.Encoding.Error      as Text
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.Text as Text
import Data.Text (Text)
import qualified Data.Text.Encoding as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText
import GHC.Stack

-- | Lazy byte strings.
--
-- A type alias to 'Lazy.ByteString' that can be used everywhere such that
-- references don't need to be qualified with the complete module name everywere.
--
-- @since 0.5.67
type LazyByteString = LazyByteString.ByteString

-- | Lazy texts.
--
-- A type alias to 'LazyText.Text' that can be used everywhere such that
-- references don't need to be qualified with the complete module name everywere.
--
-- @since 0.5.67
type LazyText = LazyText.Text

-- | A class for values that can be converted to/from 'Text'.
--
-- @since 0.5.67
class Textual a where
  -- | Convert a 'String' to 'Text'
  -- If an error occured, return 'Left' with the error message.
  --
  -- @since 0.5.67
  renderToText :: HasCallStack => a -> Either String Text

  -- | Convert a 'Text' to 'String'
  --
  -- @since 0.5.67
  parseFromText :: HasCallStack => Text -> Either String a

instance Textual Text where
  renderToText :: Text -> Either String Text
renderToText = Text -> Either String Text
forall a b. b -> Either a b
Right
  parseFromText :: Text -> Either String Text
parseFromText = Text -> Either String Text
forall a b. b -> Either a b
Right

instance Textual String where
  renderToText :: String -> Either String Text
renderToText = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text)
-> (String -> Text) -> String -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
  parseFromText :: Text -> Either String String
parseFromText = String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String)
-> (Text -> String) -> Text -> Either String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

-- | Convert a 'ByteString' with UTF-8 encoded string to 'Text'
--
-- @since 0.5.67
instance Textual ByteString where
  renderToText :: ByteString -> Either String Text
renderToText ByteString
x = case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
x of
    Left UnicodeException
u ->
      String -> Either String Text
forall a b. a -> Either a b
Left
        ( String
"renderToText of the ByteString failed: "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnicodeException -> String
forall e. Exception e => e -> String
displayException UnicodeException
u
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
x
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nat:\n"
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack
        )
    Right Text
t -> Text -> Either String Text
forall a b. b -> Either a b
Right Text
t
  parseFromText :: Text -> Either String ByteString
parseFromText = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

-- | Convert a 'LazyByteString' with UTF-8 encoded string to 'Text'
--
-- @since 0.5.67
instance Textual LazyByteString where
  renderToText :: LazyByteString -> Either String Text
renderToText LazyByteString
x = case LazyByteString -> Either UnicodeException Text
LazyText.decodeUtf8' LazyByteString
x of
    Left UnicodeException
u ->
      String -> Either String Text
forall a b. a -> Either a b
Left
        ( String
"renderToText of the LazyByteString failed: "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnicodeException -> String
forall e. Exception e => e -> String
displayException UnicodeException
u
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ LazyByteString -> String
forall a. Show a => a -> String
show LazyByteString
x
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nat:\n"
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack
        )
    Right Text
t -> Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Text
LazyText.toStrict Text
t)
  parseFromText :: Text -> Either String LazyByteString
parseFromText = LazyByteString -> Either String LazyByteString
forall a b. b -> Either a b
Right (LazyByteString -> Either String LazyByteString)
-> (Text -> LazyByteString) -> Text -> Either String LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LazyByteString
LazyByteString.fromStrict (ByteString -> LazyByteString)
-> (Text -> ByteString) -> Text -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

-- | Render a 'Text' to a file.
--
-- @since 0.5.67
writeTextFile :: (HasCallStack, MonadIO m) => FilePath -> Text -> m ()
writeTextFile :: String -> Text -> m ()
writeTextFile String
f = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> IO ()
Text.writeFile String
f

-- | Render a 'Text' via 'renderToText' and throw a runtime exception when rendering fails.
--
-- @since 0.5.67
unsafeRenderToText :: (Textual a, HasCallStack) => a -> Text
unsafeRenderToText :: a -> Text
unsafeRenderToText = (String -> Text) -> (Text -> Text) -> Either String Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Text
forall a. HasCallStack => String -> a
error Text -> Text
forall a. a -> a
id (Either String Text -> Text)
-> (a -> Either String Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String Text
forall a. (Textual a, HasCallStack) => a -> Either String Text
renderToText

-- | Parse a 'Text' via 'parseFromText' and throw a runtime exception when parsing fails.
--
-- @since 0.5.67
unsafeParseFromText :: (Textual a, HasCallStack) => Text -> a
unsafeParseFromText :: Text -> a
unsafeParseFromText = (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> a
forall a. HasCallStack => String -> a
error a -> a
forall a. a -> a
id (Either String a -> a) -> (Text -> Either String a) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String a
forall a. (Textual a, HasCallStack) => Text -> Either String a
parseFromText

-- | Encode a 'String' as UTF-8 encoded into a 'LazyByteString'.
--
-- @since 0.5.67
encodeAsUtf8LazyByteString :: HasCallStack => String -> LazyByteString
encodeAsUtf8LazyByteString :: String -> LazyByteString
encodeAsUtf8LazyByteString =
  ByteString -> LazyByteString
LazyByteString.fromStrict (ByteString -> LazyByteString)
-> (String -> ByteString) -> String -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-- | Parse the given 'Text'. \
-- Return @Left errorMessage@ or @Right a@.
--
-- error message.
--
-- @since 0.5.67
parseFromTextWithErrorMessage ::
  (HasCallStack, Textual a) =>
  -- | An arbitrary string for error messages
  String ->
  Text ->
  Either String a
parseFromTextWithErrorMessage :: String -> Text -> Either String a
parseFromTextWithErrorMessage String
errorMessage Text
b = case Text -> Either String a
forall a. (Textual a, HasCallStack) => Text -> Either String a
parseFromText Text
b of
  Left String
e -> String -> Either String a
forall a b. a -> Either a b
Left ([String] -> String
unwords [String
errorMessage, String
e])
  Right a
a -> a -> Either String a
forall a b. b -> Either a b
Right a
a