{-# 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 a -> Maybe (StringCellChar s, a)
f a
b =
        case a -> Maybe (StringCellChar s, a)
f a
b of
            (Just (StringCellChar s
a, a
new_b)) -> StringCellChar s
a StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
`cons` (a -> Maybe (StringCellChar s, a)) -> a -> s
forall s a.
StringCells s =>
(a -> Maybe (StringCellChar s, a)) -> a -> s
forall a. (a -> Maybe (StringCellChar s, a)) -> a -> s
unfoldr a -> Maybe (StringCellChar s, a)
f a
new_b
            (Maybe (StringCellChar s, a)
Nothing)         -> s
forall s. StringCells s => s
empty

    altUnfoldr a -> Maybe (StringCellAltChar s, a)
f a
b =
        case a -> Maybe (StringCellAltChar s, a)
f a
b of
            (Just (StringCellAltChar s
a, a
new_b)) -> StringCellAltChar s
a StringCellAltChar s -> s -> s
forall s. StringCells s => StringCellAltChar s -> s -> s
`altCons` (a -> Maybe (StringCellAltChar s, a)) -> a -> s
forall s a.
StringCells s =>
(a -> Maybe (StringCellAltChar s, a)) -> a -> s
forall a. (a -> Maybe (StringCellAltChar s, a)) -> a -> s
altUnfoldr a -> Maybe (StringCellAltChar s, a)
f a
new_b
            (Maybe (StringCellAltChar s, a)
Nothing)         -> s
forall s. StringCells s => s
empty
    unfoldrN    = ((a -> Maybe (StringCellChar s, a)) -> a -> s)
-> Int -> (a -> Maybe (StringCellChar s, a)) -> a -> s
forall a b. a -> b -> a
const (a -> Maybe (StringCellChar s, a)) -> a -> s
forall s a.
StringCells s =>
(a -> Maybe (StringCellChar s, a)) -> a -> s
forall a. (a -> Maybe (StringCellChar s, a)) -> a -> s
unfoldr
    altUnfoldrN = ((a -> Maybe (StringCellAltChar s, a)) -> a -> s)
-> Int -> (a -> Maybe (StringCellAltChar s, a)) -> a -> s
forall a b. a -> b -> a
const (a -> Maybe (StringCellAltChar s, a)) -> a -> s
forall s a.
StringCells s =>
(a -> Maybe (StringCellAltChar s, a)) -> a -> s
forall a. (a -> Maybe (StringCellAltChar s, a)) -> a -> s
altUnfoldr

    unfoldrN64 Int64
l a -> Maybe (StringCellChar s, a)
f a
z = Int -> (a -> Maybe (StringCellChar s, a)) -> a -> s
forall a. Int -> (a -> Maybe (StringCellChar s, a)) -> a -> s
forall s a.
StringCells s =>
Int -> (a -> Maybe (StringCellChar s, a)) -> a -> s
unfoldrN (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
l) a -> Maybe (StringCellChar s, a)
f a
z

    altUnfoldrN64 Int64
l a -> Maybe (StringCellAltChar s, a)
f a
z = Int -> (a -> Maybe (StringCellAltChar s, a)) -> a -> s
forall a. Int -> (a -> Maybe (StringCellAltChar s, a)) -> a -> s
forall s a.
StringCells s =>
Int -> (a -> Maybe (StringCellAltChar s, a)) -> a -> s
altUnfoldrN (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
l) a -> Maybe (StringCellAltChar s, a)
f a
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 StringCellAltChar s
c s
s = StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
cons (s
s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellAltChar s -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellAltChar s
c) s
s
    altSnoc s
s StringCellAltChar s
c = s -> StringCellChar s -> s
forall s. StringCells s => s -> StringCellChar s -> s
snoc s
s (s
s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellAltChar s -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellAltChar s
c)
    altUncons s
s = (\ ~(StringCellChar s
a, s
s') -> (s
s s -> Tagged s (StringCellAltChar s) -> StringCellAltChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged s (StringCellAltChar s)
forall c. StringCell c => c -> Tagged s (StringCellAltChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellAltChar s)
toAltChar StringCellChar s
a, s
s')) ((StringCellChar s, s) -> (StringCellAltChar s, s))
-> (StringCellChar s, s) -> (StringCellAltChar s, s)
forall a b. (a -> b) -> a -> b
$ s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
s
    altUnsnoc s
s = (\ ~(s
s', StringCellChar s
a) -> (s
s', s
s s -> Tagged s (StringCellAltChar s) -> StringCellAltChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged s (StringCellAltChar s)
forall c. StringCell c => c -> Tagged s (StringCellAltChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellAltChar s)
toAltChar StringCellChar s
a)) ((s, StringCellChar s) -> (s, StringCellAltChar s))
-> (s, StringCellChar s) -> (s, StringCellAltChar s)
forall a b. (a -> b) -> a -> b
$ s -> (s, StringCellChar s)
forall s. StringCells s => s -> (s, StringCellChar s)
unsnoc s
s

    append = s -> s -> s
forall a. Monoid a => a -> a -> a
mappend
    concat = [s] -> s
forall a. Monoid a => [a] -> a
mconcat
    empty  = s
forall a. Monoid a => a
mempty
    null   = (s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
forall a. Monoid a => a
mempty)

    head = (StringCellChar s, s) -> StringCellChar s
forall a b. (a, b) -> a
fst ((StringCellChar s, s) -> StringCellChar s)
-> (s -> (StringCellChar s, s)) -> s -> StringCellChar s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons
    tail = (StringCellChar s, s) -> s
forall a b. (a, b) -> b
snd ((StringCellChar s, s) -> s)
-> (s -> (StringCellChar s, s)) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons
    last = (s, StringCellChar s) -> StringCellChar s
forall a b. (a, b) -> b
snd ((s, StringCellChar s) -> StringCellChar s)
-> (s -> (s, StringCellChar s)) -> s -> StringCellChar s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> (s, StringCellChar s)
forall s. StringCells s => s -> (s, StringCellChar s)
unsnoc
    init = (s, StringCellChar s) -> s
forall a b. (a, b) -> a
fst ((s, StringCellChar s) -> s)
-> (s -> (s, StringCellChar s)) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> (s, StringCellChar s)
forall s. StringCells s => s -> (s, StringCellChar s)
unsnoc
    altHead s
s = (s
s s -> Tagged s (StringCellAltChar s) -> StringCellAltChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf`) (Tagged s (StringCellAltChar s) -> StringCellAltChar s)
-> (s -> Tagged s (StringCellAltChar s))
-> s
-> StringCellAltChar s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringCellChar s -> Tagged s (StringCellAltChar s)
forall c. StringCell c => c -> Tagged s (StringCellAltChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellAltChar s)
toAltChar (StringCellChar s -> Tagged s (StringCellAltChar s))
-> (s -> StringCellChar s) -> s -> Tagged s (StringCellAltChar s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
head (s -> StringCellAltChar s) -> s -> StringCellAltChar s
forall a b. (a -> b) -> a -> b
$ s
s
    altLast s
s = (s
s s -> Tagged s (StringCellAltChar s) -> StringCellAltChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf`) (Tagged s (StringCellAltChar s) -> StringCellAltChar s)
-> (s -> Tagged s (StringCellAltChar s))
-> s
-> StringCellAltChar s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringCellChar s -> Tagged s (StringCellAltChar s)
forall c. StringCell c => c -> Tagged s (StringCellAltChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellAltChar s)
toAltChar (StringCellChar s -> Tagged s (StringCellAltChar s))
-> (s -> StringCellChar s) -> s -> Tagged s (StringCellAltChar s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
last (s -> StringCellAltChar s) -> s -> StringCellAltChar s
forall a b. (a -> b) -> a -> b
$ s
s

    index        s
s Int
0 = s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
head s
s
    index        s
s Int
n = ((s -> Int -> StringCellChar s) -> Int -> s -> StringCellChar s
forall a b c. (a -> b -> c) -> b -> a -> c
flip s -> Int -> StringCellChar s
forall s. StringCells s => s -> Int -> StringCellChar s
index (Int -> s -> StringCellChar s) -> Int -> s -> StringCellChar s
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
pred Int
n) (s -> StringCellChar s) -> (s -> s) -> s -> StringCellChar s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
forall s. StringCells s => s -> s
tail (s -> StringCellChar s) -> s -> StringCellChar s
forall a b. (a -> b) -> a -> b
$ s
s
    index64      s
s Int64
0 = s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
head s
s
    index64      s
s Int64
n = ((s -> Int64 -> StringCellChar s) -> Int64 -> s -> StringCellChar s
forall a b c. (a -> b -> c) -> b -> a -> c
flip s -> Int64 -> StringCellChar s
forall s. StringCells s => s -> Int64 -> StringCellChar s
index64 (Int64 -> s -> StringCellChar s) -> Int64 -> s -> StringCellChar s
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a. Enum a => a -> a
pred Int64
n) (s -> StringCellChar s) -> (s -> s) -> s -> StringCellChar s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
forall s. StringCells s => s -> s
tail (s -> StringCellChar s) -> s -> StringCellChar s
forall a b. (a -> b) -> a -> b
$ s
s
    genericIndex s
s i
0 = s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
head s
s
    genericIndex s
s i
n = ((s -> i -> StringCellChar s) -> i -> s -> StringCellChar s
forall a b c. (a -> b -> c) -> b -> a -> c
flip s -> i -> StringCellChar s
forall i. Integral i => s -> i -> StringCellChar s
forall s i.
(StringCells s, Integral i) =>
s -> i -> StringCellChar s
genericIndex (i -> s -> StringCellChar s) -> i -> s -> StringCellChar s
forall a b. (a -> b) -> a -> b
$ i -> i
forall a. Enum a => a -> a
pred i
n) (s -> StringCellChar s) -> (s -> s) -> s -> StringCellChar s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
forall s. StringCells s => s -> s
tail (s -> StringCellChar s) -> s -> StringCellChar s
forall a b. (a -> b) -> a -> b
$ s
s

    take        Int
n s
s = Int64 -> s -> s
forall s. StringCells s => Int64 -> s -> s
take64      (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) s
s
    take64      Int64
n s
s = Integer -> s -> s
forall i. Integral i => i -> s -> s
forall s i. (StringCells s, Integral i) => i -> s -> s
genericTake (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n  :: Integer) s
s
    genericTake i
n s
s = Int -> s -> s
forall s. StringCells s => Int -> s -> s
take        (i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n) s
s
    drop        Int
n s
s = Int64 -> s -> s
forall s. StringCells s => Int64 -> s -> s
drop64      (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) s
s
    drop64      Int64
n s
s = Integer -> s -> s
forall i. Integral i => i -> s -> s
forall s i. (StringCells s, Integral i) => i -> s -> s
genericDrop (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n  :: Integer) s
s
    genericDrop i
n s
s = Int -> s -> s
forall s. StringCells s => Int -> s -> s
drop        (i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n) s
s

    length        = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (s -> Int64) -> s -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Int64
forall s. StringCells s => s -> Int64
length64
    length64      = (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Integer -> Int64) (Integer -> Int64) -> (s -> Integer) -> s -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Integer
forall i. Integral i => s -> i
forall s i. (StringCells s, Integral i) => s -> i
genericLength
    genericLength = Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> i) -> (s -> Int) -> s -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Int
forall s. StringCells s => s -> Int
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
s = (s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
head s
s, s -> s
forall s. StringCells s => s -> s
tail s
s)
    unsnoc s
s = (s -> s
forall s. StringCells s => s -> s
init s
s, s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
last s
s)

    cons2 StringCellChar s
a StringCellChar s
b s
s = StringCellChar s
a StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
`cons` StringCellChar s
b StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
`cons` s
s
    cons3 StringCellChar s
a StringCellChar s
b StringCellChar s
c s
s = StringCellChar s
a StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
`cons` StringCellChar s
b StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
`cons` StringCellChar s
c StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
`cons` s
s
    cons4 StringCellChar s
a StringCellChar s
b StringCellChar s
c StringCellChar s
d s
s = StringCellChar s
a StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
`cons` StringCellChar s
b StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
`cons` StringCellChar s
c StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
`cons` StringCellChar s
d StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
`cons` s
s
    uncons2 s
s       =
        let (StringCellChar s
a, s
s')   = s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
s
            (StringCellChar s
b, s
s'')  = s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
s'
        in  (StringCellChar s
a, StringCellChar s
b, s
s'')
    uncons3 s
s       =
        let (StringCellChar s
a, s
s')   = s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
s
            (StringCellChar s
b, s
s'')  = s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
s'
            (StringCellChar s
c, s
s''') = s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
s''
        in  (StringCellChar s
a, StringCellChar s
b, StringCellChar s
c, s
s''')
    uncons4 s
s       =
        let (StringCellChar s
a, s
s')    = s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
s
            (StringCellChar s
b, s
s'')   = s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
s'
            (StringCellChar s
c, s
s''')  = s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
s''
            (StringCellChar s
d, s
s'''') = s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
s'''
        in  (StringCellChar s
a, StringCellChar s
b, StringCellChar s
c, StringCellChar s
d, s
s'''')

    safeUncons s
s
        | s -> Bool
forall s. StringCells s => s -> Bool
null s
s    = Maybe (StringCellChar s, s)
forall a. Maybe a
Nothing
        | Bool
otherwise = (StringCellChar s, s) -> Maybe (StringCellChar s, s)
forall a. a -> Maybe a
Just ((StringCellChar s, s) -> Maybe (StringCellChar s, s))
-> (StringCellChar s, s) -> Maybe (StringCellChar s, s)
forall a b. (a -> b) -> a -> b
$ s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
s
    safeUnsnoc s
s
        | s -> Bool
forall s. StringCells s => s -> Bool
null s
s    = Maybe (s, StringCellChar s)
forall a. Maybe a
Nothing
        | Bool
otherwise = (s, StringCellChar s) -> Maybe (s, StringCellChar s)
forall a. a -> Maybe a
Just ((s, StringCellChar s) -> Maybe (s, StringCellChar s))
-> (s, StringCellChar s) -> Maybe (s, StringCellChar s)
forall a b. (a -> b) -> a -> b
$ s -> (s, StringCellChar s)
forall s. StringCells s => s -> (s, StringCellChar s)
unsnoc s
s
    safeAltUncons s
s
        | s -> Bool
forall s. StringCells s => s -> Bool
null s
s    = Maybe (StringCellAltChar s, s)
forall a. Maybe a
Nothing
        | Bool
otherwise = (StringCellAltChar s, s) -> Maybe (StringCellAltChar s, s)
forall a. a -> Maybe a
Just ((StringCellAltChar s, s) -> Maybe (StringCellAltChar s, s))
-> (StringCellAltChar s, s) -> Maybe (StringCellAltChar s, s)
forall a b. (a -> b) -> a -> b
$ s -> (StringCellAltChar s, s)
forall s. StringCells s => s -> (StringCellAltChar s, s)
altUncons s
s
    safeAltUnsnoc s
s
        | s -> Bool
forall s. StringCells s => s -> Bool
null s
s    = Maybe (s, StringCellAltChar s)
forall a. Maybe a
Nothing
        | Bool
otherwise = (s, StringCellAltChar s) -> Maybe (s, StringCellAltChar s)
forall a. a -> Maybe a
Just ((s, StringCellAltChar s) -> Maybe (s, StringCellAltChar s))
-> (s, StringCellAltChar s) -> Maybe (s, StringCellAltChar s)
forall a b. (a -> b) -> a -> b
$ s -> (s, StringCellAltChar s)
forall s. StringCells s => s -> (s, StringCellAltChar s)
altUnsnoc s
s
    safeHead s
s
        | s -> Bool
forall s. StringCells s => s -> Bool
null s
s    = Maybe (StringCellChar s)
forall a. Maybe a
Nothing
        | Bool
otherwise = StringCellChar s -> Maybe (StringCellChar s)
forall a. a -> Maybe a
Just (StringCellChar s -> Maybe (StringCellChar s))
-> StringCellChar s -> Maybe (StringCellChar s)
forall a b. (a -> b) -> a -> b
$ s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
head s
s
    safeTail s
s
        | s -> Bool
forall s. StringCells s => s -> Bool
null s
s    = Maybe s
forall a. Maybe a
Nothing
        | Bool
otherwise = s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ s -> s
forall s. StringCells s => s -> s
tail s
s
    safeLast s
s
        | s -> Bool
forall s. StringCells s => s -> Bool
null s
s    = Maybe (StringCellChar s)
forall a. Maybe a
Nothing
        | Bool
otherwise = StringCellChar s -> Maybe (StringCellChar s)
forall a. a -> Maybe a
Just (StringCellChar s -> Maybe (StringCellChar s))
-> StringCellChar s -> Maybe (StringCellChar s)
forall a b. (a -> b) -> a -> b
$ s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
last s
s
    safeInit s
s
        | s -> Bool
forall s. StringCells s => s -> Bool
null s
s    = Maybe s
forall a. Maybe a
Nothing
        | Bool
otherwise = s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ s -> s
forall s. StringCells s => s -> s
init s
s
    safeAltHead s
s
        | s -> Bool
forall s. StringCells s => s -> Bool
null s
s    = Maybe (StringCellAltChar s)
forall a. Maybe a
Nothing
        | Bool
otherwise = StringCellAltChar s -> Maybe (StringCellAltChar s)
forall a. a -> Maybe a
Just (StringCellAltChar s -> Maybe (StringCellAltChar s))
-> StringCellAltChar s -> Maybe (StringCellAltChar s)
forall a b. (a -> b) -> a -> b
$ s -> StringCellAltChar s
forall s. StringCells s => s -> StringCellAltChar s
altHead s
s
    safeAltLast s
s
        | s -> Bool
forall s. StringCells s => s -> Bool
null s
s    = Maybe (StringCellAltChar s)
forall a. Maybe a
Nothing
        | Bool
otherwise = StringCellAltChar s -> Maybe (StringCellAltChar s)
forall a. a -> Maybe a
Just (StringCellAltChar s -> Maybe (StringCellAltChar s))
-> StringCellAltChar s -> Maybe (StringCellAltChar s)
forall a b. (a -> b) -> a -> b
$ s -> StringCellAltChar s
forall s. StringCells s => s -> StringCellAltChar s
altLast s
s
    safeIndex s
s Int
n
        | s -> Int
forall s. StringCells s => s -> Int
length s
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = Maybe (StringCellChar s)
forall a. Maybe a
Nothing
        | Bool
otherwise     = StringCellChar s -> Maybe (StringCellChar s)
forall a. a -> Maybe a
Just (StringCellChar s -> Maybe (StringCellChar s))
-> StringCellChar s -> Maybe (StringCellChar s)
forall a b. (a -> b) -> a -> b
$ s
s s -> Int -> StringCellChar s
forall s. StringCells s => s -> Int -> StringCellChar s
`index` Int
n
    safeIndex64 s
s Int64
n
        | s -> Int64
forall s. StringCells s => s -> Int64
length64 s
s Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
n = Maybe (StringCellChar s)
forall a. Maybe a
Nothing
        | Bool
otherwise     = StringCellChar s -> Maybe (StringCellChar s)
forall a. a -> Maybe a
Just (StringCellChar s -> Maybe (StringCellChar s))
-> StringCellChar s -> Maybe (StringCellChar s)
forall a b. (a -> b) -> a -> b
$ s
s s -> Int64 -> StringCellChar s
forall s. StringCells s => s -> Int64 -> StringCellChar s
`index64` Int64
n
    safeGenericIndex s
s i
n
        | s -> i
forall i. Integral i => s -> i
forall s i. (StringCells s, Integral i) => s -> i
genericLength s
s i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
n = Maybe (StringCellChar s)
forall a. Maybe a
Nothing
        | Bool
otherwise            = StringCellChar s -> Maybe (StringCellChar s)
forall a. a -> Maybe a
Just (StringCellChar s -> Maybe (StringCellChar s))
-> StringCellChar s -> Maybe (StringCellChar s)
forall a b. (a -> b) -> a -> b
$ s
s s -> i -> StringCellChar s
forall i. Integral i => s -> i -> StringCellChar s
forall s i.
(StringCells s, Integral i) =>
s -> i -> StringCellChar s
`genericIndex` i
n
    safeTake Int
n s
s
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> s -> Int
forall s. StringCells s => s -> Int
length s
s = Maybe s
forall a. Maybe a
Nothing
        | Bool
otherwise    = s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ Int -> s -> s
forall s. StringCells s => Int -> s -> s
take Int
n s
s
    safeTake64 Int64
n s
s
        | Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> s -> Int64
forall s. StringCells s => s -> Int64
length64 s
s = Maybe s
forall a. Maybe a
Nothing
        | Bool
otherwise      = s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ Int64 -> s -> s
forall s. StringCells s => Int64 -> s -> s
take64 Int64
n s
s
    safeGenericTake i
n s
s
        | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> s -> i
forall i. Integral i => s -> i
forall s i. (StringCells s, Integral i) => s -> i
genericLength s
s = Maybe s
forall a. Maybe a
Nothing
        | Bool
otherwise           = s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ i -> s -> s
forall i. Integral i => i -> s -> s
forall s i. (StringCells s, Integral i) => i -> s -> s
genericTake i
n s
s
    safeDrop Int
n s
s
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> s -> Int
forall s. StringCells s => s -> Int
length s
s = Maybe s
forall a. Maybe a
Nothing
        | Bool
otherwise    = s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ Int -> s -> s
forall s. StringCells s => Int -> s -> s
drop Int
n s
s
    safeDrop64 Int64
n s
s
        | Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> s -> Int64
forall s. StringCells s => s -> Int64
length64 s
s = Maybe s
forall a. Maybe a
Nothing
        | Bool
otherwise      = s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ Int64 -> s -> s
forall s. StringCells s => Int64 -> s -> s
drop64 Int64
n s
s
    safeGenericDrop i
n s
s
        | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> s -> i
forall i. Integral i => s -> i
forall s i. (StringCells s, Integral i) => s -> i
genericLength s
s = Maybe s
forall a. Maybe a
Nothing
        | Bool
otherwise           = s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ i -> s -> s
forall i. Integral i => i -> s -> s
forall s i. (StringCells s, Integral i) => i -> s -> s
genericDrop i
n s
s
    safeUncons2 s
s = do
        (StringCellChar s
a, s
s')    <- s -> Maybe (StringCellChar s, s)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons s
s
        (StringCellChar s
b, s
s'')   <- s -> Maybe (StringCellChar s, s)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons s
s'
        (StringCellChar s, StringCellChar s, s)
-> Maybe (StringCellChar s, StringCellChar s, s)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (StringCellChar s
a, StringCellChar s
b, s
s'')
    safeUncons3 s
s = do
        (StringCellChar s
a, s
s')    <- s -> Maybe (StringCellChar s, s)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons s
s
        (StringCellChar s
b, s
s'')   <- s -> Maybe (StringCellChar s, s)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons s
s'
        (StringCellChar s
c, s
s''')  <- s -> Maybe (StringCellChar s, s)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons s
s''
        (StringCellChar s, StringCellChar s, StringCellChar s, s)
-> Maybe (StringCellChar s, StringCellChar s, StringCellChar s, s)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (StringCellChar s
a, StringCellChar s
b, StringCellChar s
c, s
s''')
    safeUncons4 s
s = do
        (StringCellChar s
a, s
s')    <- s -> Maybe (StringCellChar s, s)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons s
s
        (StringCellChar s
b, s
s'')   <- s -> Maybe (StringCellChar s, s)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons s
s'
        (StringCellChar s
c, s
s''')  <- s -> Maybe (StringCellChar s, s)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons s
s''
        (StringCellChar s
d, s
s'''') <- s -> Maybe (StringCellChar s, s)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons s
s'''
        (StringCellChar s, StringCellChar s, StringCellChar s,
 StringCellChar s, s)
-> Maybe
     (StringCellChar s, StringCellChar s, StringCellChar s,
      StringCellChar s, s)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (StringCellChar s
a, StringCellChar s
b, StringCellChar s
c, StringCellChar s
d, s
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 s -> s
f = s -> IO ()
forall s. StringRWIO s => s -> IO ()
putStr (s -> IO ()) -> (s -> s) -> s -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f (s -> IO ()) -> IO s -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO s
forall s. StringRWIO s => IO s
getContents

    -- | Read all user input on 'stdin' as a single string
    getContents :: IO s
    getContents = Handle -> IO s
forall s. StringRWIO s => Handle -> IO s
hGetContents Handle
IO.stdin

    -- | Read a single line of user input from 'stdin'
    getLine :: IO s
    getLine = Handle -> IO s
forall s. StringRWIO s => Handle -> IO s
hGetLine Handle
IO.stdin

    -- | Write a string to 'stdout'
    putStr :: s -> IO ()
    putStr = Handle -> s -> IO ()
forall s. StringRWIO s => Handle -> s -> IO ()
hPutStr Handle
IO.stdout

    -- | Write a string to 'stdout', followed by a newline
    putStrLn :: s -> IO ()
    putStrLn = Handle -> s -> IO ()
forall s. StringRWIO s => Handle -> s -> IO ()
hPutStrLn Handle
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 FilePath
fn = Handle -> IO s
forall s. StringRWIO s => Handle -> IO s
hGetContents (Handle -> IO s) -> IO Handle -> IO s
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IOMode -> IO Handle
IO.openFile FilePath
fn IOMode
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 FilePath
fn s
s = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile FilePath
fn IOMode
IO.WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
hdl -> Handle -> s -> IO ()
forall s. StringRWIO s => Handle -> s -> IO ()
hPutStr Handle
hdl s
s

    -- | Write a string to the end of a file
    --
    -- The default definition uses 'withFile' to open the file.
    appendFile :: FilePath -> s -> IO ()
    appendFile FilePath
fn s
s = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile FilePath
fn IOMode
IO.AppendMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
hdl -> Handle -> s -> IO ()
forall s. StringRWIO s => Handle -> s -> IO ()
hPutStr Handle
hdl s
s



instance StringCells String where
    type StringCellChar    String = Char
    type StringCellAltChar String = Char

    toStringCells :: forall s2. StringCells s2 => FilePath -> s2
toStringCells   = FilePath -> s2
forall s. ConvString s => FilePath -> s
fromString
    fromStringCells :: forall s2. StringCells s2 => s2 -> FilePath
fromStringCells = s2 -> FilePath
forall s. ConvString s => s -> FilePath
toString

    length :: FilePath -> Int
length = FilePath -> Int
forall i a. Num i => [a] -> i
List.genericLength
    empty :: FilePath
empty  = []
    null :: FilePath -> Bool
null   = FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null
    cons :: StringCellChar FilePath -> FilePath -> FilePath
cons          = (:)
    snoc :: FilePath -> StringCellChar FilePath -> FilePath
snoc FilePath
s StringCellChar FilePath
c      = FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
StringCellChar FilePath
c]
    safeUncons :: FilePath -> Maybe (StringCellChar FilePath, FilePath)
safeUncons (Char
x:FilePath
xs) = (Char, FilePath) -> Maybe (Char, FilePath)
forall a. a -> Maybe a
Just (Char
x, FilePath
xs)
    safeUncons FilePath
_      = Maybe (Char, FilePath)
Maybe (StringCellChar FilePath, FilePath)
forall a. Maybe a
Nothing
    uncons :: FilePath -> (StringCellChar FilePath, FilePath)
uncons (Char
x:FilePath
xs) = (Char
StringCellChar FilePath
x, FilePath
xs)
    uncons FilePath
_      = FilePath -> (Char, FilePath)
forall a. HasCallStack => FilePath -> a
error FilePath
"String.uncons: null string"
    toMainChar :: forall c.
StringCell c =>
c -> Tagged FilePath (StringCellChar FilePath)
toMainChar    = Char -> Tagged FilePath Char
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Char -> Tagged FilePath Char)
-> (c -> Char) -> c -> Tagged FilePath Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Char
forall c. StringCell c => c -> Char
toChar
    toAltChar :: forall c.
StringCell c =>
c -> Tagged FilePath (StringCellAltChar FilePath)
toAltChar     = Char -> Tagged FilePath Char
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Char -> Tagged FilePath Char)
-> (c -> Char) -> c -> Tagged FilePath Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Char
forall c. StringCell c => c -> Char
toChar
    head :: FilePath -> StringCellChar FilePath
head          = FilePath -> Char
FilePath -> StringCellChar FilePath
forall a. HasCallStack => [a] -> a
List.head
    tail :: FilePath -> FilePath
tail          = FilePath -> FilePath
forall a. HasCallStack => [a] -> [a]
List.tail
    init :: FilePath -> FilePath
init          = FilePath -> FilePath
forall a. HasCallStack => [a] -> [a]
List.init
    last :: FilePath -> StringCellChar FilePath
last          = FilePath -> Char
FilePath -> StringCellChar FilePath
forall a. HasCallStack => [a] -> a
List.last
    unfoldr :: forall a.
(a -> Maybe (StringCellChar FilePath, a)) -> a -> FilePath
unfoldr       = (a -> Maybe (Char, a)) -> a -> FilePath
(a -> Maybe (StringCellChar FilePath, a)) -> a -> FilePath
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr
    index :: FilePath -> Int -> StringCellChar FilePath
index         = FilePath -> Int -> Char
FilePath -> Int -> StringCellChar FilePath
forall a. HasCallStack => [a] -> Int -> a
(List.!!)
    index64 :: FilePath -> Int64 -> StringCellChar FilePath
index64 FilePath
s     = FilePath -> Int -> StringCellChar FilePath
forall s. StringCells s => s -> Int -> StringCellChar s
index FilePath
s (Int -> Char) -> (Int64 -> Int) -> Int64 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    genericIndex :: forall i. Integral i => FilePath -> i -> StringCellChar FilePath
genericIndex  = FilePath -> i -> Char
FilePath -> i -> StringCellChar FilePath
forall i a. Integral i => [a] -> i -> a
List.genericIndex
    take :: Int -> FilePath -> FilePath
take          = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
List.take
    genericTake :: forall i. Integral i => i -> FilePath -> FilePath
genericTake   = i -> FilePath -> FilePath
forall i a. Integral i => i -> [a] -> [a]
List.genericTake
    drop :: Int -> FilePath -> FilePath
drop          = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
List.drop
    genericDrop :: forall i. Integral i => i -> FilePath -> FilePath
genericDrop   = i -> FilePath -> FilePath
forall i a. Integral i => i -> [a] -> [a]
List.genericDrop
    append :: FilePath -> FilePath -> FilePath
append        = FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
(List.++)
    concat :: [FilePath] -> FilePath
concat        = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat

instance StringCells S.ByteString where
    type StringCellChar    S.ByteString = Word8
    type StringCellAltChar S.ByteString = Char

    toStringCells :: forall s2. StringCells s2 => ByteString -> s2
toStringCells   = ByteString -> s2
forall s. ConvStrictByteString s => ByteString -> s
fromStrictByteString
    fromStringCells :: forall s2. StringCells s2 => s2 -> ByteString
fromStringCells = s2 -> ByteString
forall s. ConvStrictByteString s => s -> ByteString
toStrictByteString

    length :: ByteString -> Int
length          = ByteString -> Int
S.length
    empty :: ByteString
empty           = ByteString
S.empty
    null :: ByteString -> Bool
null            = ByteString -> Bool
S.null
    cons :: StringCellChar ByteString -> ByteString -> ByteString
cons            = Word8 -> ByteString -> ByteString
StringCellChar ByteString -> ByteString -> ByteString
S.cons
    snoc :: ByteString -> StringCellChar ByteString -> ByteString
snoc            = ByteString -> Word8 -> ByteString
ByteString -> StringCellChar ByteString -> ByteString
S.snoc
    safeUncons :: ByteString -> Maybe (StringCellChar ByteString, ByteString)
safeUncons      = ByteString -> Maybe (Word8, ByteString)
ByteString -> Maybe (StringCellChar ByteString, ByteString)
S.uncons
    uncons :: ByteString -> (StringCellChar ByteString, ByteString)
uncons          = (Word8, ByteString)
-> ((Word8, ByteString) -> (Word8, ByteString))
-> Maybe (Word8, ByteString)
-> (Word8, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> (Word8, ByteString)
forall a. HasCallStack => FilePath -> a
error FilePath
"StringCells.Data.ByteString.ByteString.uncons: string is null") (Word8, ByteString) -> (Word8, ByteString)
forall a. a -> a
id (Maybe (Word8, ByteString) -> (Word8, ByteString))
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> (Word8, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Word8, ByteString)
ByteString -> Maybe (StringCellChar ByteString, ByteString)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons
    toMainChar :: forall c.
StringCell c =>
c -> Tagged ByteString (StringCellChar ByteString)
toMainChar      = Word8 -> Tagged ByteString Word8
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Word8 -> Tagged ByteString Word8)
-> (c -> Word8) -> c -> Tagged ByteString Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Word8
forall c. StringCell c => c -> Word8
toWord8
    toAltChar :: forall c.
StringCell c =>
c -> Tagged ByteString (StringCellAltChar ByteString)
toAltChar       = Char -> Tagged ByteString Char
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Char -> Tagged ByteString Char)
-> (c -> Char) -> c -> Tagged ByteString Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Char
forall c. StringCell c => c -> Char
toChar
    head :: ByteString -> StringCellChar ByteString
head            = HasCallStack => ByteString -> Word8
ByteString -> Word8
ByteString -> StringCellChar ByteString
S.head
    tail :: ByteString -> ByteString
tail            = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
S.tail
    init :: ByteString -> ByteString
init            = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
S.init
    last :: ByteString -> StringCellChar ByteString
last            = HasCallStack => ByteString -> Word8
ByteString -> Word8
ByteString -> StringCellChar ByteString
S.last
    unfoldr :: forall a.
(a -> Maybe (StringCellChar ByteString, a)) -> a -> ByteString
unfoldr         = (a -> Maybe (Word8, a)) -> a -> ByteString
(a -> Maybe (StringCellChar ByteString, a)) -> a -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
S.unfoldr
    altUnfoldr :: forall a.
(a -> Maybe (StringCellAltChar ByteString, a)) -> a -> ByteString
altUnfoldr      = (a -> Maybe (Char, a)) -> a -> ByteString
(a -> Maybe (StringCellAltChar ByteString, a)) -> a -> ByteString
forall a. (a -> Maybe (Char, a)) -> a -> ByteString
SC.unfoldr
    unfoldrN :: forall a.
Int
-> (a -> Maybe (StringCellChar ByteString, a)) -> a -> ByteString
unfoldrN        = (((ByteString, Maybe a) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe a) -> ByteString)
-> (a -> (ByteString, Maybe a)) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> (ByteString, Maybe a)) -> a -> ByteString)
-> ((a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a))
-> (a -> Maybe (Word8, a))
-> a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (((a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a))
 -> (a -> Maybe (Word8, a)) -> a -> ByteString)
-> (Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a))
-> Int
-> (a -> Maybe (Word8, a))
-> a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
S.unfoldrN
    altUnfoldrN :: forall a.
Int
-> (a -> Maybe (StringCellAltChar ByteString, a))
-> a
-> ByteString
altUnfoldrN     = (((ByteString, Maybe a) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe a) -> ByteString)
-> (a -> (ByteString, Maybe a)) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> (ByteString, Maybe a)) -> a -> ByteString)
-> ((a -> Maybe (Char, a)) -> a -> (ByteString, Maybe a))
-> (a -> Maybe (Char, a))
-> a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (((a -> Maybe (Char, a)) -> a -> (ByteString, Maybe a))
 -> (a -> Maybe (Char, a)) -> a -> ByteString)
-> (Int -> (a -> Maybe (Char, a)) -> a -> (ByteString, Maybe a))
-> Int
-> (a -> Maybe (Char, a))
-> a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (a -> Maybe (Char, a)) -> a -> (ByteString, Maybe a)
forall a.
Int -> (a -> Maybe (Char, a)) -> a -> (ByteString, Maybe a)
SC.unfoldrN
    index :: ByteString -> Int -> StringCellChar ByteString
index           = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
ByteString -> Int -> StringCellChar ByteString
S.index
    index64 :: ByteString -> Int64 -> StringCellChar ByteString
index64 ByteString
s       = ByteString -> Int -> StringCellChar ByteString
forall s. StringCells s => s -> Int -> StringCellChar s
index ByteString
s (Int -> Word8) -> (Int64 -> Int) -> Int64 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    take :: Int -> ByteString -> ByteString
take            = Int -> ByteString -> ByteString
S.take
    drop :: Int -> ByteString -> ByteString
drop            = Int -> ByteString -> ByteString
S.drop
    append :: ByteString -> ByteString -> ByteString
append          = ByteString -> ByteString -> ByteString
S.append
    concat :: [ByteString] -> ByteString
concat          = [ByteString] -> ByteString
S.concat

instance StringCells L.ByteString where
    type StringCellChar    L.ByteString = Word8
    type StringCellAltChar L.ByteString = Char

    toStringCells :: forall s2. StringCells s2 => GenStringDefault -> s2
toStringCells   = GenStringDefault -> s2
forall s. ConvLazyByteString s => GenStringDefault -> s
fromLazyByteString
    fromStringCells :: forall s2. StringCells s2 => s2 -> GenStringDefault
fromStringCells = s2 -> GenStringDefault
forall s. ConvLazyByteString s => s -> GenStringDefault
toLazyByteString

    length64 :: GenStringDefault -> Int64
length64        = GenStringDefault -> Int64
L.length
    length :: GenStringDefault -> Int
length          = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int)
-> (GenStringDefault -> Int64) -> GenStringDefault -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenStringDefault -> Int64
forall s. StringCells s => s -> Int64
length64
    empty :: GenStringDefault
empty           = GenStringDefault
L.empty
    null :: GenStringDefault -> Bool
null            = GenStringDefault -> Bool
L.null
    cons :: StringCellChar GenStringDefault
-> GenStringDefault -> GenStringDefault
cons            = Word8 -> GenStringDefault -> GenStringDefault
StringCellChar GenStringDefault
-> GenStringDefault -> GenStringDefault
L.cons
    snoc :: GenStringDefault
-> StringCellChar GenStringDefault -> GenStringDefault
snoc            = GenStringDefault -> Word8 -> GenStringDefault
GenStringDefault
-> StringCellChar GenStringDefault -> GenStringDefault
L.snoc
    safeUncons :: GenStringDefault
-> Maybe (StringCellChar GenStringDefault, GenStringDefault)
safeUncons      = GenStringDefault -> Maybe (Word8, GenStringDefault)
GenStringDefault
-> Maybe (StringCellChar GenStringDefault, GenStringDefault)
L.uncons
    uncons :: GenStringDefault
-> (StringCellChar GenStringDefault, GenStringDefault)
uncons          = (Word8, GenStringDefault)
-> ((Word8, GenStringDefault) -> (Word8, GenStringDefault))
-> Maybe (Word8, GenStringDefault)
-> (Word8, GenStringDefault)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> (Word8, GenStringDefault)
forall a. HasCallStack => FilePath -> a
error FilePath
"StringCells.Data.ByteString.Lazy.ByteString.uncons: string is null") (Word8, GenStringDefault) -> (Word8, GenStringDefault)
forall a. a -> a
id (Maybe (Word8, GenStringDefault) -> (Word8, GenStringDefault))
-> (GenStringDefault -> Maybe (Word8, GenStringDefault))
-> GenStringDefault
-> (Word8, GenStringDefault)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenStringDefault -> Maybe (Word8, GenStringDefault)
GenStringDefault
-> Maybe (StringCellChar GenStringDefault, GenStringDefault)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons
    toMainChar :: forall c.
StringCell c =>
c -> Tagged GenStringDefault (StringCellChar GenStringDefault)
toMainChar      = Word8 -> Tagged GenStringDefault Word8
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Word8 -> Tagged GenStringDefault Word8)
-> (c -> Word8) -> c -> Tagged GenStringDefault Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Word8
forall c. StringCell c => c -> Word8
toWord8
    toAltChar :: forall c.
StringCell c =>
c -> Tagged GenStringDefault (StringCellAltChar GenStringDefault)
toAltChar       = Char -> Tagged GenStringDefault Char
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Char -> Tagged GenStringDefault Char)
-> (c -> Char) -> c -> Tagged GenStringDefault Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Char
forall c. StringCell c => c -> Char
toChar
    head :: GenStringDefault -> StringCellChar GenStringDefault
head            = HasCallStack => GenStringDefault -> Word8
GenStringDefault -> Word8
GenStringDefault -> StringCellChar GenStringDefault
L.head
    tail :: GenStringDefault -> GenStringDefault
tail            = HasCallStack => GenStringDefault -> GenStringDefault
GenStringDefault -> GenStringDefault
L.tail
    init :: GenStringDefault -> GenStringDefault
init            = HasCallStack => GenStringDefault -> GenStringDefault
GenStringDefault -> GenStringDefault
L.init
    last :: GenStringDefault -> StringCellChar GenStringDefault
last            = HasCallStack => GenStringDefault -> Word8
GenStringDefault -> Word8
GenStringDefault -> StringCellChar GenStringDefault
L.last
    unfoldr :: forall a.
(a -> Maybe (StringCellChar GenStringDefault, a))
-> a -> GenStringDefault
unfoldr         = (a -> Maybe (Word8, a)) -> a -> GenStringDefault
(a -> Maybe (StringCellChar GenStringDefault, a))
-> a -> GenStringDefault
forall a. (a -> Maybe (Word8, a)) -> a -> GenStringDefault
L.unfoldr
    altUnfoldr :: forall a.
(a -> Maybe (StringCellAltChar GenStringDefault, a))
-> a -> GenStringDefault
altUnfoldr      = (a -> Maybe (Char, a)) -> a -> GenStringDefault
(a -> Maybe (StringCellAltChar GenStringDefault, a))
-> a -> GenStringDefault
forall a. (a -> Maybe (Char, a)) -> a -> GenStringDefault
LC.unfoldr
    index :: GenStringDefault -> Int -> StringCellChar GenStringDefault
index GenStringDefault
s         = GenStringDefault -> Int64 -> StringCellChar GenStringDefault
forall s. StringCells s => s -> Int64 -> StringCellChar s
index64 GenStringDefault
s (Int64 -> Word8) -> (Int -> Int64) -> Int -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    index64 :: GenStringDefault -> Int64 -> StringCellChar GenStringDefault
index64         = HasCallStack => GenStringDefault -> Int64 -> Word8
GenStringDefault -> Int64 -> Word8
GenStringDefault -> Int64 -> StringCellChar GenStringDefault
L.index
    take64 :: Int64 -> GenStringDefault -> GenStringDefault
take64          = Int64 -> GenStringDefault -> GenStringDefault
L.take
    drop64 :: Int64 -> GenStringDefault -> GenStringDefault
drop64          = Int64 -> GenStringDefault -> GenStringDefault
L.drop
    append :: GenStringDefault -> GenStringDefault -> GenStringDefault
append          = GenStringDefault -> GenStringDefault -> GenStringDefault
L.append
    concat :: [GenStringDefault] -> GenStringDefault
concat          = [GenStringDefault] -> GenStringDefault
L.concat

instance StringCells T.Text where
    type StringCellChar    T.Text = Char
    type StringCellAltChar T.Text = Char

    toStringCells :: forall s2. StringCells s2 => Text -> s2
toStringCells   = Text -> s2
forall s. ConvText s => Text -> s
fromText
    fromStringCells :: forall s2. StringCells s2 => s2 -> Text
fromStringCells = s2 -> Text
forall s. ConvText s => s -> Text
toText

    length :: Text -> Int
length          = Text -> Int
T.length
    empty :: Text
empty           = Text
T.empty
    null :: Text -> Bool
null            = Text -> Bool
T.null
    cons :: StringCellChar Text -> Text -> Text
cons            = Char -> Text -> Text
StringCellChar Text -> Text -> Text
T.cons
    safeUncons :: Text -> Maybe (StringCellChar Text, Text)
safeUncons      = Text -> Maybe (Char, Text)
Text -> Maybe (StringCellChar Text, Text)
T.uncons
    uncons :: Text -> (StringCellChar Text, Text)
uncons          = (Char, Text)
-> ((Char, Text) -> (Char, Text))
-> Maybe (Char, Text)
-> (Char, Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> (Char, Text)
forall a. HasCallStack => FilePath -> a
error FilePath
"StringCells.Data.Text.Text.uncons: string is null") (Char, Text) -> (Char, Text)
forall a. a -> a
id (Maybe (Char, Text) -> (Char, Text))
-> (Text -> Maybe (Char, Text)) -> Text -> (Char, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
Text -> Maybe (StringCellChar Text, Text)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons
    snoc :: Text -> StringCellChar Text -> Text
snoc            = Text -> Char -> Text
Text -> StringCellChar Text -> Text
T.snoc
    altSnoc :: Text -> StringCellAltChar Text -> Text
altSnoc         = Text -> Char -> Text
Text -> StringCellAltChar Text -> Text
T.snoc
    toMainChar :: forall c. StringCell c => c -> Tagged Text (StringCellChar Text)
toMainChar      = Char -> Tagged Text Char
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Char -> Tagged Text Char) -> (c -> Char) -> c -> Tagged Text Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Char
forall c. StringCell c => c -> Char
toChar
    toAltChar :: forall c. StringCell c => c -> Tagged Text (StringCellAltChar Text)
toAltChar       = Char -> Tagged Text Char
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Char -> Tagged Text Char) -> (c -> Char) -> c -> Tagged Text Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Char
forall c. StringCell c => c -> Char
toChar
    head :: Text -> StringCellChar Text
head            = HasCallStack => Text -> Char
Text -> Char
Text -> StringCellChar Text
T.head
    tail :: Text -> Text
tail            = HasCallStack => Text -> Text
Text -> Text
T.tail
    init :: Text -> Text
init            = HasCallStack => Text -> Text
Text -> Text
T.init
    last :: Text -> StringCellChar Text
last            = HasCallStack => Text -> Char
Text -> Char
Text -> StringCellChar Text
T.last
    unfoldr :: forall a. (a -> Maybe (StringCellChar Text, a)) -> a -> Text
unfoldr         = (a -> Maybe (Char, a)) -> a -> Text
(a -> Maybe (StringCellChar Text, a)) -> a -> Text
forall a. (a -> Maybe (Char, a)) -> a -> Text
T.unfoldr
    altUnfoldr :: forall a. (a -> Maybe (StringCellAltChar Text, a)) -> a -> Text
altUnfoldr      = (a -> Maybe (Char, a)) -> a -> Text
(a -> Maybe (StringCellAltChar Text, a)) -> a -> Text
forall a. (a -> Maybe (Char, a)) -> a -> Text
T.unfoldr
    unfoldrN :: forall a. Int -> (a -> Maybe (StringCellChar Text, a)) -> a -> Text
unfoldrN        = Int -> (a -> Maybe (Char, a)) -> a -> Text
Int -> (a -> Maybe (StringCellChar Text, a)) -> a -> Text
forall a. Int -> (a -> Maybe (Char, a)) -> a -> Text
T.unfoldrN
    altUnfoldrN :: forall a.
Int -> (a -> Maybe (StringCellAltChar Text, a)) -> a -> Text
altUnfoldrN     = Int -> (a -> Maybe (Char, a)) -> a -> Text
Int -> (a -> Maybe (StringCellAltChar Text, a)) -> a -> Text
forall a. Int -> (a -> Maybe (Char, a)) -> a -> Text
T.unfoldrN
    index :: Text -> Int -> StringCellChar Text
index           = HasCallStack => Text -> Int -> Char
Text -> Int -> Char
Text -> Int -> StringCellChar Text
T.index
    index64 :: Text -> Int64 -> StringCellChar Text
index64 Text
s       = Text -> Int -> StringCellChar Text
forall s. StringCells s => s -> Int -> StringCellChar s
index Text
s (Int -> Char) -> (Int64 -> Int) -> Int64 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    append :: Text -> Text -> Text
append          = Text -> Text -> Text
T.append
    concat :: [Text] -> Text
concat          = [Text] -> Text
T.concat

instance StringCells LT.Text where
    type StringCellChar    LT.Text = Char
    type StringCellAltChar LT.Text = Char

    toStringCells :: forall s2. StringCells s2 => Text -> s2
toStringCells   = Text -> s2
forall s. ConvLazyText s => Text -> s
fromLazyText
    fromStringCells :: forall s2. StringCells s2 => s2 -> Text
fromStringCells = s2 -> Text
forall s. ConvLazyText s => s -> Text
toLazyText

    length64 :: Text -> Int64
length64        = Text -> Int64
LT.length
    empty :: Text
empty           = Text
LT.empty
    null :: Text -> Bool
null            = Text -> Bool
LT.null
    cons :: StringCellChar Text -> Text -> Text
cons            = Char -> Text -> Text
StringCellChar Text -> Text -> Text
LT.cons
    safeUncons :: Text -> Maybe (StringCellChar Text, Text)
safeUncons      = Text -> Maybe (Char, Text)
Text -> Maybe (StringCellChar Text, Text)
LT.uncons
    uncons :: Text -> (StringCellChar Text, Text)
uncons          = (Char, Text)
-> ((Char, Text) -> (Char, Text))
-> Maybe (Char, Text)
-> (Char, Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> (Char, Text)
forall a. HasCallStack => FilePath -> a
error FilePath
"StringCells.Data.Text.Lazy.Text.uncons: string is null") (Char, Text) -> (Char, Text)
forall a. a -> a
id (Maybe (Char, Text) -> (Char, Text))
-> (Text -> Maybe (Char, Text)) -> Text -> (Char, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
Text -> Maybe (StringCellChar Text, Text)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons
    snoc :: Text -> StringCellChar Text -> Text
snoc            = Text -> Char -> Text
Text -> StringCellChar Text -> Text
LT.snoc
    altSnoc :: Text -> StringCellAltChar Text -> Text
altSnoc         = Text -> Char -> Text
Text -> StringCellAltChar Text -> Text
LT.snoc
    toMainChar :: forall c. StringCell c => c -> Tagged Text (StringCellChar Text)
toMainChar      = Char -> Tagged Text Char
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Char -> Tagged Text Char) -> (c -> Char) -> c -> Tagged Text Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Char
forall c. StringCell c => c -> Char
toChar
    toAltChar :: forall c. StringCell c => c -> Tagged Text (StringCellAltChar Text)
toAltChar       = Char -> Tagged Text Char
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Char -> Tagged Text Char) -> (c -> Char) -> c -> Tagged Text Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Char
forall c. StringCell c => c -> Char
toChar
    head :: Text -> StringCellChar Text
head            = HasCallStack => Text -> Char
Text -> Char
Text -> StringCellChar Text
LT.head
    tail :: Text -> Text
tail            = HasCallStack => Text -> Text
Text -> Text
LT.tail
    init :: Text -> Text
init            = HasCallStack => Text -> Text
Text -> Text
LT.init
    last :: Text -> StringCellChar Text
last            = HasCallStack => Text -> Char
Text -> Char
Text -> StringCellChar Text
LT.last
    unfoldr :: forall a. (a -> Maybe (StringCellChar Text, a)) -> a -> Text
unfoldr         = (a -> Maybe (Char, a)) -> a -> Text
(a -> Maybe (StringCellChar Text, a)) -> a -> Text
forall a. (a -> Maybe (Char, a)) -> a -> Text
LT.unfoldr
    altUnfoldr :: forall a. (a -> Maybe (StringCellAltChar Text, a)) -> a -> Text
altUnfoldr      = (a -> Maybe (Char, a)) -> a -> Text
(a -> Maybe (StringCellAltChar Text, a)) -> a -> Text
forall a. (a -> Maybe (Char, a)) -> a -> Text
LT.unfoldr
    unfoldrN64 :: forall a.
Int64 -> (a -> Maybe (StringCellChar Text, a)) -> a -> Text
unfoldrN64      = Int64 -> (a -> Maybe (Char, a)) -> a -> Text
Int64 -> (a -> Maybe (StringCellChar Text, a)) -> a -> Text
forall a. Int64 -> (a -> Maybe (Char, a)) -> a -> Text
LT.unfoldrN
    altUnfoldrN64 :: forall a.
Int64 -> (a -> Maybe (StringCellAltChar Text, a)) -> a -> Text
altUnfoldrN64   = Int64 -> (a -> Maybe (Char, a)) -> a -> Text
Int64 -> (a -> Maybe (StringCellAltChar Text, a)) -> a -> Text
forall a. Int64 -> (a -> Maybe (Char, a)) -> a -> Text
LT.unfoldrN
    index :: Text -> Int -> StringCellChar Text
index Text
s         = Text -> Int64 -> StringCellChar Text
forall s. StringCells s => s -> Int64 -> StringCellChar s
index64 Text
s (Int64 -> Char) -> (Int -> Int64) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    index64 :: Text -> Int64 -> StringCellChar Text
index64         = HasCallStack => Text -> Int64 -> Char
Text -> Int64 -> Char
Text -> Int64 -> StringCellChar Text
LT.index
    append :: Text -> Text -> Text
append          = Text -> Text -> Text
LT.append
    concat :: [Text] -> Text
concat          = [Text] -> Text
LT.concat

instance StringCell Char where
    toChar :: Char -> Char
toChar     = Char -> Char
forall a. a -> a
id
    toWord8 :: Char -> Word8
toWord8    = Char -> Word8
BI.c2w
    toWord16 :: Char -> Word16
toWord16   = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16) -> (Char -> Word8) -> Char -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
forall c. StringCell c => c -> Word8
toWord8
    toWord32 :: Char -> Word32
toWord32   = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> (Char -> Word8) -> Char -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
forall c. StringCell c => c -> Word8
toWord8
    toWord64 :: Char -> Word64
toWord64   = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> (Char -> Word8) -> Char -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
forall c. StringCell c => c -> Word8
toWord8
    fromChar :: Char -> Char
fromChar   = Char -> Char
forall a. a -> a
id
    fromWord8 :: Word8 -> Char
fromWord8  = Word8 -> Char
BI.w2c
    fromWord16 :: Word16 -> Char
fromWord16 = Word8 -> Char
BI.w2c (Word8 -> Char) -> (Word16 -> Word8) -> Word16 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromWord32 :: Word32 -> Char
fromWord32 = Word8 -> Char
BI.w2c (Word8 -> Char) -> (Word32 -> Word8) -> Word32 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromWord64 :: Word64 -> Char
fromWord64 = Word8 -> Char
BI.w2c (Word8 -> Char) -> (Word64 -> Word8) -> Word64 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance StringCell Word8 where
    toChar :: Word8 -> Char
toChar     = Word8 -> Char
BI.w2c
    toWord8 :: Word8 -> Word8
toWord8    = Word8 -> Word8
forall a. a -> a
id
    toWord16 :: Word8 -> Word16
toWord16   = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord32 :: Word8 -> Word32
toWord32   = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord64 :: Word8 -> Word64
toWord64   = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromChar :: Char -> Word8
fromChar   = Char -> Word8
BI.c2w
    fromWord8 :: Word8 -> Word8
fromWord8  = Word8 -> Word8
forall a. a -> a
id
    fromWord16 :: Word16 -> Word8
fromWord16 = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromWord32 :: Word32 -> Word8
fromWord32 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromWord64 :: Word64 -> Word8
fromWord64 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance StringCell Word16 where
    toChar :: Word16 -> Char
toChar     = Word8 -> Char
BI.w2c (Word8 -> Char) -> (Word16 -> Word8) -> Word16 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord8 :: Word16 -> Word8
toWord8    = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord16 :: Word16 -> Word16
toWord16   = Word16 -> Word16
forall a. a -> a
id
    toWord32 :: Word16 -> Word32
toWord32   = Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord64 :: Word16 -> Word64
toWord64   = Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromChar :: Char -> Word16
fromChar   = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16) -> (Char -> Word8) -> Char -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
BI.c2w
    fromWord8 :: Word8 -> Word16
fromWord8  = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromWord16 :: Word16 -> Word16
fromWord16 = Word16 -> Word16
forall a. a -> a
id
    fromWord32 :: Word32 -> Word16
fromWord32 = Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromWord64 :: Word64 -> Word16
fromWord64 = Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance StringCell Word32 where
    toChar :: Word32 -> Char
toChar     = Word8 -> Char
BI.w2c (Word8 -> Char) -> (Word32 -> Word8) -> Word32 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord8 :: Word32 -> Word8
toWord8    = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord16 :: Word32 -> Word16
toWord16   = Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord32 :: Word32 -> Word32
toWord32   = Word32 -> Word32
forall a. a -> a
id
    toWord64 :: Word32 -> Word64
toWord64   = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromChar :: Char -> Word32
fromChar   = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> (Char -> Word8) -> Char -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
BI.c2w
    fromWord8 :: Word8 -> Word32
fromWord8  = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromWord16 :: Word16 -> Word32
fromWord16 = Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromWord32 :: Word32 -> Word32
fromWord32 = Word32 -> Word32
forall a. a -> a
id
    fromWord64 :: Word64 -> Word32
fromWord64 = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance StringCell Word64 where
    toChar :: Word64 -> Char
toChar     = Word8 -> Char
BI.w2c (Word8 -> Char) -> (Word64 -> Word8) -> Word64 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord8 :: Word64 -> Word8
toWord8    = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord16 :: Word64 -> Word16
toWord16   = Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord32 :: Word64 -> Word32
toWord32   = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord64 :: Word64 -> Word64
toWord64   = Word64 -> Word64
forall a. a -> a
id
    fromChar :: Char -> Word64
fromChar   = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> (Char -> Word8) -> Char -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
BI.c2w
    fromWord8 :: Word8 -> Word64
fromWord8  = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromWord16 :: Word16 -> Word64
fromWord16 = Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromWord32 :: Word32 -> Word64
fromWord32 = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromWord64 :: Word64 -> Word64
fromWord64 = Word64 -> Word64
forall a. a -> a
id

instance ConvGenString GenString where
    toGenString :: GenString -> GenString
toGenString   = GenString -> GenString
forall a. a -> a
id
    fromGenString :: GenString -> GenString
fromGenString = GenString -> GenString
forall a. a -> a
id

instance ConvGenString String where
    toGenString :: FilePath -> GenString
toGenString      = FilePath -> GenString
forall s. Stringy s => s -> GenString
GenString
    fromGenString :: GenString -> FilePath
fromGenString GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> FilePath
forall s2. StringCells s2 => s -> s2
forall s s2. (StringCells s, StringCells s2) => s -> s2
toStringCells s
_s

instance ConvGenString SC.ByteString where
    toGenString :: ByteString -> GenString
toGenString      = ByteString -> GenString
forall s. Stringy s => s -> GenString
GenString
    fromGenString :: GenString -> ByteString
fromGenString GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> ByteString
forall s2. StringCells s2 => s -> s2
forall s s2. (StringCells s, StringCells s2) => s -> s2
toStringCells s
_s

instance ConvGenString LC.ByteString where
    toGenString :: GenStringDefault -> GenString
toGenString      = GenStringDefault -> GenString
forall s. Stringy s => s -> GenString
GenString
    fromGenString :: GenString -> GenStringDefault
fromGenString GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenStringDefault
forall s2. StringCells s2 => s -> s2
forall s s2. (StringCells s, StringCells s2) => s -> s2
toStringCells s
_s

instance ConvGenString T.Text where
    toGenString :: Text -> GenString
toGenString      = Text -> GenString
forall s. Stringy s => s -> GenString
GenString
    fromGenString :: GenString -> Text
fromGenString GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> Text
forall s2. StringCells s2 => s -> s2
forall s s2. (StringCells s, StringCells s2) => s -> s2
toStringCells s
_s

instance ConvGenString LT.Text where
    toGenString :: Text -> GenString
toGenString      = Text -> GenString
forall s. Stringy s => s -> GenString
GenString
    fromGenString :: GenString -> Text
fromGenString GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> Text
forall s2. StringCells s2 => s -> s2
forall s s2. (StringCells s, StringCells s2) => s -> s2
toStringCells s
_s

instance ConvString GenString where
    toString :: GenString -> FilePath
toString   = GenString -> FilePath
forall s. ConvGenString s => GenString -> s
fromGenString
    fromString :: FilePath -> GenString
fromString = FilePath -> GenString
forall s. ConvGenString s => s -> GenString
toGenString

instance ConvString String where
    toString :: FilePath -> FilePath
toString   = FilePath -> FilePath
forall a. a -> a
id
    fromString :: FilePath -> FilePath
fromString = FilePath -> FilePath
forall a. a -> a
id

instance ConvString SC.ByteString where
    toString :: ByteString -> FilePath
toString   = ByteString -> FilePath
SC.unpack
    fromString :: FilePath -> ByteString
fromString = FilePath -> ByteString
SC.pack

instance ConvString LC.ByteString where
    toString :: GenStringDefault -> FilePath
toString   = GenStringDefault -> FilePath
LC.unpack
    fromString :: FilePath -> GenStringDefault
fromString = FilePath -> GenStringDefault
LC.pack

instance ConvString T.Text where
    toString :: Text -> FilePath
toString   = Text -> FilePath
T.unpack
    fromString :: FilePath -> Text
fromString = FilePath -> Text
T.pack

instance ConvString LT.Text where
    toString :: Text -> FilePath
toString   = Text -> FilePath
LT.unpack
    fromString :: FilePath -> Text
fromString = FilePath -> Text
LT.pack

instance ConvStrictByteString GenString where
    toStrictByteString :: GenString -> ByteString
toStrictByteString   = GenString -> ByteString
forall s. ConvGenString s => GenString -> s
fromGenString
    fromStrictByteString :: ByteString -> GenString
fromStrictByteString = ByteString -> GenString
forall s. ConvGenString s => s -> GenString
toGenString

instance ConvStrictByteString String where
    toStrictByteString :: FilePath -> ByteString
toStrictByteString   = FilePath -> ByteString
SC.pack
    fromStrictByteString :: ByteString -> FilePath
fromStrictByteString = ByteString -> FilePath
SC.unpack

instance ConvStrictByteString S.ByteString where
    toStrictByteString :: ByteString -> ByteString
toStrictByteString   = ByteString -> ByteString
forall a. a -> a
id
    fromStrictByteString :: ByteString -> ByteString
fromStrictByteString = ByteString -> ByteString
forall a. a -> a
id

instance ConvStrictByteString L.ByteString where
    toStrictByteString :: GenStringDefault -> ByteString
toStrictByteString   = GenStringDefault -> ByteString
L.toStrict
    fromStrictByteString :: ByteString -> GenStringDefault
fromStrictByteString = ByteString -> GenStringDefault
forall s. ConvLazyByteString s => s -> GenStringDefault
toLazyByteString

instance ConvStrictByteString T.Text where
    toStrictByteString :: Text -> ByteString
toStrictByteString   = Text -> ByteString
TE.encodeUtf8
    fromStrictByteString :: ByteString -> Text
fromStrictByteString = ByteString -> Text
forall s. ConvText s => s -> Text
toText

instance ConvStrictByteString LT.Text where
    toStrictByteString :: Text -> ByteString
toStrictByteString   = GenStringDefault -> ByteString
forall s. ConvStrictByteString s => s -> ByteString
toStrictByteString (GenStringDefault -> ByteString)
-> (Text -> GenStringDefault) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> GenStringDefault
LTE.encodeUtf8
    fromStrictByteString :: ByteString -> Text
fromStrictByteString = ByteString -> Text
forall s. ConvLazyText s => s -> Text
toLazyText

instance ConvLazyByteString GenString where
    toLazyByteString :: GenString -> GenStringDefault
toLazyByteString   = GenString -> GenStringDefault
forall s. ConvGenString s => GenString -> s
fromGenString
    fromLazyByteString :: GenStringDefault -> GenString
fromLazyByteString = GenStringDefault -> GenString
forall s. ConvGenString s => s -> GenString
toGenString

instance ConvLazyByteString String where
    toLazyByteString :: FilePath -> GenStringDefault
toLazyByteString   = FilePath -> GenStringDefault
LC.pack
    fromLazyByteString :: GenStringDefault -> FilePath
fromLazyByteString = GenStringDefault -> FilePath
LC.unpack

instance ConvLazyByteString S.ByteString where
    toLazyByteString :: ByteString -> GenStringDefault
toLazyByteString   = ByteString -> GenStringDefault
L.fromStrict
    fromLazyByteString :: GenStringDefault -> ByteString
fromLazyByteString = GenStringDefault -> ByteString
forall s. ConvStrictByteString s => s -> ByteString
toStrictByteString

instance ConvLazyByteString L.ByteString where
    toLazyByteString :: GenStringDefault -> GenStringDefault
toLazyByteString   = GenStringDefault -> GenStringDefault
forall a. a -> a
id
    fromLazyByteString :: GenStringDefault -> GenStringDefault
fromLazyByteString = GenStringDefault -> GenStringDefault
forall a. a -> a
id

instance ConvLazyByteString T.Text where
    toLazyByteString :: Text -> GenStringDefault
toLazyByteString   = ByteString -> GenStringDefault
forall s. ConvLazyByteString s => s -> GenStringDefault
toLazyByteString (ByteString -> GenStringDefault)
-> (Text -> ByteString) -> Text -> GenStringDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall s. ConvStrictByteString s => s -> ByteString
toStrictByteString
    fromLazyByteString :: GenStringDefault -> Text
fromLazyByteString = GenStringDefault -> Text
forall s. ConvText s => s -> Text
toText

instance ConvLazyByteString LT.Text where
    toLazyByteString :: Text -> GenStringDefault
toLazyByteString   = ByteString -> GenStringDefault
forall s. ConvLazyByteString s => s -> GenStringDefault
toLazyByteString (ByteString -> GenStringDefault)
-> (Text -> ByteString) -> Text -> GenStringDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall s. ConvStrictByteString s => s -> ByteString
toStrictByteString
    fromLazyByteString :: GenStringDefault -> Text
fromLazyByteString = GenStringDefault -> Text
forall s. ConvLazyText s => s -> Text
toLazyText

instance ConvText GenString where
    toText :: GenString -> Text
toText   = GenString -> Text
forall s. ConvGenString s => GenString -> s
fromGenString
    fromText :: Text -> GenString
fromText = Text -> GenString
forall s. ConvGenString s => s -> GenString
toGenString

instance ConvText String where
    toText :: FilePath -> Text
toText   = FilePath -> Text
T.pack
    fromText :: Text -> FilePath
fromText = Text -> FilePath
T.unpack

instance ConvText S.ByteString where
    toText :: ByteString -> Text
toText   = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode
    fromText :: Text -> ByteString
fromText = Text -> ByteString
forall s. ConvStrictByteString s => s -> ByteString
toStrictByteString

instance ConvText L.ByteString where
    toText :: GenStringDefault -> Text
toText   = ByteString -> Text
forall s. ConvText s => s -> Text
toText (ByteString -> Text)
-> (GenStringDefault -> ByteString) -> GenStringDefault -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenStringDefault -> ByteString
forall s. ConvStrictByteString s => s -> ByteString
toStrictByteString
    fromText :: Text -> GenStringDefault
fromText = Text -> GenStringDefault
forall s. ConvLazyByteString s => s -> GenStringDefault
toLazyByteString

instance ConvText T.Text where
    toText :: Text -> Text
toText   = Text -> Text
forall a. a -> a
id
    fromText :: Text -> Text
fromText = Text -> Text
forall a. a -> a
id

instance ConvText LT.Text where
    toText :: Text -> Text
toText   = Text -> Text
LT.toStrict
    fromText :: Text -> Text
fromText = Text -> Text
forall s. ConvLazyText s => s -> Text
toLazyText

instance ConvLazyText GenString where
    toLazyText :: GenString -> Text
toLazyText   = GenString -> Text
forall s. ConvGenString s => GenString -> s
fromGenString
    fromLazyText :: Text -> GenString
fromLazyText = Text -> GenString
forall s. ConvGenString s => s -> GenString
toGenString

instance ConvLazyText String where
    toLazyText :: FilePath -> Text
toLazyText   = FilePath -> Text
LT.pack
    fromLazyText :: Text -> FilePath
fromLazyText = Text -> FilePath
LT.unpack

instance ConvLazyText S.ByteString where
    toLazyText :: ByteString -> Text
toLazyText   = OnDecodeError -> GenStringDefault -> Text
LTE.decodeUtf8With OnDecodeError
TEE.lenientDecode (GenStringDefault -> Text)
-> (ByteString -> GenStringDefault) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> GenStringDefault
forall s. ConvLazyByteString s => s -> GenStringDefault
toLazyByteString
    fromLazyText :: Text -> ByteString
fromLazyText = Text -> ByteString
forall s. ConvStrictByteString s => s -> ByteString
toStrictByteString

instance ConvLazyText L.ByteString where
    toLazyText :: GenStringDefault -> Text
toLazyText   = OnDecodeError -> GenStringDefault -> Text
LTE.decodeUtf8With OnDecodeError
TEE.lenientDecode
    fromLazyText :: Text -> GenStringDefault
fromLazyText = Text -> GenStringDefault
forall s. ConvLazyByteString s => s -> GenStringDefault
toLazyByteString

instance ConvLazyText T.Text where
    toLazyText :: Text -> Text
toLazyText   = Text -> Text
LT.fromStrict
    fromLazyText :: Text -> Text
fromLazyText = Text -> Text
forall s. ConvLazyText s => Text -> s
fromLazyText

instance ConvLazyText LT.Text where
    toLazyText :: Text -> Text
toLazyText   = Text -> Text
forall a. a -> a
id
    fromLazyText :: Text -> Text
fromLazyText = Text -> Text
forall a. a -> a
id

-- |
--
-- This is minimally defined with 'GenStringDefault'.
instance StringRWIO GenString where
    hGetContents :: Handle -> IO GenString
hGetContents Handle
h = GenStringDefault -> GenString
genStringFromConConv (GenStringDefault -> GenString)
-> IO GenStringDefault -> IO GenString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO GenStringDefault
forall s. StringRWIO s => Handle -> IO s
hGetContents Handle
h

    hGetLine :: Handle -> IO GenString
hGetLine Handle
h = GenStringDefault -> GenString
genStringFromConConv (GenStringDefault -> GenString)
-> IO GenStringDefault -> IO GenString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO GenStringDefault
forall s. StringRWIO s => Handle -> IO s
hGetLine Handle
h

    hPutStr :: Handle -> GenString -> IO ()
hPutStr Handle
h GenString
s = Handle -> GenStringDefault -> IO ()
forall s. StringRWIO s => Handle -> s -> IO ()
hPutStr Handle
h (GenString -> GenStringDefault
genStringConConv GenString
s)

    hPutStrLn :: Handle -> GenString -> IO ()
hPutStrLn Handle
h GenString
s = Handle -> GenStringDefault -> IO ()
forall s. StringRWIO s => Handle -> s -> IO ()
hPutStrLn Handle
h (GenString -> GenStringDefault
genStringConConv GenString
s)

-- | Type-restricted string conversion used by 'GenString's instance definition for 'StringRWIO'
genStringConConv :: GenString -> GenStringDefault
genStringConConv :: GenString -> GenStringDefault
genStringConConv = GenString -> GenStringDefault
forall s2. StringCells s2 => GenString -> s2
forall s s2. (StringCells s, StringCells s2) => s -> s2
toStringCells

-- | Type-restricted string conversion used by 'GenString's instance definition for 'StringRWIO'
genStringFromConConv :: GenStringDefault -> GenString
genStringFromConConv :: GenStringDefault -> GenString
genStringFromConConv = GenStringDefault -> GenString
forall s2. StringCells s2 => GenStringDefault -> s2
forall s s2. (StringCells s, StringCells s2) => s -> s2
toStringCells

-- |
--
-- See 'System.IO for documentation of behaviour.
instance StringRWIO String where
    hGetContents :: Handle -> IO FilePath
hGetContents = Handle -> IO FilePath
IO.hGetContents

    hGetLine :: Handle -> IO FilePath
hGetLine     = Handle -> IO FilePath
IO.hGetLine

    hPutStr :: Handle -> FilePath -> IO ()
hPutStr      = Handle -> FilePath -> IO ()
IO.hPutStr

    hPutStrLn :: Handle -> FilePath -> IO ()
hPutStrLn    = Handle -> FilePath -> IO ()
IO.hPutStrLn

    interact :: (FilePath -> FilePath) -> IO ()
interact     = (FilePath -> FilePath) -> IO ()
IO.interact

    getContents :: IO FilePath
getContents  = IO FilePath
IO.getContents

    getLine :: IO FilePath
getLine      = IO FilePath
IO.getLine

    putStr :: FilePath -> IO ()
putStr       = FilePath -> IO ()
IO.putStr

    putStrLn :: FilePath -> IO ()
putStrLn     = FilePath -> IO ()
IO.putStrLn

    readFile :: FilePath -> IO FilePath
readFile     = FilePath -> IO FilePath
IO.readFile

    writeFile :: FilePath -> FilePath -> IO ()
writeFile    = FilePath -> FilePath -> IO ()
IO.writeFile

    appendFile :: FilePath -> FilePath -> IO ()
appendFile   = FilePath -> FilePath -> IO ()
IO.appendFile

-- |
--
-- See 'Data.ByteString' for documentation of behaviour.
instance StringRWIO S.ByteString where
    hGetContents :: Handle -> IO ByteString
hGetContents = Handle -> IO ByteString
S.hGetContents

    hGetLine :: Handle -> IO ByteString
hGetLine     = Handle -> IO ByteString
S.hGetLine

    hPutStr :: Handle -> ByteString -> IO ()
hPutStr      = Handle -> ByteString -> IO ()
S.hPutStr

    hPutStrLn :: Handle -> ByteString -> IO ()
hPutStrLn    = Handle -> ByteString -> IO ()
SC.hPutStrLn

    interact :: (ByteString -> ByteString) -> IO ()
interact     = (ByteString -> ByteString) -> IO ()
S.interact

    getContents :: IO ByteString
getContents  = IO ByteString
S.getContents

    getLine :: IO ByteString
getLine      = IO ByteString
S.getLine

    putStr :: ByteString -> IO ()
putStr       = ByteString -> IO ()
S.putStr

    putStrLn :: ByteString -> IO ()
putStrLn     = ByteString -> IO ()
SC.putStrLn

    readFile :: FilePath -> IO ByteString
readFile     = FilePath -> IO ByteString
S.readFile

    writeFile :: FilePath -> ByteString -> IO ()
writeFile    = FilePath -> ByteString -> IO ()
S.writeFile

    appendFile :: FilePath -> ByteString -> IO ()
appendFile   = FilePath -> ByteString -> IO ()
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 :: Handle -> IO GenStringDefault
hGetContents = Handle -> IO GenStringDefault
L.hGetContents

    hGetLine :: Handle -> IO GenStringDefault
hGetLine     = (ByteString -> GenStringDefault
forall s2. StringCells s2 => ByteString -> s2
forall s s2. (StringCells s, StringCells s2) => s -> s2
toStringCells (ByteString -> GenStringDefault)
-> IO ByteString -> IO GenStringDefault
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO ByteString -> IO GenStringDefault)
-> (Handle -> IO ByteString) -> Handle -> IO GenStringDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ByteString
S.hGetLine

    hPutStr :: Handle -> GenStringDefault -> IO ()
hPutStr      = Handle -> GenStringDefault -> IO ()
L.hPutStr

    hPutStrLn :: Handle -> GenStringDefault -> IO ()
hPutStrLn Handle
h  = (IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> GenStringDefault -> IO ()
forall s. StringRWIO s => Handle -> s -> IO ()
hPutStr Handle
h ((FilePath -> GenStringDefault
forall s2. StringCells s2 => FilePath -> s2
forall s s2. (StringCells s, StringCells s2) => s -> s2
toStringCells :: String -> L.ByteString) [Char
'\n'])) (IO () -> IO ())
-> (GenStringDefault -> IO ()) -> GenStringDefault -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> GenStringDefault -> IO ()
forall s. StringRWIO s => Handle -> s -> IO ()
hPutStr Handle
h

    interact :: (GenStringDefault -> GenStringDefault) -> IO ()
interact     = (GenStringDefault -> GenStringDefault) -> IO ()
L.interact

    getContents :: IO GenStringDefault
getContents  = IO GenStringDefault
L.getContents

    getLine :: IO GenStringDefault
getLine      = ByteString -> GenStringDefault
forall s2. StringCells s2 => ByteString -> s2
forall s s2. (StringCells s, StringCells s2) => s -> s2
toStringCells (ByteString -> GenStringDefault)
-> IO ByteString -> IO GenStringDefault
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
S.getLine

    putStr :: GenStringDefault -> IO ()
putStr       = GenStringDefault -> IO ()
L.putStr

    putStrLn :: GenStringDefault -> IO ()
putStrLn     = GenStringDefault -> IO ()
LC.putStrLn

    readFile :: FilePath -> IO GenStringDefault
readFile     = FilePath -> IO GenStringDefault
L.readFile

    writeFile :: FilePath -> GenStringDefault -> IO ()
writeFile    = FilePath -> GenStringDefault -> IO ()
L.writeFile

    appendFile :: FilePath -> GenStringDefault -> IO ()
appendFile   = FilePath -> GenStringDefault -> IO ()
L.appendFile

-- |
--
-- See 'Data.Text.IO' for documentation of behaviour.
instance StringRWIO T.Text where
    hGetContents :: Handle -> IO Text
hGetContents = Handle -> IO Text
T.hGetContents

    hGetLine :: Handle -> IO Text
hGetLine     = Handle -> IO Text
T.hGetLine

    hPutStr :: Handle -> Text -> IO ()
hPutStr      = Handle -> Text -> IO ()
T.hPutStr

    hPutStrLn :: Handle -> Text -> IO ()
hPutStrLn    = Handle -> Text -> IO ()
T.hPutStrLn

    interact :: (Text -> Text) -> IO ()
interact     = (Text -> Text) -> IO ()
T.interact

    getContents :: IO Text
getContents  = IO Text
T.getContents

    getLine :: IO Text
getLine      = IO Text
T.getLine

    putStr :: Text -> IO ()
putStr       = Text -> IO ()
T.putStr

    putStrLn :: Text -> IO ()
putStrLn     = Text -> IO ()
T.putStrLn

    readFile :: FilePath -> IO Text
readFile     = FilePath -> IO Text
T.readFile

    writeFile :: FilePath -> Text -> IO ()
writeFile    = FilePath -> Text -> IO ()
T.writeFile

    appendFile :: FilePath -> Text -> IO ()
appendFile   = FilePath -> Text -> IO ()
T.appendFile

-- |
--
-- See 'Data.Text.Lazy.IO' for documentation of behaviour.
instance StringRWIO LT.Text where
    hGetContents :: Handle -> IO Text
hGetContents = Handle -> IO Text
LT.hGetContents

    hGetLine :: Handle -> IO Text
hGetLine     = Handle -> IO Text
LT.hGetLine

    hPutStr :: Handle -> Text -> IO ()
hPutStr      = Handle -> Text -> IO ()
LT.hPutStr

    hPutStrLn :: Handle -> Text -> IO ()
hPutStrLn    = Handle -> Text -> IO ()
LT.hPutStrLn

    interact :: (Text -> Text) -> IO ()
interact     = (Text -> Text) -> IO ()
LT.interact

    getContents :: IO Text
getContents  = IO Text
LT.getContents

    getLine :: IO Text
getLine      = IO Text
LT.getLine

    putStr :: Text -> IO ()
putStr       = Text -> IO ()
LT.putStr

    putStrLn :: Text -> IO ()
putStrLn     = Text -> IO ()
LT.putStrLn

    readFile :: FilePath -> IO Text
readFile     = FilePath -> IO Text
LT.readFile

    writeFile :: FilePath -> Text -> IO ()
writeFile    = FilePath -> Text -> IO ()
LT.writeFile

    appendFile :: FilePath -> Text -> IO ()
appendFile   = FilePath -> Text -> IO ()
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 :: forall s. Stringy s => s -> GenStringDefault
toGenDefaultString = s -> GenStringDefault
forall s2. StringCells s2 => s -> s2
forall s s2. (StringCells s, StringCells s2) => s -> s2
toStringCells

instance Eq GenString where
    GenString
_a == :: GenString -> GenString -> Bool
== GenString
_b = case (GenString
_a, GenString
_b) of
        ((GenString s
_a), (GenString s
_b)) -> s -> GenStringDefault
forall s. Stringy s => s -> GenStringDefault
toGenDefaultString s
_a GenStringDefault -> GenStringDefault -> Bool
forall a. Eq a => a -> a -> Bool
== s -> GenStringDefault
forall s. Stringy s => s -> GenStringDefault
toGenDefaultString s
_b
    GenString
_a /= :: GenString -> GenString -> Bool
/= GenString
_b = case (GenString
_a, GenString
_b) of
        ((GenString s
_a), (GenString s
_b)) -> s -> GenStringDefault
forall s. Stringy s => s -> GenStringDefault
toGenDefaultString s
_a GenStringDefault -> GenStringDefault -> Bool
forall a. Eq a => a -> a -> Bool
/= s -> GenStringDefault
forall s. Stringy s => s -> GenStringDefault
toGenDefaultString s
_b

instance IsString GenString where
    fromString :: FilePath -> GenString
fromString = FilePath -> GenString
forall s. Stringy s => s -> GenString
GenString

instance Semigroup GenString where
    <> :: GenString -> GenString -> GenString
(<>) GenString
a GenString
b = case (GenString
a, GenString
b) of
        (GenString s
_a, GenString s
_b) -> GenStringDefault -> GenString
forall s. Stringy s => s -> GenString
GenString (GenStringDefault -> GenString) -> GenStringDefault -> GenString
forall a b. (a -> b) -> a -> b
$ GenStringDefault -> GenStringDefault -> GenStringDefault
forall s. StringCells s => s -> s -> s
append (s -> GenStringDefault
forall s. Stringy s => s -> GenStringDefault
toGenDefaultString s
_a) (s -> GenStringDefault
forall s. Stringy s => s -> GenStringDefault
toGenDefaultString s
_b)

instance Monoid GenString where
    mempty :: GenString
mempty  = GenStringDefault -> GenString
forall s. Stringy s => s -> GenString
GenString (GenStringDefault -> GenString) -> GenStringDefault -> GenString
forall a b. (a -> b) -> a -> b
$ (GenStringDefault
forall s. StringCells s => s
empty :: GenStringDefault)
    mappend :: GenString -> GenString -> GenString
mappend = GenString -> GenString -> GenString
forall a. Semigroup a => a -> a -> a
(<>)
    mconcat :: [GenString] -> GenString
mconcat [GenString]
ss = GenStringDefault -> GenString
forall s. Stringy s => s -> GenString
GenString (GenStringDefault -> GenString) -> GenStringDefault -> GenString
forall a b. (a -> b) -> a -> b
$ [GenStringDefault] -> GenStringDefault
forall s. StringCells s => [s] -> s
concat ([GenStringDefault] -> GenStringDefault)
-> ([GenString] -> [GenStringDefault])
-> [GenString]
-> GenStringDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenString -> GenStringDefault)
-> [GenString] -> [GenStringDefault]
forall a b. (a -> b) -> [a] -> [b]
map GenString -> GenStringDefault
forall s. Stringy s => s -> GenStringDefault
toGenDefaultString ([GenString] -> GenStringDefault)
-> [GenString] -> GenStringDefault
forall a b. (a -> b) -> a -> b
$ [GenString]
ss

instance StringCells GenString where
    -- These associated types were rather arbitrarily chosen
    type StringCellChar GenString = Char
    type StringCellAltChar GenString = Word8

    toStringCells :: forall s2. StringCells s2 => GenString -> s2
toStringCells   = GenString -> s2
forall s. ConvGenString s => GenString -> s
fromGenString
    fromStringCells :: forall s2. StringCells s2 => s2 -> GenString
fromStringCells = s2 -> GenString
forall s. ConvGenString s => s -> GenString
toGenString

    cons :: StringCellChar GenString -> GenString -> GenString
cons StringCellChar GenString
c GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
cons (s
_s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` Char -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar Char
StringCellChar GenString
c) s
_s
    uncons :: GenString -> (StringCellChar GenString, GenString)
uncons GenString
_s = case GenString
_s of
        (GenString s
_s) -> let (StringCellChar s
c, s
s') = s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
_s
                          in  (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
c, s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s')
    snoc :: GenString -> StringCellChar GenString -> GenString
snoc GenString
_s StringCellChar GenString
c = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ s -> StringCellChar s -> s
forall s. StringCells s => s -> StringCellChar s -> s
snoc s
_s (s
_s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` Char -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar Char
StringCellChar GenString
c)
    unsnoc :: GenString -> (GenString, StringCellChar GenString)
unsnoc GenString
_s = case GenString
_s of
        (GenString s
_s) -> let (s
s', StringCellChar s
c) = s -> (s, StringCellChar s)
forall s. StringCells s => s -> (s, StringCellChar s)
unsnoc s
_s
                          in  (s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s', GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
c)

    altCons :: StringCellAltChar GenString -> GenString -> GenString
altCons StringCellAltChar GenString
c GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ StringCellChar s -> s -> s
forall s. StringCells s => StringCellChar s -> s -> s
cons (Word8 -> StringCellChar s
forall c. StringCell c => Word8 -> c
fromWord8 Word8
StringCellAltChar GenString
c) s
_s
    altUncons :: GenString -> (StringCellAltChar GenString, GenString)
altUncons GenString
_s = case GenString
_s of
        (GenString s
_s) -> let (StringCellChar s
c, s
s') = s -> (StringCellChar s, s)
forall s. StringCells s => s -> (StringCellChar s, s)
uncons s
_s
                          in  (GenString
genStringPhantom GenString -> Tagged GenString Word8 -> Word8
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellAltChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellAltChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellAltChar s)
toAltChar StringCellChar s
c, s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s')
    altSnoc :: GenString -> StringCellAltChar GenString -> GenString
altSnoc GenString
_s StringCellAltChar GenString
c = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ s -> StringCellChar s -> s
forall s. StringCells s => s -> StringCellChar s -> s
snoc s
_s (Word8 -> StringCellChar s
forall c. StringCell c => Word8 -> c
fromWord8 Word8
StringCellAltChar GenString
c)
    altUnsnoc :: GenString -> (GenString, StringCellAltChar GenString)
altUnsnoc GenString
_s = case GenString
_s of
        (GenString s
_s) -> let (s
s', StringCellChar s
c) = s -> (s, StringCellChar s)
forall s. StringCells s => s -> (s, StringCellChar s)
unsnoc s
_s
                          in  (s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s', GenString
genStringPhantom GenString -> Tagged GenString Word8 -> Word8
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellAltChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellAltChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellAltChar s)
toAltChar StringCellChar s
c)

    toMainChar :: forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
toMainChar = Char -> Tagged GenString Char
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Char -> Tagged GenString Char)
-> (c -> Char) -> c -> Tagged GenString Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Char
forall c. StringCell c => c -> Char
toChar
    toAltChar :: forall c.
StringCell c =>
c -> Tagged GenString (StringCellAltChar GenString)
toAltChar  = Word8 -> Tagged GenString Word8
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Word8 -> Tagged GenString Word8)
-> (c -> Word8) -> c -> Tagged GenString Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Word8
forall c. StringCell c => c -> Word8
toWord8

    null :: GenString -> Bool
null GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> Bool
forall s. StringCells s => s -> Bool
null s
_s

    head :: GenString -> StringCellChar GenString
head GenString
_s = case GenString
_s of
        (GenString s
_s) -> GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar (s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
head s
_s)
    tail :: GenString -> GenString
tail GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ s -> s
forall s. StringCells s => s -> s
tail s
_s
    last :: GenString -> StringCellChar GenString
last GenString
_s = case GenString
_s of
        (GenString s
_s) -> GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar (s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
last s
_s)
    init :: GenString -> GenString
init GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ s -> s
forall s. StringCells s => s -> s
init s
_s
    altHead :: GenString -> StringCellAltChar GenString
altHead GenString
_s = case GenString
_s of
        (GenString s
_s) -> GenString
genStringPhantom GenString -> Tagged GenString Word8 -> Word8
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellAltChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellAltChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellAltChar s)
toAltChar (s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
head s
_s)
    altLast :: GenString -> StringCellAltChar GenString
altLast GenString
_s = case GenString
_s of
        (GenString s
_s) -> GenString
genStringPhantom GenString -> Tagged GenString Word8 -> Word8
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellAltChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellAltChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellAltChar s)
toAltChar (s -> StringCellChar s
forall s. StringCells s => s -> StringCellChar s
last s
_s)

    unfoldr :: forall a.
(a -> Maybe (StringCellChar GenString, a)) -> a -> GenString
unfoldr       a -> Maybe (StringCellChar GenString, a)
f a
z = GenStringDefault -> GenString
forall s. Stringy s => s -> GenString
GenString (GenStringDefault -> GenString) -> GenStringDefault -> GenString
forall a b. (a -> b) -> a -> b
$ ((a -> Maybe (StringCellAltChar GenStringDefault, a))
-> a -> GenStringDefault
forall s a.
StringCells s =>
(a -> Maybe (StringCellAltChar s, a)) -> a -> s
forall a.
(a -> Maybe (StringCellAltChar GenStringDefault, a))
-> a -> GenStringDefault
altUnfoldr    a -> Maybe (StringCellChar GenString, a)
a -> Maybe (StringCellAltChar GenStringDefault, a)
f a
z  :: GenStringDefault)
    altUnfoldr :: forall a.
(a -> Maybe (StringCellAltChar GenString, a)) -> a -> GenString
altUnfoldr    a -> Maybe (StringCellAltChar GenString, a)
f a
z = GenStringDefault -> GenString
forall s. Stringy s => s -> GenString
GenString (GenStringDefault -> GenString) -> GenStringDefault -> GenString
forall a b. (a -> b) -> a -> b
$ ((a -> Maybe (StringCellChar GenStringDefault, a))
-> a -> GenStringDefault
forall s a.
StringCells s =>
(a -> Maybe (StringCellChar s, a)) -> a -> s
forall a.
(a -> Maybe (StringCellChar GenStringDefault, a))
-> a -> GenStringDefault
unfoldr       a -> Maybe (StringCellChar GenStringDefault, a)
a -> Maybe (StringCellAltChar GenString, a)
f a
z  :: GenStringDefault)
    unfoldrN :: forall a.
Int -> (a -> Maybe (StringCellChar GenString, a)) -> a -> GenString
unfoldrN    Int
n a -> Maybe (StringCellChar GenString, a)
f a
z = GenStringDefault -> GenString
forall s. Stringy s => s -> GenString
GenString (GenStringDefault -> GenString) -> GenStringDefault -> GenString
forall a b. (a -> b) -> a -> b
$ (Int
-> (a -> Maybe (StringCellAltChar GenStringDefault, a))
-> a
-> GenStringDefault
forall a.
Int
-> (a -> Maybe (StringCellAltChar GenStringDefault, a))
-> a
-> GenStringDefault
forall s a.
StringCells s =>
Int -> (a -> Maybe (StringCellAltChar s, a)) -> a -> s
altUnfoldrN Int
n a -> Maybe (StringCellChar GenString, a)
a -> Maybe (StringCellAltChar GenStringDefault, a)
f a
z  :: GenStringDefault)
    altUnfoldrN :: forall a.
Int
-> (a -> Maybe (StringCellAltChar GenString, a)) -> a -> GenString
altUnfoldrN Int
n a -> Maybe (StringCellAltChar GenString, a)
f a
z = GenStringDefault -> GenString
forall s. Stringy s => s -> GenString
GenString (GenStringDefault -> GenString) -> GenStringDefault -> GenString
forall a b. (a -> b) -> a -> b
$ (Int
-> (a -> Maybe (StringCellChar GenStringDefault, a))
-> a
-> GenStringDefault
forall a.
Int
-> (a -> Maybe (StringCellChar GenStringDefault, a))
-> a
-> GenStringDefault
forall s a.
StringCells s =>
Int -> (a -> Maybe (StringCellChar s, a)) -> a -> s
unfoldrN    Int
n a -> Maybe (StringCellChar GenStringDefault, a)
a -> Maybe (StringCellAltChar GenString, a)
f a
z  :: GenStringDefault)

    index :: GenString -> Int -> StringCellChar GenString
index GenString
_s Int
i = case GenString
_s of
        (GenString s
_s) -> GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar (s -> Int -> StringCellChar s
forall s. StringCells s => s -> Int -> StringCellChar s
index s
_s Int
i)
    index64 :: GenString -> Int64 -> StringCellChar GenString
index64 GenString
_s Int64
i = case GenString
_s of
        (GenString s
_s) -> GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar (s -> Int64 -> StringCellChar s
forall s. StringCells s => s -> Int64 -> StringCellChar s
index64 s
_s Int64
i)
    genericIndex :: forall i. Integral i => GenString -> i -> StringCellChar GenString
genericIndex GenString
_s i
i = case GenString
_s of
        (GenString s
_s) -> GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar (s -> i -> StringCellChar s
forall i. Integral i => s -> i -> StringCellChar s
forall s i.
(StringCells s, Integral i) =>
s -> i -> StringCellChar s
genericIndex s
_s i
i)

    take :: Int -> GenString -> GenString
take Int
n GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ Int -> s -> s
forall s. StringCells s => Int -> s -> s
take Int
n s
_s
    take64 :: Int64 -> GenString -> GenString
take64 Int64
n GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ Int64 -> s -> s
forall s. StringCells s => Int64 -> s -> s
take64 Int64
n s
_s
    genericTake :: forall b. Integral b => b -> GenString -> GenString
genericTake i
n GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ i -> s -> s
forall i. Integral i => i -> s -> s
forall s i. (StringCells s, Integral i) => i -> s -> s
genericTake i
n s
_s
    drop :: Int -> GenString -> GenString
drop Int
n GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ Int -> s -> s
forall s. StringCells s => Int -> s -> s
drop Int
n s
_s
    drop64 :: Int64 -> GenString -> GenString
drop64 Int64
n GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ Int64 -> s -> s
forall s. StringCells s => Int64 -> s -> s
drop64 Int64
n s
_s
    genericDrop :: forall b. Integral b => b -> GenString -> GenString
genericDrop i
n GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ i -> s -> s
forall i. Integral i => i -> s -> s
forall s i. (StringCells s, Integral i) => i -> s -> s
genericDrop i
n s
_s

    length :: GenString -> Int
length GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> Int
forall s. StringCells s => s -> Int
length s
_s
    length64 :: GenString -> Int64
length64 GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> Int64
forall s. StringCells s => s -> Int64
length64 s
_s
    genericLength :: forall i. Integral i => GenString -> i
genericLength GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> i
forall i. Integral i => s -> i
forall s i. (StringCells s, Integral i) => s -> i
genericLength s
_s

    safeUncons :: GenString -> Maybe (StringCellChar GenString, GenString)
safeUncons GenString
_s = case GenString
_s of
        (GenString s
_s) -> (\(StringCellChar s
c, s
s') -> (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
c, s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s')) ((StringCellChar s, s) -> (Char, GenString))
-> Maybe (StringCellChar s, s) -> Maybe (Char, GenString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe (StringCellChar s, s)
forall s. StringCells s => s -> Maybe (StringCellChar s, s)
safeUncons s
_s
    safeUnsnoc :: GenString -> Maybe (GenString, StringCellChar GenString)
safeUnsnoc GenString
_s = case GenString
_s of
        (GenString s
_s) -> (\(s
s', StringCellChar s
c) -> (s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s', GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
c)) ((s, StringCellChar s) -> (GenString, Char))
-> Maybe (s, StringCellChar s) -> Maybe (GenString, Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe (s, StringCellChar s)
forall s. StringCells s => s -> Maybe (s, StringCellChar s)
safeUnsnoc s
_s
    safeAltUncons :: GenString -> Maybe (StringCellAltChar GenString, GenString)
safeAltUncons GenString
_s = case GenString
_s of
        (GenString s
_s) -> (\(StringCellAltChar s
c, s
s') -> (GenString
genStringPhantom GenString -> Tagged GenString Word8 -> Word8
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellAltChar s
-> Tagged GenString (StringCellAltChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellAltChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellAltChar s)
toAltChar StringCellAltChar s
c, s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s')) ((StringCellAltChar s, s) -> (Word8, GenString))
-> Maybe (StringCellAltChar s, s) -> Maybe (Word8, GenString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe (StringCellAltChar s, s)
forall s. StringCells s => s -> Maybe (StringCellAltChar s, s)
safeAltUncons s
_s
    safeAltUnsnoc :: GenString -> Maybe (GenString, StringCellAltChar GenString)
safeAltUnsnoc GenString
_s = case GenString
_s of
        (GenString s
_s) -> (\(s
s', StringCellAltChar s
c) -> (s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s', GenString
genStringPhantom GenString -> Tagged GenString Word8 -> Word8
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellAltChar s
-> Tagged GenString (StringCellAltChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellAltChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellAltChar s)
toAltChar StringCellAltChar s
c)) ((s, StringCellAltChar s) -> (GenString, Word8))
-> Maybe (s, StringCellAltChar s) -> Maybe (GenString, Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe (s, StringCellAltChar s)
forall s. StringCells s => s -> Maybe (s, StringCellAltChar s)
safeAltUnsnoc s
_s
    safeHead :: GenString -> Maybe (StringCellChar GenString)
safeHead GenString
_s = case GenString
_s of
        (GenString s
_s) -> (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf`) (Tagged GenString Char -> Char)
-> (StringCellChar s -> Tagged GenString Char)
-> StringCellChar s
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringCellChar s -> Tagged GenString Char
StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar (StringCellChar s -> Char)
-> Maybe (StringCellChar s) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe (StringCellChar s)
forall s. StringCells s => s -> Maybe (StringCellChar s)
safeHead s
_s
    safeTail :: GenString -> Maybe GenString
safeTail GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> Maybe s -> Maybe GenString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe s
forall s. StringCells s => s -> Maybe s
safeTail s
_s
    safeLast :: GenString -> Maybe (StringCellChar GenString)
safeLast GenString
_s = case GenString
_s of
        (GenString s
_s) -> (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf`) (Tagged GenString Char -> Char)
-> (StringCellChar s -> Tagged GenString Char)
-> StringCellChar s
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringCellChar s -> Tagged GenString Char
StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar (StringCellChar s -> Char)
-> Maybe (StringCellChar s) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe (StringCellChar s)
forall s. StringCells s => s -> Maybe (StringCellChar s)
safeLast s
_s
    safeInit :: GenString -> Maybe GenString
safeInit GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> Maybe s -> Maybe GenString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe s
forall s. StringCells s => s -> Maybe s
safeInit s
_s
    safeAltHead :: GenString -> Maybe (StringCellAltChar GenString)
safeAltHead GenString
_s = case GenString
_s of
        (GenString s
_s) -> (GenString
genStringPhantom GenString -> Tagged GenString Word8 -> Word8
forall s b. s -> Tagged s b -> b
`untagTypeOf`) (Tagged GenString Word8 -> Word8)
-> (StringCellAltChar s -> Tagged GenString Word8)
-> StringCellAltChar s
-> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringCellAltChar s -> Tagged GenString Word8
StringCellAltChar s
-> Tagged GenString (StringCellAltChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellAltChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellAltChar s)
toAltChar  (StringCellAltChar s -> Word8)
-> Maybe (StringCellAltChar s) -> Maybe Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe (StringCellAltChar s)
forall s. StringCells s => s -> Maybe (StringCellAltChar s)
safeAltHead s
_s
    safeAltLast :: GenString -> Maybe (StringCellAltChar GenString)
safeAltLast GenString
_s = case GenString
_s of
        (GenString s
_s) -> (GenString
genStringPhantom GenString -> Tagged GenString Word8 -> Word8
forall s b. s -> Tagged s b -> b
`untagTypeOf`) (Tagged GenString Word8 -> Word8)
-> (StringCellAltChar s -> Tagged GenString Word8)
-> StringCellAltChar s
-> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringCellAltChar s -> Tagged GenString Word8
StringCellAltChar s
-> Tagged GenString (StringCellAltChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellAltChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellAltChar s)
toAltChar  (StringCellAltChar s -> Word8)
-> Maybe (StringCellAltChar s) -> Maybe Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe (StringCellAltChar s)
forall s. StringCells s => s -> Maybe (StringCellAltChar s)
safeAltLast s
_s
    safeIndex :: GenString -> Int -> Maybe (StringCellChar GenString)
safeIndex GenString
_s Int
i = case GenString
_s of
        (GenString s
_s) -> (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf`) (Tagged GenString Char -> Char)
-> (StringCellChar s -> Tagged GenString Char)
-> StringCellChar s
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringCellChar s -> Tagged GenString Char
StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar (StringCellChar s -> Char)
-> Maybe (StringCellChar s) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Int -> Maybe (StringCellChar s)
forall s. StringCells s => s -> Int -> Maybe (StringCellChar s)
safeIndex s
_s Int
i
    safeIndex64 :: GenString -> Int64 -> Maybe (StringCellChar GenString)
safeIndex64 GenString
_s Int64
i = case GenString
_s of
        (GenString s
_s) -> (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf`) (Tagged GenString Char -> Char)
-> (StringCellChar s -> Tagged GenString Char)
-> StringCellChar s
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringCellChar s -> Tagged GenString Char
StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar (StringCellChar s -> Char)
-> Maybe (StringCellChar s) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Int64 -> Maybe (StringCellChar s)
forall s. StringCells s => s -> Int64 -> Maybe (StringCellChar s)
safeIndex64 s
_s Int64
i
    safeGenericIndex :: forall i.
Integral i =>
GenString -> i -> Maybe (StringCellChar GenString)
safeGenericIndex GenString
_s i
i = case GenString
_s of
        (GenString s
_s) -> (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf`) (Tagged GenString Char -> Char)
-> (StringCellChar s -> Tagged GenString Char)
-> StringCellChar s
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringCellChar s -> Tagged GenString Char
StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar (StringCellChar s -> Char)
-> Maybe (StringCellChar s) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> i -> Maybe (StringCellChar s)
forall i. Integral i => s -> i -> Maybe (StringCellChar s)
forall s i.
(StringCells s, Integral i) =>
s -> i -> Maybe (StringCellChar s)
safeGenericIndex s
_s i
i
    safeTake :: Int -> GenString -> Maybe GenString
safeTake Int
n GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> Maybe s -> Maybe GenString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> s -> Maybe s
forall s. StringCells s => Int -> s -> Maybe s
safeTake Int
n s
_s
    safeTake64 :: Int64 -> GenString -> Maybe GenString
safeTake64 Int64
n GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> Maybe s -> Maybe GenString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> s -> Maybe s
forall s. StringCells s => Int64 -> s -> Maybe s
safeTake64 Int64
n s
_s
    safeGenericTake :: forall i. Integral i => i -> GenString -> Maybe GenString
safeGenericTake i
n GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> Maybe s -> Maybe GenString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> s -> Maybe s
forall i. Integral i => i -> s -> Maybe s
forall s i. (StringCells s, Integral i) => i -> s -> Maybe s
safeGenericTake i
n s
_s
    safeDrop :: Int -> GenString -> Maybe GenString
safeDrop Int
n GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> Maybe s -> Maybe GenString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> s -> Maybe s
forall s. StringCells s => Int -> s -> Maybe s
safeDrop Int
n s
_s
    safeDrop64 :: Int64 -> GenString -> Maybe GenString
safeDrop64 Int64
n GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> Maybe s -> Maybe GenString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> s -> Maybe s
forall s. StringCells s => Int64 -> s -> Maybe s
safeDrop64 Int64
n s
_s
    safeGenericDrop :: forall i. Integral i => i -> GenString -> Maybe GenString
safeGenericDrop i
n GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> Maybe s -> Maybe GenString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> s -> Maybe s
forall i. Integral i => i -> s -> Maybe s
forall s i. (StringCells s, Integral i) => i -> s -> Maybe s
safeGenericDrop i
n s
_s
    safeUncons2 :: GenString
-> Maybe
     (StringCellChar GenString, StringCellChar GenString, GenString)
safeUncons2 GenString
_s = case GenString
_s of
        (GenString s
_s) -> (\(StringCellChar s
a, StringCellChar s
b, s
s') -> (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
a, GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
b, s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s')) ((StringCellChar s, StringCellChar s, s)
 -> (Char, Char, GenString))
-> Maybe (StringCellChar s, StringCellChar s, s)
-> Maybe (Char, Char, GenString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe (StringCellChar s, StringCellChar s, s)
forall s.
StringCells s =>
s -> Maybe (StringCellChar s, StringCellChar s, s)
safeUncons2 s
_s
    safeUncons3 :: GenString
-> Maybe
     (StringCellChar GenString, StringCellChar GenString,
      StringCellChar GenString, GenString)
safeUncons3 GenString
_s = case GenString
_s of
        (GenString s
_s) -> (\(StringCellChar s
a, StringCellChar s
b, StringCellChar s
c, s
s') -> (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
a, GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
b, GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
c, s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s')) ((StringCellChar s, StringCellChar s, StringCellChar s, s)
 -> (Char, Char, Char, GenString))
-> Maybe (StringCellChar s, StringCellChar s, StringCellChar s, s)
-> Maybe (Char, Char, Char, GenString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s
-> Maybe (StringCellChar s, StringCellChar s, StringCellChar s, s)
forall s.
StringCells s =>
s
-> Maybe (StringCellChar s, StringCellChar s, StringCellChar s, s)
safeUncons3 s
_s
    safeUncons4 :: GenString
-> Maybe
     (StringCellChar GenString, StringCellChar GenString,
      StringCellChar GenString, StringCellChar GenString, GenString)
safeUncons4 GenString
_s = case GenString
_s of
        (GenString s
_s) -> (\(StringCellChar s
a, StringCellChar s
b, StringCellChar s
c, StringCellChar s
d, s
s') -> (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
a, GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
b, GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
c, GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
d, s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s')) ((StringCellChar s, StringCellChar s, StringCellChar s,
  StringCellChar s, s)
 -> (Char, Char, Char, Char, GenString))
-> Maybe
     (StringCellChar s, StringCellChar s, StringCellChar s,
      StringCellChar s, s)
-> Maybe (Char, Char, Char, Char, GenString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s
-> Maybe
     (StringCellChar s, StringCellChar s, StringCellChar s,
      StringCellChar s, s)
forall s.
StringCells s =>
s
-> Maybe
     (StringCellChar s, StringCellChar s, StringCellChar s,
      StringCellChar s, s)
safeUncons4 s
_s

    cons2 :: StringCellChar GenString
-> StringCellChar GenString -> GenString -> GenString
cons2 StringCellChar GenString
a StringCellChar GenString
b GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ StringCellChar s -> StringCellChar s -> s -> s
forall s.
StringCells s =>
StringCellChar s -> StringCellChar s -> s -> s
cons2 (s
_s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` Char -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar Char
StringCellChar GenString
a) (s
_s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` Char -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar Char
StringCellChar GenString
b) s
_s
    cons3 :: StringCellChar GenString
-> StringCellChar GenString
-> StringCellChar GenString
-> GenString
-> GenString
cons3 StringCellChar GenString
a StringCellChar GenString
b StringCellChar GenString
c GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ StringCellChar s -> StringCellChar s -> StringCellChar s -> s -> s
forall s.
StringCells s =>
StringCellChar s -> StringCellChar s -> StringCellChar s -> s -> s
cons3 (s
_s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` Char -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar Char
StringCellChar GenString
a) (s
_s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` Char -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar Char
StringCellChar GenString
b) (s
_s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` Char -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar Char
StringCellChar GenString
c) s
_s
    cons4 :: StringCellChar GenString
-> StringCellChar GenString
-> StringCellChar GenString
-> StringCellChar GenString
-> GenString
-> GenString
cons4 StringCellChar GenString
a StringCellChar GenString
b StringCellChar GenString
c StringCellChar GenString
d GenString
_s = case GenString
_s of
        (GenString s
_s) -> s -> GenString
forall s. Stringy s => s -> GenString
GenString (s -> GenString) -> s -> GenString
forall a b. (a -> b) -> a -> b
$ StringCellChar s
-> StringCellChar s
-> StringCellChar s
-> StringCellChar s
-> s
-> s
forall s.
StringCells s =>
StringCellChar s
-> StringCellChar s
-> StringCellChar s
-> StringCellChar s
-> s
-> s
cons4 (s
_s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` Char -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar Char
StringCellChar GenString
a) (s
_s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` Char -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar Char
StringCellChar GenString
b) (s
_s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` Char -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar Char
StringCellChar GenString
c) (s
_s s -> Tagged s (StringCellChar s) -> StringCellChar s
forall s b. s -> Tagged s b -> b
`untagTypeOf` Char -> Tagged s (StringCellChar s)
forall c. StringCell c => c -> Tagged s (StringCellChar s)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar Char
StringCellChar GenString
d) s
_s
    uncons2 :: GenString
-> (StringCellChar GenString, StringCellChar GenString, GenString)
uncons2 GenString
_s = case GenString
_s of
        (GenString s
_s) -> let (StringCellChar s
a, StringCellChar s
b, s
s') = s -> (StringCellChar s, StringCellChar s, s)
forall s.
StringCells s =>
s -> (StringCellChar s, StringCellChar s, s)
uncons2 s
_s
                          in  (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
a, GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
b, s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s')
    uncons3 :: GenString
-> (StringCellChar GenString, StringCellChar GenString,
    StringCellChar GenString, GenString)
uncons3 GenString
_s = case GenString
_s of
        (GenString s
_s) -> let (StringCellChar s
a, StringCellChar s
b, StringCellChar s
c, s
s') = s -> (StringCellChar s, StringCellChar s, StringCellChar s, s)
forall s.
StringCells s =>
s -> (StringCellChar s, StringCellChar s, StringCellChar s, s)
uncons3 s
_s
                          in  (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
a, GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
b, GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
c, s -> GenString
forall s. Stringy s => s -> GenString
GenString s
s')
    uncons4 :: GenString
-> (StringCellChar GenString, StringCellChar GenString,
    StringCellChar GenString, StringCellChar GenString, GenString)
uncons4 GenString
_s = case GenString
_s of
        (GenString s
_s) -> let (StringCellChar s
a, StringCellChar s
b, StringCellChar s
c, StringCellChar s
d, s
s') = s
-> (StringCellChar s, StringCellChar s, StringCellChar s,
    StringCellChar s, s)
forall s.
StringCells s =>
s
-> (StringCellChar s, StringCellChar s, StringCellChar s,
    StringCellChar s, s)
uncons4 s
_s
                          in  (GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
a, GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
b, GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
c, GenString
genStringPhantom GenString -> Tagged GenString Char -> Char
forall s b. s -> Tagged s b -> b
`untagTypeOf` StringCellChar s -> Tagged GenString (StringCellChar GenString)
forall c.
StringCell c =>
c -> Tagged GenString (StringCellChar GenString)
forall s c.
(StringCells s, StringCell c) =>
c -> Tagged s (StringCellChar s)
toMainChar StringCellChar s
d, s -> GenString
forall s. Stringy s => s -> GenString
GenString s
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 :: forall s b. s -> Tagged s b -> b
untagTypeOf s
_ = Tagged s b -> b
forall {k} (s :: k) b. Tagged s b -> b
untag

-- | Phantom, undefined value only used for convenience
--
-- Users should be careful that this value is never evaluated when using this.
genStringPhantom :: GenString
genStringPhantom :: GenString
genStringPhantom = GenString
forall a. HasCallStack => a
undefined

-- | This type is used by 'GenString' when a concrete string type is needed
type GenStringDefault = L.ByteString