module ASCII.Superset.Text where

import ASCII.CaseRefinement (ASCII'case)
import ASCII.CaseRefinement qualified as CaseRefinement
import ASCII.Refinement (ASCII)
import ASCII.Refinement qualified as Refinement
import Data.ByteString qualified as Strict (ByteString)
import Data.ByteString.Lazy qualified as Lazy (ByteString)
import Data.Char qualified as Unicode
import Data.Function (id, (.))
import Data.Kind (Type)
import Data.Text qualified as Strict (Text)
import Data.Text qualified as Text.Strict
import Data.Text.Encoding qualified as Text.Strict
import Data.Text.Lazy qualified as Lazy (Text)
import Data.Text.Lazy qualified as Text.Lazy
import Data.Text.Lazy.Encoding qualified as Text.Lazy

class ToText (a :: Type) where
  toStrictText :: a -> Strict.Text
  toStrictText = Text -> Text
Text.Lazy.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToText a => a -> Text
toLazyText

  toLazyText :: a -> Lazy.Text
  toLazyText = Text -> Text
Text.Lazy.fromStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToText a => a -> Text
toStrictText

  toUnicodeCharList :: a -> [Unicode.Char]
  toUnicodeCharList = Text -> [Char]
Text.Lazy.unpack (Text -> [Char]) -> (a -> Text) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToText a => a -> Text
toLazyText

  {-# MINIMAL toStrictText | toLazyText #-}

instance ToText Strict.Text where
  toStrictText :: Text -> Text
toStrictText = Text -> Text
forall a. a -> a
id

instance ToText Lazy.Text where
  toLazyText :: Text -> Text
toLazyText = Text -> Text
forall a. a -> a
id

instance ToText [Unicode.Char] where
  toUnicodeCharList :: [Char] -> [Char]
toUnicodeCharList = [Char] -> [Char]
forall a. a -> a
id
  toStrictText :: [Char] -> Text
toStrictText = [Char] -> Text
Text.Strict.pack
  toLazyText :: [Char] -> Text
toLazyText = [Char] -> Text
Text.Lazy.pack

instance ToText (ASCII Strict.Text) where
  toStrictText :: ASCII Text -> Text
toStrictText = ASCII Text -> Text
forall superset. ASCII superset -> superset
Refinement.lift

instance ToText (ASCII Lazy.Text) where
  toLazyText :: ASCII Text -> Text
toLazyText = ASCII Text -> Text
forall superset. ASCII superset -> superset
Refinement.lift

instance ToText (ASCII Strict.ByteString) where
  toStrictText :: ASCII ByteString -> Text
toStrictText = ByteString -> Text
Text.Strict.decodeUtf8 (ByteString -> Text)
-> (ASCII ByteString -> ByteString) -> ASCII ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII ByteString -> ByteString
forall superset. ASCII superset -> superset
Refinement.lift

instance ToText (ASCII Lazy.ByteString) where
  toLazyText :: ASCII ByteString -> Text
toLazyText = ByteString -> Text
Text.Lazy.decodeUtf8 (ByteString -> Text)
-> (ASCII ByteString -> ByteString) -> ASCII ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII ByteString -> ByteString
forall superset. ASCII superset -> superset
Refinement.lift

instance ToText (ASCII [Unicode.Char]) where
  toUnicodeCharList :: ASCII [Char] -> [Char]
toUnicodeCharList = ASCII [Char] -> [Char]
forall superset. ASCII superset -> superset
Refinement.lift
  toStrictText :: ASCII [Char] -> Text
toStrictText = [Char] -> Text
Text.Strict.pack ([Char] -> Text)
-> (ASCII [Char] -> [Char]) -> ASCII [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII [Char] -> [Char]
forall superset. ASCII superset -> superset
Refinement.lift
  toLazyText :: ASCII [Char] -> Text
toLazyText = [Char] -> Text
Text.Lazy.pack ([Char] -> Text)
-> (ASCII [Char] -> [Char]) -> ASCII [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII [Char] -> [Char]
forall superset. ASCII superset -> superset
Refinement.lift

instance ToText (ASCII'case letterCase Strict.Text) where
  toStrictText :: ASCII'case letterCase Text -> Text
toStrictText = ASCII Text -> Text
forall superset. ASCII superset -> superset
Refinement.lift (ASCII Text -> Text)
-> (ASCII'case letterCase Text -> ASCII Text)
-> ASCII'case letterCase Text
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase Text -> ASCII Text
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> ASCII superset
CaseRefinement.forgetCase

instance ToText (ASCII'case letterCase Lazy.Text) where
  toLazyText :: ASCII'case letterCase Text -> Text
toLazyText = ASCII Text -> Text
forall superset. ASCII superset -> superset
Refinement.lift (ASCII Text -> Text)
-> (ASCII'case letterCase Text -> ASCII Text)
-> ASCII'case letterCase Text
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase Text -> ASCII Text
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> ASCII superset
CaseRefinement.forgetCase

instance ToText (ASCII'case letterCase Strict.ByteString) where
  toStrictText :: ASCII'case letterCase ByteString -> Text
toStrictText = ByteString -> Text
Text.Strict.decodeUtf8 (ByteString -> Text)
-> (ASCII'case letterCase ByteString -> ByteString)
-> ASCII'case letterCase ByteString
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII ByteString -> ByteString
forall superset. ASCII superset -> superset
Refinement.lift (ASCII ByteString -> ByteString)
-> (ASCII'case letterCase ByteString -> ASCII ByteString)
-> ASCII'case letterCase ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase ByteString -> ASCII ByteString
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> ASCII superset
CaseRefinement.forgetCase

instance ToText (ASCII'case letterCase Lazy.ByteString) where
  toLazyText :: ASCII'case letterCase ByteString -> Text
toLazyText = ByteString -> Text
Text.Lazy.decodeUtf8 (ByteString -> Text)
-> (ASCII'case letterCase ByteString -> ByteString)
-> ASCII'case letterCase ByteString
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII ByteString -> ByteString
forall superset. ASCII superset -> superset
Refinement.lift (ASCII ByteString -> ByteString)
-> (ASCII'case letterCase ByteString -> ASCII ByteString)
-> ASCII'case letterCase ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase ByteString -> ASCII ByteString
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> ASCII superset
CaseRefinement.forgetCase

instance ToText (ASCII'case letterCase [Unicode.Char]) where
  toUnicodeCharList :: ASCII'case letterCase [Char] -> [Char]
toUnicodeCharList = ASCII [Char] -> [Char]
forall superset. ASCII superset -> superset
Refinement.lift (ASCII [Char] -> [Char])
-> (ASCII'case letterCase [Char] -> ASCII [Char])
-> ASCII'case letterCase [Char]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase [Char] -> ASCII [Char]
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> ASCII superset
CaseRefinement.forgetCase
  toStrictText :: ASCII'case letterCase [Char] -> Text
toStrictText = [Char] -> Text
Text.Strict.pack ([Char] -> Text)
-> (ASCII'case letterCase [Char] -> [Char])
-> ASCII'case letterCase [Char]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII [Char] -> [Char]
forall superset. ASCII superset -> superset
Refinement.lift (ASCII [Char] -> [Char])
-> (ASCII'case letterCase [Char] -> ASCII [Char])
-> ASCII'case letterCase [Char]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase [Char] -> ASCII [Char]
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> ASCII superset
CaseRefinement.forgetCase
  toLazyText :: ASCII'case letterCase [Char] -> Text
toLazyText = [Char] -> Text
Text.Lazy.pack ([Char] -> Text)
-> (ASCII'case letterCase [Char] -> [Char])
-> ASCII'case letterCase [Char]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII [Char] -> [Char]
forall superset. ASCII superset -> superset
Refinement.lift (ASCII [Char] -> [Char])
-> (ASCII'case letterCase [Char] -> ASCII [Char])
-> ASCII'case letterCase [Char]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase [Char] -> ASCII [Char]
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> ASCII superset
CaseRefinement.forgetCase