{-# LANGUAGE TypeFamilies, FlexibleContexts, TypeSynonymInstances, ExistentialQuantification, DeriveDataTypeable, FlexibleInstances, UndecidableInstances #-}

module Data.String.Class

( Stringy

, StringCells(..)

, StringCell(..)

, StringRWIO(..)

, ConvGenString(..)

, ConvString(..)

, ConvStrictByteString(..)

, ConvLazyByteString(..)

, ConvText(..)

, GenString(..)

, GenStringDefault

) where

import Prelude hiding (head, tail, last, init, take, drop, length, null, concat, putStr, getContents)

import Control.Applicative hiding (empty)

import qualified Data.ByteString as S

import qualified Data.ByteString.Char8 as SC

import qualified Data.ByteString.Internal as BI

import qualified Data.ByteString.Lazy as L

import qualified Data.ByteString.Lazy.Char8 as LC

import Data.Int

import qualified Data.List as List

import Data.Semigroup

import Data.Monoid hiding ((<>))

import Data.String (IsString)

import qualified Data.String

import Data.Tagged

import qualified Data.Text as T

import qualified Data.Text.Encoding as TE

import qualified Data.Text.Encoding.Error as TEE

import qualified Data.Text.IO as T

import qualified Data.Text.Lazy as LT

import qualified Data.Text.Lazy.Encoding as LTE

import qualified Data.Text.Lazy.IO as LT

import Data.Typeable

import Data.Word

import qualified System.IO as IO

-- | String super class

class (StringCells s, StringRWIO s) => Stringy s

instance (StringCells s, StringRWIO s) => Stringy s

-- | Minimal complete definition: StringCellChar; StringCellAltChar; toStringCells; fromStringCells; toMainChar; toAltChar; cons; snoc; either all of head, tail, last, and init, or all of uncons and unsnoc; take, take64 or genericTake; drop, drop64, or genericDrop; and length, length64, or genericLength

class (Eq s, Monoid s, IsString s, Typeable s, StringCell (StringCellChar s), StringCell (StringCellAltChar s), ConvGenString s, ConvString s, ConvStrictByteString s, ConvLazyByteString s, ConvText s, ConvLazyText s) => StringCells s where

type StringCellChar s

type StringCellAltChar s

toStringCells :: (StringCells s2) => s -> s2

fromStringCells :: (StringCells s2) => s2 -> s

infixr 9 `cons`

infixr 9 `uncons`

infixr 9 `altCons`

infixr 9 `altUncons`

cons :: StringCellChar s -> s -> s

uncons :: s -> (StringCellChar s, s)

snoc :: s -> StringCellChar s -> s

unsnoc :: s -> (s, StringCellChar s)

altCons :: StringCellAltChar s -> s -> s

altUncons :: s -> (StringCellAltChar s, s)

altSnoc :: s -> StringCellAltChar s -> s

altUnsnoc :: s -> (s, StringCellAltChar s)

toMainChar :: (StringCell c) => c -> Tagged s (StringCellChar s)

toAltChar :: (StringCell c) => c -> Tagged s (StringCellAltChar s)

-- | Append two strings

infixr 9 `append`

append :: s -> s -> s

concat :: [s] -> s

empty :: s

null :: s -> Bool

head :: s -> StringCellChar s

tail :: s -> s

last :: s -> StringCellChar s

init :: s -> s

altHead :: s -> StringCellAltChar s

altLast :: s -> StringCellAltChar s

-- | Construction of a string; implementations should behave safely with incorrect lengths

--

-- The default implementation of 'unfoldr' is independent from that of 'altUnfoldr',

-- as well as 'unfoldrN' as and 'altUnfoldrN'.

unfoldr :: (a -> Maybe (StringCellChar s, a)) -> a -> s

altUnfoldr :: (a -> Maybe (StringCellAltChar s, a)) -> a -> s

unfoldrN :: Int -> (a -> Maybe (StringCellChar s, a)) -> a -> s

altUnfoldrN :: Int -> (a -> Maybe (StringCellAltChar s, a)) -> a -> s

unfoldrN64 :: Int64 -> (a -> Maybe (StringCellChar s, a)) -> a -> s

altUnfoldrN64 :: Int64 -> (a -> Maybe (StringCellAltChar s, a)) -> a -> s

unfoldr f b =

case f b of

(Just (a, new_b)) -> a `cons` unfoldr f new_b

(Nothing) -> empty

altUnfoldr f b =

case f b of

(Just (a, new_b)) -> a `altCons` altUnfoldr f new_b

(Nothing) -> empty

unfoldrN = const unfoldr

altUnfoldrN = const altUnfoldr

unfoldrN64 l f z = unfoldrN (fromIntegral l) f z

altUnfoldrN64 l f z = altUnfoldrN (fromIntegral l) f z

-- | Get the character at the given position

--

-- Just like 'drop', 'drop64', and the variants of those functions, the

-- default definitions of these three variants are independent of each

-- other, and are defined in terms of 'head' and 'tail', which can be

-- inefficient.

index :: s -> Int -> StringCellChar s

index64 :: s -> Int64 -> StringCellChar s

-- | Index a string at any location

--

-- Just like the other 'generic' functions of this module, this function

-- can be significantly slower than 'index', since the function must be

-- able to support arbitrarily large indices. Consider using 'index' or

-- 'index64', even if you need to coerce the index to an 'Int'.

genericIndex :: (Integral i) => s -> i -> StringCellChar s

take :: Int -> s -> s

take64 :: Int64 -> s -> s

genericTake :: (Integral i) => i -> s -> s

drop :: Int -> s -> s

drop64 :: Int64 -> s -> s

genericDrop :: (Integral i) => i -> s -> s

length :: s -> Int

length64 :: s -> Int64

genericLength :: (Integral i) => s -> i

safeUncons :: s -> Maybe ((StringCellChar s), s)

safeUnsnoc :: s -> Maybe (s, (StringCellChar s))

safeAltUncons :: s -> Maybe ((StringCellAltChar s), s)

safeAltUnsnoc :: s -> Maybe (s, (StringCellAltChar s))

safeHead :: s -> Maybe (StringCellChar s)

safeTail :: s -> Maybe s

safeLast :: s -> Maybe (StringCellChar s)

safeInit :: s -> Maybe s

safeAltHead :: s -> Maybe (StringCellAltChar s)

safeAltLast :: s -> Maybe (StringCellAltChar s)

safeIndex :: s -> Int -> Maybe (StringCellChar s)

safeIndex64 :: s -> Int64 -> Maybe (StringCellChar s)

safeGenericIndex :: (Integral i) => s -> i -> Maybe (StringCellChar s)

safeTake :: Int -> s -> Maybe s

safeTake64 :: Int64 -> s -> Maybe s

safeGenericTake :: (Integral i) => i -> s -> Maybe s

safeDrop :: Int -> s -> Maybe s

safeDrop64 :: Int64 -> s -> Maybe s

safeGenericDrop :: (Integral i) => i -> s -> Maybe s

safeUncons2 :: s -> Maybe ((StringCellChar s), (StringCellChar s), s)

safeUncons3 :: s -> Maybe ((StringCellChar s), (StringCellChar s), (StringCellChar s), s)

safeUncons4 :: s -> Maybe ((StringCellChar s), (StringCellChar s), (StringCellChar s), (StringCellChar s), s)

infixr 9 `cons2`

infixr 9 `cons3`

infixr 9 `cons4`

infixr 9 `uncons2`

infixr 9 `uncons3`

infixr 9 `uncons4`

cons2 :: StringCellChar s -> StringCellChar s -> s -> s

cons3 :: StringCellChar s -> StringCellChar s -> StringCellChar s -> s -> s

cons4 :: StringCellChar s -> StringCellChar s -> StringCellChar s -> StringCellChar s -> s -> s

uncons2 :: s -> (StringCellChar s, StringCellChar s, s)

uncons3 :: s -> (StringCellChar s, StringCellChar s, StringCellChar s, s)

uncons4 :: s -> (StringCellChar s, StringCellChar s, StringCellChar s, StringCellChar s, s)

altCons c s = cons (s `untagTypeOf` toMainChar c) s

altSnoc s c = snoc s (s `untagTypeOf` toMainChar c)

altUncons s = (\ ~(a, s') -> (s `untagTypeOf` toAltChar a, s')) $ uncons s

altUnsnoc s = (\ ~(s', a) -> (s', s `untagTypeOf` toAltChar a)) $ unsnoc s

append = mappend

concat = mconcat

empty = mempty

null = (== mempty)

head = fst . uncons

tail = snd . uncons

last = snd . unsnoc

init = fst . unsnoc

altHead s = (s `untagTypeOf`) . toAltChar . head $ s

altLast s = (s `untagTypeOf`) . toAltChar . last $ s

index s 0 = head s

index s n = (flip index $ pred n) . tail $ s

index64 s 0 = head s

index64 s n = (flip index64 $ pred n) . tail $ s

genericIndex s 0 = head s

genericIndex s n = (flip genericIndex $ pred n) . tail $ s

take n s = take64 (fromIntegral n) s

take64 n s = genericTake (fromIntegral n :: Integer) s

genericTake n s = take (fromIntegral n) s

drop n s = drop64 (fromIntegral n) s

drop64 n s = genericDrop (fromIntegral n :: Integer) s

genericDrop n s = drop (fromIntegral n) s

length = fromIntegral . length64

length64 = (fromIntegral :: Integer -> Int64) . genericLength

genericLength = fromIntegral . length

{-

uncons s = (head s, tail s)

unsnoc s = (init s, last s)

cons2 a b s = a `cons` b `cons` s

cons3 a b c s = a `cons` b `cons` c `cons` s

cons4 a b c d s = a `cons` b `cons` c `cons` d `cons` s

uncons2 s =

let (a, s') = uncons s

(b, s'') = uncons s'

in (a, b, s'')

uncons3 s =

let (a, s') = uncons s

(b, s'') = uncons s'

(c, s''') = uncons s''

in (a, b, c, s''')

uncons4 s =

let (a, s') = uncons s

(b, s'') = uncons s'

(c, s''') = uncons s''

(d, s'''') = uncons s'''

in (a, b, c, d, s'''')

safeUncons s

| null s = Nothing

| otherwise = Just $ uncons s

safeUnsnoc s

| null s = Nothing

| otherwise = Just $ unsnoc s

safeAltUncons s

| null s = Nothing

| otherwise = Just $ altUncons s

safeAltUnsnoc s

| null s = Nothing

| otherwise = Just $ altUnsnoc s

safeHead s

| null s = Nothing

| otherwise = Just $ head s

safeTail s

| null s = Nothing

| otherwise = Just $ tail s

safeLast s

| null s = Nothing

| otherwise = Just $ last s

safeInit s

| null s = Nothing

| otherwise = Just $ init s

safeAltHead s

| null s = Nothing

| otherwise = Just $ altHead s

safeAltLast s

| null s = Nothing

| otherwise = Just $ altLast s

safeIndex s n

| length s <= n = Nothing

| otherwise = Just $ s `index` n

safeIndex64 s n

| length64 s <= n = Nothing

| otherwise = Just $ s `index64` n

safeGenericIndex s n

| genericLength s <= n = Nothing

| otherwise = Just $ s `genericIndex` n

safeTake n s

| n > length s = Nothing

| otherwise = Just $ take n s

safeTake64 n s

| n > length64 s = Nothing

| otherwise = Just $ take64 n s

safeGenericTake n s

| n > genericLength s = Nothing

| otherwise = Just $ genericTake n s

safeDrop n s

| n > length s = Nothing

| otherwise = Just $ drop n s

safeDrop64 n s

| n > length64 s = Nothing

| otherwise = Just $ drop64 n s

safeGenericDrop n s

| n > genericLength s = Nothing

| otherwise = Just $ genericDrop n s

safeUncons2 s = do

(a, s') <- safeUncons s

(b, s'') <- safeUncons s'

return (a, b, s'')

safeUncons3 s = do

(a, s') <- safeUncons s

(b, s'') <- safeUncons s'

(c, s''') <- safeUncons s''

return (a, b, c, s''')

safeUncons4 s = do

(a, s') <- safeUncons s

(b, s'') <- safeUncons s'

(c, s''') <- safeUncons s''

(d, s'''') <- safeUncons s'''

return (a, b, c, d, s'''')

class StringCell c where

toChar :: c -> Char

toWord8 :: c -> Word8

toWord16 :: c -> Word16

toWord32 :: c -> Word32

toWord64 :: c -> Word64

fromChar :: Char -> c

fromWord8 :: Word8 -> c

fromWord16 :: Word16 -> c

fromWord32 :: Word32 -> c

fromWord64 :: Word64 -> c

class ConvGenString s where

toGenString :: s -> GenString

fromGenString :: GenString -> s

class ConvString s where

toString :: s -> String

fromString :: String -> s

class ConvStrictByteString s where

toStrictByteString :: s -> S.ByteString

fromStrictByteString :: S.ByteString -> s

class ConvLazyByteString s where

toLazyByteString :: s -> L.ByteString

fromLazyByteString :: L.ByteString -> s

class ConvText s where

toText :: s -> T.Text

fromText :: T.Text -> s

class ConvLazyText s where

toLazyText :: s -> LT.Text

fromLazyText :: LT.Text -> s

-- | Minimal complete definition: 'hGetContents', 'hGetLine', 'hPutStr', and 'hPutStrLn'

class StringRWIO s where

--- Handles

-- | Read n bytes *or* characters, depending on the implementation into a

-- ByteString, directly from the specified Handle

--

-- Whether or not this function is lazy depends on the instance; laziness

-- is preferred.

hGetContents :: IO.Handle -> IO s

-- | Read a single line from a handle

hGetLine :: IO.Handle -> IO s

-- | Write a string to a handle

hPutStr :: IO.Handle -> s -> IO ()

-- | Write a string to a handle, followed by a newline

--

-- N.B.: implementations might not define this atomically. If the state

-- of being atomic is necessary, one possible solution is to convert a

-- string to an efficient type for which 'hPutStrLn' is atomic.

hPutStrLn :: IO.Handle -> s -> IO ()

--- Special cases for standard input and output

-- | Take a function of type Text -> Text as its argument

--

-- The entire input from the standard input device is passed to this

-- function as its argument, and the resulting string is output on the

-- standard output device.

interact :: (s -> s) -> IO ()

interact f = putStr . f =<< getContents

-- | Read all user input on 'stdin' as a single string

getContents :: IO s

getContents = hGetContents IO.stdin

-- | Read a single line of user input from 'stdin'

getLine :: IO s

getLine = hGetLine IO.stdin

-- | Write a string to 'stdout'

putStr :: s -> IO ()

putStr = hPutStr IO.stdout

-- | Write a string to 'stdout', followed by a newline

putStrLn :: s -> IO ()

putStrLn = hPutStrLn IO.stdout

---

-- | Read a file and returns the contents of the file as a string

--

-- Depending on the instance, this function might expect the file to be

-- non-binary. The default definition uses 'openFile' to open the file.

readFile :: FilePath -> IO s

readFile fn = hGetContents =<< IO.openFile fn IO.ReadMode

-- | Write a string to a file

--

-- The file is truncated to zero length before writing begins.

-- The default definition uses 'withFile' to open the file.

writeFile :: FilePath -> s -> IO ()

writeFile fn s = IO.withFile fn IO.WriteMode $ \hdl -> hPutStr hdl s

-- | Write a string to the end of a file

--

-- The default definition uses 'withFile' to open the file.

appendFile :: FilePath -> s -> IO ()

appendFile fn s = IO.withFile fn IO.AppendMode $ \hdl -> hPutStr hdl s

instance StringCells String where

type StringCellChar String = Char

type StringCellAltChar String = Char

toStringCells = fromString

fromStringCells = toString

length = List.genericLength

empty = []

null = List.null

cons = (:)

snoc s c = s ++ [c]

safeUncons (x:xs) = Just (x, xs)

safeUncons _ = Nothing

uncons (x:xs) = (x, xs)

uncons _ = error "String.uncons: null string"

toMainChar = Tagged . toChar

toAltChar = Tagged . toChar

head = List.head

tail = List.tail

init = List.init

last = List.last

unfoldr = List.unfoldr

index = (List.!!)

index64 s = index s . fromIntegral

genericIndex = List.genericIndex

take = List.take

genericTake = List.genericTake

drop = List.drop

genericDrop = List.genericDrop

append = (List.++)

concat = List.concat

instance StringCells S.ByteString where

type StringCellChar S.ByteString = Word8

type StringCellAltChar S.ByteString = Char

toStringCells = fromStrictByteString

fromStringCells = toStrictByteString

length = S.length

empty = S.empty

null = S.null

cons = S.cons

snoc = S.snoc

safeUncons = S.uncons

uncons = maybe (error "StringCells.Data.ByteString.ByteString.uncons: string is null") id . safeUncons

toMainChar = Tagged . toWord8

toAltChar = Tagged . toChar

head = S.head

tail = S.tail

init = S.init

last = S.last

unfoldr = S.unfoldr

altUnfoldr = SC.unfoldr

unfoldrN = ((fst .) .) . S.unfoldrN

altUnfoldrN = ((fst .) .) . SC.unfoldrN

index = S.index

index64 s = index s . fromIntegral

take = S.take

drop = S.drop

append = S.append

concat = S.concat

instance StringCells L.ByteString where

type StringCellChar L.ByteString = Word8

type StringCellAltChar L.ByteString = Char

toStringCells = fromLazyByteString

fromStringCells = toLazyByteString

length64 = L.length

length = fromIntegral . length64

empty = L.empty

null = L.null

cons = L.cons

snoc = L.snoc

safeUncons = L.uncons

uncons = maybe (error "StringCells.Data.ByteString.Lazy.ByteString.uncons: string is null") id . safeUncons

toMainChar = Tagged . toWord8

toAltChar = Tagged . toChar

head = L.head

tail = L.tail

init = L.init

last = L.last

unfoldr = L.unfoldr

altUnfoldr = LC.unfoldr

index s = index64 s . fromIntegral

index64 = L.index

take64 = L.take

drop64 = L.drop

append = L.append

concat = L.concat

instance StringCells T.Text where

type StringCellChar T.Text = Char

type StringCellAltChar T.Text = Char

toStringCells = fromText

fromStringCells = toText

length = T.length

empty = T.empty

null = T.null

cons = T.cons

safeUncons = T.uncons

uncons = maybe (error "StringCells.Data.Text.Text.uncons: string is null") id . safeUncons

snoc = T.snoc

altSnoc = T.snoc

toMainChar = Tagged . toChar

toAltChar = Tagged . toChar

head = T.head

tail = T.tail

init = T.init

last = T.last

unfoldr = T.unfoldr

altUnfoldr = T.unfoldr

unfoldrN = T.unfoldrN

altUnfoldrN = T.unfoldrN

index = T.index

index64 s = index s . fromIntegral

append = T.append

concat = T.concat

instance StringCells LT.Text where

type StringCellChar LT.Text = Char

type StringCellAltChar LT.Text = Char

toStringCells = fromLazyText

fromStringCells = toLazyText

length64 = LT.length

empty = LT.empty

null = LT.null

cons = LT.cons

safeUncons = LT.uncons

uncons = maybe (error "StringCells.Data.Text.Lazy.Text.uncons: string is null") id . safeUncons

snoc = LT.snoc

altSnoc = LT.snoc

toMainChar = Tagged . toChar

toAltChar = Tagged . toChar

head = LT.head

tail = LT.tail

init = LT.init

last = LT.last

unfoldr = LT.unfoldr

altUnfoldr = LT.unfoldr

unfoldrN64 = LT.unfoldrN

altUnfoldrN64 = LT.unfoldrN

index s = index64 s . fromIntegral

index64 = LT.index

append = LT.append

concat = LT.concat

instance StringCell Char where

toChar = id

toWord8 = BI.c2w

toWord16 = fromIntegral . toWord8

toWord32 = fromIntegral . toWord8

toWord64 = fromIntegral . toWord8

fromChar = id

fromWord8 = BI.w2c

fromWord16 = BI.w2c . fromIntegral

fromWord32 = BI.w2c . fromIntegral

fromWord64 = BI.w2c . fromIntegral

instance StringCell Word8 where

toChar = BI.w2c

toWord8 = id

toWord16 = fromIntegral

toWord32 = fromIntegral

toWord64 = fromIntegral

fromChar = BI.c2w

fromWord8 = id

fromWord16 = fromIntegral

fromWord32 = fromIntegral

fromWord64 = fromIntegral

instance StringCell Word16 where

toChar = BI.w2c . fromIntegral

toWord8 = fromIntegral

toWord16 = id

toWord32 = fromIntegral

toWord64 = fromIntegral

fromChar = fromIntegral . BI.c2w

fromWord8 = fromIntegral

fromWord16 = id

fromWord32 = fromIntegral

fromWord64 = fromIntegral

instance StringCell Word32 where

toChar = BI.w2c . fromIntegral

toWord8 = fromIntegral

toWord16 = fromIntegral

toWord32 = id

toWord64 = fromIntegral

fromChar = fromIntegral . BI.c2w

fromWord8 = fromIntegral

fromWord16 = fromIntegral

fromWord32 = id

fromWord64 = fromIntegral

instance StringCell Word64 where

toChar = BI.w2c . fromIntegral

toWord8 = fromIntegral

toWord16 = fromIntegral

toWord32 = fromIntegral

toWord64 = id

fromChar = fromIntegral . BI.c2w

fromWord8 = fromIntegral

fromWord16 = fromIntegral

fromWord32 = fromIntegral

fromWord64 = id

instance ConvGenString GenString where

toGenString = id

fromGenString = id

instance ConvGenString String where

toGenString = GenString

fromGenString _s = case _s of

(GenString _s) -> toStringCells _s

instance ConvGenString SC.ByteString where

toGenString = GenString

fromGenString _s = case _s of

(GenString _s) -> toStringCells _s

instance ConvGenString LC.ByteString where

toGenString = GenString

fromGenString _s = case _s of

(GenString _s) -> toStringCells _s

instance ConvGenString T.Text where

toGenString = GenString

fromGenString _s = case _s of

(GenString _s) -> toStringCells _s

instance ConvGenString LT.Text where

toGenString = GenString

fromGenString _s = case _s of

(GenString _s) -> toStringCells _s

instance ConvString GenString where

toString = fromGenString

fromString = toGenString

instance ConvString String where

toString = id

fromString = id

instance ConvString SC.ByteString where

toString = SC.unpack

fromString = SC.pack

instance ConvString LC.ByteString where

toString = LC.unpack

fromString = LC.pack

instance ConvString T.Text where

toString = T.unpack

fromString = T.pack

instance ConvString LT.Text where

toString = LT.unpack

fromString = LT.pack

instance ConvStrictByteString GenString where

toStrictByteString = fromGenString

fromStrictByteString = toGenString

instance ConvStrictByteString String where

toStrictByteString = SC.pack

fromStrictByteString = SC.unpack

instance ConvStrictByteString S.ByteString where

toStrictByteString = id

fromStrictByteString = id

instance ConvStrictByteString L.ByteString where

toStrictByteString = L.toStrict

fromStrictByteString = toLazyByteString

instance ConvStrictByteString T.Text where

toStrictByteString = TE.encodeUtf8

fromStrictByteString = toText

instance ConvStrictByteString LT.Text where

toStrictByteString = toStrictByteString . LTE.encodeUtf8

fromStrictByteString = toLazyText

instance ConvLazyByteString GenString where

toLazyByteString = fromGenString

fromLazyByteString = toGenString

instance ConvLazyByteString String where

toLazyByteString = LC.pack

fromLazyByteString = LC.unpack

instance ConvLazyByteString S.ByteString where

toLazyByteString = L.fromStrict

fromLazyByteString = toStrictByteString

instance ConvLazyByteString L.ByteString where

toLazyByteString = id

fromLazyByteString = id

instance ConvLazyByteString T.Text where

toLazyByteString = toLazyByteString . toStrictByteString

fromLazyByteString = toText

instance ConvLazyByteString LT.Text where

toLazyByteString = toLazyByteString . toStrictByteString

fromLazyByteString = toLazyText

instance ConvText GenString where

toText = fromGenString

fromText = toGenString

instance ConvText String where

toText = T.pack

fromText = T.unpack

instance ConvText S.ByteString where

toText = TE.decodeUtf8With TEE.lenientDecode

fromText = toStrictByteString

instance ConvText L.ByteString where

toText = toText . toStrictByteString

fromText = toLazyByteString

instance ConvText T.Text where

toText = id

fromText = id

instance ConvText LT.Text where

toText = LT.toStrict

fromText = toLazyText

instance ConvLazyText GenString where

toLazyText = fromGenString

fromLazyText = toGenString

instance ConvLazyText String where

toLazyText = LT.pack

fromLazyText = LT.unpack

instance ConvLazyText S.ByteString where

toLazyText = LTE.decodeUtf8With TEE.lenientDecode . toLazyByteString

fromLazyText = toStrictByteString

instance ConvLazyText L.ByteString where

toLazyText = LTE.decodeUtf8With TEE.lenientDecode

fromLazyText = toLazyByteString

instance ConvLazyText T.Text where

toLazyText = LT.fromStrict

fromLazyText = fromLazyText

instance ConvLazyText LT.Text where

toLazyText = id

fromLazyText = id

-- |

instance StringRWIO GenString where

hGetContents h = genStringFromConConv <$> hGetContents h

hGetLine h = genStringFromConConv <$> hGetLine h

hPutStr h s = hPutStr h (genStringConConv s)

hPutStrLn h s = hPutStrLn h (genStringConConv s)

-- | Type-restricted string conversion used by 'GenString's instance definition for 'StringRWIO'

genStringConConv :: GenString -> GenStringDefault

genStringConConv = toStringCells

-- | Type-restricted string conversion used by 'GenString's instance definition for 'StringRWIO'

genStringFromConConv :: GenStringDefault -> GenString

genStringFromConConv = toStringCells

-- |

instance StringRWIO String where

hGetContents = IO.hGetContents

hGetLine = IO.hGetLine

hPutStr = IO.hPutStr

hPutStrLn = IO.hPutStrLn

interact = IO.interact

getContents = IO.getContents

getLine = IO.getLine

putStr = IO.putStr

putStrLn = IO.putStrLn

readFile = IO.readFile

writeFile = IO.writeFile

appendFile = IO.appendFile

-- |

instance StringRWIO S.ByteString where

hGetContents = S.hGetContents

hGetLine = S.hGetLine

hPutStr = S.hPutStr

hPutStrLn = SC.hPutStrLn

interact = S.interact

getContents = S.getContents

getLine = S.getLine

putStr = S.putStr

putStrLn = SC.putStrLn

readFile = S.readFile

writeFile = S.writeFile

appendFile = S.appendFile

-- |

instance StringRWIO L.ByteString where

hGetContents = L.hGetContents

hGetLine = (toStringCells <$>) . S.hGetLine

hPutStr = L.hPutStr

hPutStrLn h = (>> hPutStr h ((toStringCells :: String -> L.ByteString) ['\n'])) . hPutStr h

interact = L.interact

getContents = L.getContents

getLine = toStringCells <$> S.getLine

putStr = L.putStr

putStrLn = LC.putStrLn

readFile = L.readFile

writeFile = L.writeFile

appendFile = L.appendFile

-- |

instance StringRWIO T.Text where

hGetContents = T.hGetContents

hGetLine = T.hGetLine

hPutStr = T.hPutStr

hPutStrLn = T.hPutStrLn

interact = T.interact

getContents = T.getContents

getLine = T.getLine

putStr = T.putStr

putStrLn = T.putStrLn

readFile = T.readFile

writeFile = T.writeFile

appendFile = T.appendFile

-- |

instance StringRWIO LT.Text where

hGetContents = LT.hGetContents

hGetLine = LT.hGetLine

hPutStr = LT.hPutStr

hPutStrLn = LT.hPutStrLn

interact = LT.interact

getContents = LT.getContents

getLine = LT.getLine

putStr = LT.putStr

putStrLn = LT.putStrLn

readFile = LT.readFile

writeFile = LT.writeFile

appendFile = LT.appendFile

-- | Polymorphic container of a string

data GenString = forall s. (Stringy s) => GenString {gen_string :: s}

deriving (Typeable)

toGenDefaultString :: (Stringy s) => s -> GenStringDefault

toGenDefaultString = toStringCells

instance Eq GenString where

_a == _b = case (_a, _b) of

((GenString _a), (GenString _b)) -> toGenDefaultString _a == toGenDefaultString _b

_a /= _b = case (_a, _b) of

((GenString _a), (GenString _b)) -> toGenDefaultString _a /= toGenDefaultString _b

instance IsString GenString where

fromString = GenString

instance Semigroup GenString where

(<>) a b = case (a, b) of

(GenString _a, GenString _b) -> GenString $ append (toGenDefaultString _a) (toGenDefaultString _b)

instance Monoid GenString where

mempty = GenString $ (empty :: GenStringDefault)

mappend = (<>)

mconcat ss = GenString $ concat . map toGenDefaultString $ ss

instance StringCells GenString where

-- These associated types were rather arbitrarily chosen

type StringCellChar GenString = Char

type StringCellAltChar GenString = Word8

toStringCells = fromGenString

fromStringCells = toGenString

cons c _s = case _s of

(GenString _s) -> GenString $ cons (_s `untagTypeOf` toMainChar c) _s

uncons _s = case _s of

(GenString _s) -> let (c, s') = uncons _s

in (genStringPhantom `untagTypeOf` toMainChar c, GenString s')

snoc _s c = case _s of

(GenString _s) -> GenString $ snoc _s (_s `untagTypeOf` toMainChar c)

unsnoc _s = case _s of

(GenString _s) -> let (s', c) = unsnoc _s

in (GenString s', genStringPhantom `untagTypeOf` toMainChar c)