{-# LANGUAGE FlexibleInstances #-}
-- NOTE: FlexibleInstances is needed to support `String` instance :-(

module Symbolize.Textual (Textual (..)) where

import Data.ByteString (ByteString)
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as ShortByteString
import Data.Function ((&))
import Data.Text (Text)
import qualified Data.Text.Encoding as Text.Encoding
import qualified Data.Text.Encoding.Error as Text.Encoding.Error
import qualified Data.Text.Lazy as LText
import Data.Text.Short (ShortText)
import qualified Data.Text.Short as ShortText
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as Builder

-- | Implemented by any String-like types.
-- The symbol table uses `ShortText` for its internal storage, so any type which can be converted to it
-- can be turned to/from a `Symbolize.Symbol`.
--
-- Instance should handle potential invalid UTF-8 by using the Unicode replacement character,
-- c.f. `Data.Text.Encoding.Error.lenientDecode`.
class Textual a where
  toShortText :: a -> ShortText
  fromShortText :: ShortText -> a

-- |
-- - O(0) conversion (a no-op)
instance Textual ShortText where
  toShortText :: ShortText -> ShortText
toShortText = forall a. a -> a
id
  {-# INLINE toShortText #-}
  fromShortText :: ShortText -> ShortText
fromShortText = forall a. a -> a
id
  {-# INLINE fromShortText #-}

-- |
-- - O(1) conversion
instance Textual Text where
  toShortText :: Text -> ShortText
toShortText = Text -> ShortText
ShortText.fromText
  {-# INLINE toShortText #-}
  fromShortText :: ShortText -> Text
fromShortText = ShortText -> Text
ShortText.toText
  {-# INLINE fromShortText #-}

-- |
-- - O(n) conversion
instance Textual String where
  toShortText :: String -> ShortText
toShortText = String -> ShortText
ShortText.fromString
  {-# INLINE toShortText #-}
  fromShortText :: ShortText -> String
fromShortText = ShortText -> String
ShortText.toString
  {-# INLINE fromShortText #-}

-- |
-- - O(1) conversion
instance Textual LText.Text where
  toShortText :: Text -> ShortText
toShortText = Text -> ShortText
ShortText.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LText.toStrict
  {-# INLINE toShortText #-}
  fromShortText :: ShortText -> Text
fromShortText = Text -> Text
LText.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
ShortText.toText
  {-# INLINE fromShortText #-}

-- | 
-- - toShortText: O(n). Evaluates the entire builder.
-- - fromShortText: O(1)
instance Textual Builder where
  toShortText :: Builder -> ShortText
toShortText = Text -> ShortText
ShortText.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LText.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText
  {-# INLINE toShortText #-}
  fromShortText :: ShortText -> Builder
fromShortText = Text -> Builder
Builder.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
ShortText.toText
  {-# INLINE fromShortText #-}

-- |
-- - toShortText: O(n). Turns invalid UTF-8 into the Unicode replacement character.
-- - fromShortText: O(0) no-op
instance Textual ShortByteString where
  toShortText :: ShortByteString -> ShortText
toShortText ShortByteString
byteString =
    ShortByteString
byteString
      forall a b. a -> (a -> b) -> b
& ShortByteString -> ByteString
ShortByteString.fromShort
      forall a b. a -> (a -> b) -> b
& OnDecodeError -> ByteString -> Text
Text.Encoding.decodeUtf8With OnDecodeError
Text.Encoding.Error.lenientDecode
      forall a b. a -> (a -> b) -> b
& Text -> ShortText
ShortText.fromText
  {-# INLINE toShortText #-}

  fromShortText :: ShortText -> ShortByteString
fromShortText = ShortText -> ShortByteString
ShortText.toShortByteString
  {-# INLINE fromShortText #-}

-- |
-- - toShortText: O(n). Turns invalid UTF-8 into the Unicode replacement character.
-- - fromShortText: O(n).
instance Textual ByteString where
  toShortText :: ByteString -> ShortText
toShortText ByteString
byteString =
    ByteString
byteString
      forall a b. a -> (a -> b) -> b
& OnDecodeError -> ByteString -> Text
Text.Encoding.decodeUtf8With OnDecodeError
Text.Encoding.Error.lenientDecode
      forall a b. a -> (a -> b) -> b
& Text -> ShortText
ShortText.fromText
  {-# INLINE toShortText #-}

  fromShortText :: ShortText -> ByteString
fromShortText = ShortText -> ByteString
ShortText.toByteString
  {-# INLINE fromShortText #-}