module ASCII.Superset.Text where

import ASCII.CaseRefinement (ASCII'case)
import ASCII.Refinement (ASCII)
import Data.Function (id, (.))

import qualified ASCII.CaseRefinement as CaseRefinement
import qualified ASCII.Refinement as Refinement
import qualified Data.ByteString as Strict (ByteString)
import qualified Data.ByteString.Lazy as Lazy (ByteString)
import qualified Data.Char as Unicode
import qualified Data.Text as Strict (Text)
import qualified Data.Text as Text.Strict
import qualified Data.Text.Encoding as Text.Strict
import qualified Data.Text.Lazy as Lazy (Text)
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Encoding as Text.Lazy

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

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

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

    {-# minimal toStrictText | toLazyText #-}

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

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

instance ToText [Unicode.Char] where
    toUnicodeCharList :: [Char] -> [Char]
toUnicodeCharList = 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 = forall superset. ASCII superset -> superset
Refinement.lift

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

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

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

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

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