{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DerivingStrategies, DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}

module DSV.UTF8
  ( EncodeUtf8 (..)
  , DecodeUtf8 (..)
  , InvalidUtf8 (..)
  , utf8View, utf8TextView, encodeTextUtf8, utf8TextMaybe
  ) where

import DSV.ByteString
import DSV.IO
import DSV.Prelude
import DSV.Validation
import DSV.ViewType

-- text
import Data.Text (Text)
import qualified Data.Text
import qualified Data.Text.Encoding


--- Encode ---

class EncodeUtf8 a
  where
    encodeUtf8 :: a -> ByteString

instance EncodeUtf8 Text
  where
    encodeUtf8 :: Text -> ByteString
encodeUtf8 =
        Text -> ByteString
Data.Text.Encoding.encodeUtf8

instance EncodeUtf8 [Char]
  where
    encodeUtf8 :: [Char] -> ByteString
encodeUtf8 =
        Text -> ByteString
Data.Text.Encoding.encodeUtf8 (Text -> ByteString) -> ([Char] -> Text) -> [Char] -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
        [Char] -> Text
Data.Text.pack


--- Decode ---

class DecodeUtf8 a
  where
    decodeUtf8Maybe :: ByteString -> Maybe a

instance DecodeUtf8 Text
  where
    decodeUtf8Maybe :: ByteString -> Maybe Text
decodeUtf8Maybe =
        Either UnicodeException Text -> Maybe Text
forall a b. Either a b -> Maybe b
rightMaybe (Either UnicodeException Text -> Maybe Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Maybe Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
        ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8'

instance DecodeUtf8 [Char]
  where
    decodeUtf8Maybe :: ByteString -> Maybe [Char]
decodeUtf8Maybe =
        (Text -> [Char]) -> Maybe Text -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Char]
Data.Text.unpack (Maybe Text -> Maybe [Char])
-> (ByteString -> Maybe Text) -> ByteString -> Maybe [Char]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
        Either UnicodeException Text -> Maybe Text
forall a b. Either a b -> Maybe b
rightMaybe (Either UnicodeException Text -> Maybe Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Maybe Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
        ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8'


--- Views ---

data InvalidUtf8 = InvalidUtf8
  deriving stock (InvalidUtf8 -> InvalidUtf8 -> Bool
(InvalidUtf8 -> InvalidUtf8 -> Bool)
-> (InvalidUtf8 -> InvalidUtf8 -> Bool) -> Eq InvalidUtf8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidUtf8 -> InvalidUtf8 -> Bool
$c/= :: InvalidUtf8 -> InvalidUtf8 -> Bool
== :: InvalidUtf8 -> InvalidUtf8 -> Bool
$c== :: InvalidUtf8 -> InvalidUtf8 -> Bool
Eq, Int -> InvalidUtf8 -> ShowS
[InvalidUtf8] -> ShowS
InvalidUtf8 -> [Char]
(Int -> InvalidUtf8 -> ShowS)
-> (InvalidUtf8 -> [Char])
-> ([InvalidUtf8] -> ShowS)
-> Show InvalidUtf8
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [InvalidUtf8] -> ShowS
$cshowList :: [InvalidUtf8] -> ShowS
show :: InvalidUtf8 -> [Char]
$cshow :: InvalidUtf8 -> [Char]
showsPrec :: Int -> InvalidUtf8 -> ShowS
$cshowsPrec :: Int -> InvalidUtf8 -> ShowS
Show)
  deriving anyclass Show InvalidUtf8
Typeable InvalidUtf8
Typeable InvalidUtf8
-> Show InvalidUtf8
-> (InvalidUtf8 -> SomeException)
-> (SomeException -> Maybe InvalidUtf8)
-> (InvalidUtf8 -> [Char])
-> Exception InvalidUtf8
SomeException -> Maybe InvalidUtf8
InvalidUtf8 -> [Char]
InvalidUtf8 -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> [Char])
-> Exception e
displayException :: InvalidUtf8 -> [Char]
$cdisplayException :: InvalidUtf8 -> [Char]
fromException :: SomeException -> Maybe InvalidUtf8
$cfromException :: SomeException -> Maybe InvalidUtf8
toException :: InvalidUtf8 -> SomeException
$ctoException :: InvalidUtf8 -> SomeException
$cp2Exception :: Show InvalidUtf8
$cp1Exception :: Typeable InvalidUtf8
Exception

utf8View :: DecodeUtf8 txt => View InvalidUtf8 ByteString txt
utf8View :: View InvalidUtf8 ByteString txt
utf8View =
  (ByteString -> Validation InvalidUtf8 txt)
-> View InvalidUtf8 ByteString txt
forall e a b. (a -> Validation e b) -> View e a b
View ((ByteString -> Validation InvalidUtf8 txt)
 -> View InvalidUtf8 ByteString txt)
-> (ByteString -> Validation InvalidUtf8 txt)
-> View InvalidUtf8 ByteString txt
forall a b. (a -> b) -> a -> b
$ \ByteString
x ->
    case ByteString -> Maybe txt
forall a. DecodeUtf8 a => ByteString -> Maybe a
decodeUtf8Maybe ByteString
x of
        Maybe txt
Nothing -> InvalidUtf8 -> Validation InvalidUtf8 txt
forall err a. err -> Validation err a
Failure InvalidUtf8
InvalidUtf8
        Just txt
y -> txt -> Validation InvalidUtf8 txt
forall err a. a -> Validation err a
Success txt
y

-- | Decode a byte string as UTF-8 text, failing with 'Nothing' if the decoding fails.
utf8TextMaybe :: ByteString -> Maybe Text
utf8TextMaybe :: ByteString -> Maybe Text
utf8TextMaybe = DecodeUtf8 Text => ByteString -> Maybe Text
forall a. DecodeUtf8 a => ByteString -> Maybe a
decodeUtf8Maybe @Text

utf8TextView :: View InvalidUtf8 ByteString Text
utf8TextView :: View InvalidUtf8 ByteString Text
utf8TextView = DecodeUtf8 Text => View InvalidUtf8 ByteString Text
forall txt. DecodeUtf8 txt => View InvalidUtf8 ByteString txt
utf8View @Text

encodeTextUtf8 :: Text -> ByteString
encodeTextUtf8 :: Text -> ByteString
encodeTextUtf8 = EncodeUtf8 Text => Text -> ByteString
forall a. EncodeUtf8 a => a -> ByteString
encodeUtf8 @Text

rightMaybe :: Either a b -> Maybe b
rightMaybe :: Either a b -> Maybe b
rightMaybe = (a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> a -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just