string-class-0.1.7.0: src/Data/String/Class.hs
{-# 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
{-
-- More efficient default implementation provided above
append a b = case safeUncons a of
(Just (c, cs)) -> c `cons` append cs b
(Nothing) -> a
concat = foldr append empty
-}
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
-- |
--
-- This is minimally defined with 'GenStringDefault'.
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
-- |
--
-- See 'System.IO for documentation of behaviour.
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
-- |
--
-- See 'Data.ByteString' for documentation of behaviour.
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
-- |
--
-- See 'Data.ByteString.Lazy' for documentation of behaviour.
--
-- 'hGetLine' and 'getLine' are defined in terms of 'toStringCells' and the equivalent methods of 'Data.ByteString'.
-- 'hPutStrLn' is defined non-atomically: it is defined as an action that puts the string and then separately puts a newline character string.
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
-- |
--
-- See 'Data.Text.IO' for documentation of behaviour.
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
-- |
--
-- See 'Data.Text.Lazy.IO' for documentation of behaviour.
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
--
-- When operations take place on multiple 'GenString's, they are first
-- converted to the type 'GenStringDefault', which are lazy bytestrings,
-- whenever absolutely necessary (which includes testing for equality,
-- appending strings, concatenating lists of strings, empty strings with
-- 'empty', and unfolding), making them the most efficient type for this
-- polymorphic container.
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)
altCons c _s = case _s of
(GenString _s) -> GenString $ cons (fromWord8 c) _s
altUncons _s = case _s of
(GenString _s) -> let (c, s') = uncons _s
in (genStringPhantom `untagTypeOf` toAltChar c, GenString s')
altSnoc _s c = case _s of
(GenString _s) -> GenString $ snoc _s (fromWord8 c)
altUnsnoc _s = case _s of
(GenString _s) -> let (s', c) = unsnoc _s
in (GenString s', genStringPhantom `untagTypeOf` toAltChar c)
toMainChar = Tagged . toChar
toAltChar = Tagged . toWord8
null _s = case _s of
(GenString _s) -> null _s
head _s = case _s of
(GenString _s) -> genStringPhantom `untagTypeOf` toMainChar (head _s)
tail _s = case _s of
(GenString _s) -> GenString $ tail _s
last _s = case _s of
(GenString _s) -> genStringPhantom `untagTypeOf` toMainChar (last _s)
init _s = case _s of
(GenString _s) -> GenString $ init _s
altHead _s = case _s of
(GenString _s) -> genStringPhantom `untagTypeOf` toAltChar (head _s)
altLast _s = case _s of
(GenString _s) -> genStringPhantom `untagTypeOf` toAltChar (last _s)
unfoldr f z = GenString $ (altUnfoldr f z :: GenStringDefault)
altUnfoldr f z = GenString $ (unfoldr f z :: GenStringDefault)
unfoldrN n f z = GenString $ (altUnfoldrN n f z :: GenStringDefault)
altUnfoldrN n f z = GenString $ (unfoldrN n f z :: GenStringDefault)
index _s i = case _s of
(GenString _s) -> genStringPhantom `untagTypeOf` toMainChar (index _s i)
index64 _s i = case _s of
(GenString _s) -> genStringPhantom `untagTypeOf` toMainChar (index64 _s i)
genericIndex _s i = case _s of
(GenString _s) -> genStringPhantom `untagTypeOf` toMainChar (genericIndex _s i)
take n _s = case _s of
(GenString _s) -> GenString $ take n _s
take64 n _s = case _s of
(GenString _s) -> GenString $ take64 n _s
genericTake n _s = case _s of
(GenString _s) -> GenString $ genericTake n _s
drop n _s = case _s of
(GenString _s) -> GenString $ drop n _s
drop64 n _s = case _s of
(GenString _s) -> GenString $ drop64 n _s
genericDrop n _s = case _s of
(GenString _s) -> GenString $ genericDrop n _s
length _s = case _s of
(GenString _s) -> length _s
length64 _s = case _s of
(GenString _s) -> length64 _s
genericLength _s = case _s of
(GenString _s) -> genericLength _s
safeUncons _s = case _s of
(GenString _s) -> (\(c, s') -> (genStringPhantom `untagTypeOf` toMainChar c, GenString s')) <$> safeUncons _s
safeUnsnoc _s = case _s of
(GenString _s) -> (\(s', c) -> (GenString s', genStringPhantom `untagTypeOf` toMainChar c)) <$> safeUnsnoc _s
safeAltUncons _s = case _s of
(GenString _s) -> (\(c, s') -> (genStringPhantom `untagTypeOf` toAltChar c, GenString s')) <$> safeAltUncons _s
safeAltUnsnoc _s = case _s of
(GenString _s) -> (\(s', c) -> (GenString s', genStringPhantom `untagTypeOf` toAltChar c)) <$> safeAltUnsnoc _s
safeHead _s = case _s of
(GenString _s) -> (genStringPhantom `untagTypeOf`) . toMainChar <$> safeHead _s
safeTail _s = case _s of
(GenString _s) -> GenString <$> safeTail _s
safeLast _s = case _s of
(GenString _s) -> (genStringPhantom `untagTypeOf`) . toMainChar <$> safeLast _s
safeInit _s = case _s of
(GenString _s) -> GenString <$> safeInit _s
safeAltHead _s = case _s of
(GenString _s) -> (genStringPhantom `untagTypeOf`) . toAltChar <$> safeAltHead _s
safeAltLast _s = case _s of
(GenString _s) -> (genStringPhantom `untagTypeOf`) . toAltChar <$> safeAltLast _s
safeIndex _s i = case _s of
(GenString _s) -> (genStringPhantom `untagTypeOf`) . toMainChar <$> safeIndex _s i
safeIndex64 _s i = case _s of
(GenString _s) -> (genStringPhantom `untagTypeOf`) . toMainChar <$> safeIndex64 _s i
safeGenericIndex _s i = case _s of
(GenString _s) -> (genStringPhantom `untagTypeOf`) . toMainChar <$> safeGenericIndex _s i
safeTake n _s = case _s of
(GenString _s) -> GenString <$> safeTake n _s
safeTake64 n _s = case _s of
(GenString _s) -> GenString <$> safeTake64 n _s
safeGenericTake n _s = case _s of
(GenString _s) -> GenString <$> safeGenericTake n _s
safeDrop n _s = case _s of
(GenString _s) -> GenString <$> safeDrop n _s
safeDrop64 n _s = case _s of
(GenString _s) -> GenString <$> safeDrop64 n _s
safeGenericDrop n _s = case _s of
(GenString _s) -> GenString <$> safeGenericDrop n _s
safeUncons2 _s = case _s of
(GenString _s) -> (\(a, b, s') -> (genStringPhantom `untagTypeOf` toMainChar a, genStringPhantom `untagTypeOf` toMainChar b, GenString s')) <$> safeUncons2 _s
safeUncons3 _s = case _s of
(GenString _s) -> (\(a, b, c, s') -> (genStringPhantom `untagTypeOf` toMainChar a, genStringPhantom `untagTypeOf` toMainChar b, genStringPhantom `untagTypeOf` toMainChar c, GenString s')) <$> safeUncons3 _s
safeUncons4 _s = case _s of
(GenString _s) -> (\(a, b, c, d, s') -> (genStringPhantom `untagTypeOf` toMainChar a, genStringPhantom `untagTypeOf` toMainChar b, genStringPhantom `untagTypeOf` toMainChar c, genStringPhantom `untagTypeOf` toMainChar d, GenString s')) <$> safeUncons4 _s
cons2 a b _s = case _s of
(GenString _s) -> GenString $ cons2 (_s `untagTypeOf` toMainChar a) (_s `untagTypeOf` toMainChar b) _s
cons3 a b c _s = case _s of
(GenString _s) -> GenString $ cons3 (_s `untagTypeOf` toMainChar a) (_s `untagTypeOf` toMainChar b) (_s `untagTypeOf` toMainChar c) _s
cons4 a b c d _s = case _s of
(GenString _s) -> GenString $ cons4 (_s `untagTypeOf` toMainChar a) (_s `untagTypeOf` toMainChar b) (_s `untagTypeOf` toMainChar c) (_s `untagTypeOf` toMainChar d) _s
uncons2 _s = case _s of
(GenString _s) -> let (a, b, s') = uncons2 _s
in (genStringPhantom `untagTypeOf` toMainChar a, genStringPhantom `untagTypeOf` toMainChar b, GenString s')
uncons3 _s = case _s of
(GenString _s) -> let (a, b, c, s') = uncons3 _s
in (genStringPhantom `untagTypeOf` toMainChar a, genStringPhantom `untagTypeOf` toMainChar b, genStringPhantom `untagTypeOf` toMainChar c, GenString s')
uncons4 _s = case _s of
(GenString _s) -> let (a, b, c, d, s') = uncons4 _s
in (genStringPhantom `untagTypeOf` toMainChar a, genStringPhantom `untagTypeOf` toMainChar b, genStringPhantom `untagTypeOf` toMainChar c, genStringPhantom `untagTypeOf` toMainChar d, GenString s')
-- | Untag a type with a type restriction
--
-- The first argument is guaranteed to be ignored; thus the value 'undefined'
-- can be passed in its place.
untagTypeOf :: s -> Tagged s b -> b
untagTypeOf _ = untag
-- | Phantom, undefined value only used for convenience
--
-- Users should be careful that this value is never evaluated when using this.
genStringPhantom :: GenString
genStringPhantom = undefined
-- | This type is used by 'GenString' when a concrete string type is needed
type GenStringDefault = L.ByteString