{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Provides @ByteString <-> Text@ (UTF-8) conversions.
--
-- @since 0.1
module FileSystem.UTF8
  ( -- * Decoding UTF-8

    -- ** Total
    decodeUtf8,
    decodeUtf8Lenient,

    -- ** Partial
    decodeUtf8ThrowM,
    decodeUtf8Fail,
    unsafeDecodeUtf8,

    -- * Encoding UTF-8
    TEnc.encodeUtf8,

    -- * Normalization
    normalizeC,
    NormalizationMode (..),
    TNormalize.normalize,
    glyphLength,
  )
where

import Control.Category ((>>>))
import Control.Exception (Exception (displayException))
import Control.Monad.Catch (MonadThrow, throwM)
import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TEnc
import Data.Text.Encoding.Error (UnicodeException)
import Data.Text.Encoding.Error qualified as TEncError
import Data.Text.Normalize (NormalizationMode (NFC, NFD, NFKC, NFKD))
import Data.Text.Normalize qualified as TNormalize
import GHC.Stack (HasCallStack)

-- NOTE: -Wno-redundant-constraints is because the HasCallStack is redundant
-- on some of these functions when the exceptions library is too old.
-- Disabling the warning is easier than trying to get it right with cpp.

-- | Decodes a 'ByteString' to UTF-8.
--
-- @since 0.1
decodeUtf8 :: ByteString -> Either UnicodeException Text
decodeUtf8 :: ByteString -> Either UnicodeException Text
decodeUtf8 = ByteString -> Either UnicodeException Text
TEnc.decodeUtf8'

-- | Leniently decodes a 'ByteString' to UTF-8.
--
-- @since 0.1
decodeUtf8Lenient :: ByteString -> Text
decodeUtf8Lenient :: ByteString -> Text
decodeUtf8Lenient = OnDecodeError -> ByteString -> Text
TEnc.decodeUtf8With OnDecodeError
TEncError.lenientDecode

-- | Decodes a 'ByteString' to UTF-8. Can throw 'UnicodeException'.
--
-- @since 0.1
decodeUtf8ThrowM ::
  (HasCallStack, MonadThrow m) =>
  ByteString ->
  m Text
decodeUtf8ThrowM :: forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
ByteString -> m Text
decodeUtf8ThrowM =
  ByteString -> Either UnicodeException Text
decodeUtf8 (ByteString -> Either UnicodeException Text)
-> (Either UnicodeException Text -> m Text) -> ByteString -> m Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    Right Text
txt -> Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
txt
    Left UnicodeException
ex -> UnicodeException -> m Text
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM UnicodeException
ex
{-# INLINEABLE decodeUtf8ThrowM #-}

-- | Decodes a 'ByteString' to UTF-8.
--
-- @since 0.1
decodeUtf8Fail ::
  (HasCallStack, MonadFail m) =>
  ByteString ->
  m Text
decodeUtf8Fail :: forall (m :: * -> *).
(HasCallStack, MonadFail m) =>
ByteString -> m Text
decodeUtf8Fail =
  ByteString -> Either UnicodeException Text
decodeUtf8 (ByteString -> Either UnicodeException Text)
-> (Either UnicodeException Text -> m Text) -> ByteString -> m Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    Right Text
txt -> Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
txt
    Left UnicodeException
ex -> String -> m Text
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Text) -> String -> m Text
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall e. Exception e => e -> String
displayException UnicodeException
ex
{-# INLINEABLE decodeUtf8Fail #-}

-- | Decodes a 'ByteString' to UTF-8.
--
-- __WARNING: Partial__
--
-- @since 0.1
unsafeDecodeUtf8 ::
  (HasCallStack) =>
  ByteString ->
  Text
unsafeDecodeUtf8 :: HasCallStack => ByteString -> Text
unsafeDecodeUtf8 =
  ByteString -> Either UnicodeException Text
decodeUtf8 (ByteString -> Either UnicodeException Text)
-> (Either UnicodeException Text -> Text) -> ByteString -> Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    Right Text
txt -> Text
txt
    Left UnicodeException
ex -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall e. Exception e => e -> String
displayException UnicodeException
ex

-- | Returns the number of "visual characters" i.e. glyphs.
--
-- @since 0.1
glyphLength :: Text -> Int
glyphLength :: Text -> Int
glyphLength = Text -> Int
T.length (Text -> Int) -> (Text -> Text) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
normalizeC

-- | Normalizes text with canonical decomposition then canonical
-- composition.
--
-- @since 0.1
normalizeC :: Text -> Text
normalizeC :: Text -> Text
normalizeC = NormalizationMode -> Text -> Text
TNormalize.normalize NormalizationMode
NFC