{-# LANGUAGE PatternGuards, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

-- | ByteString wrappers which don't require special imports and are all UTF8 safe
module General.Str(
    Str, strPack, strUnpack, strNull, strCopy, strCons,
    BStr, bstrPack, bstrUnpack, bstrReadFile, bstrSplitInfix, bstrNull, bstrStripPrefix, bstrTrimStart,
    LBStr, lbstrPack, lbstrUnpack, lbstrToChunks, lbstrFromChunks,
    BStr0, bstr0Join, bstr0Split
    ) where

import qualified Foundation as Fdn
import qualified Foundation.Collection as Fdn
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.UTF8 as US
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Lazy.UTF8 as LUS
import Control.DeepSeq
import Data.Char
import Data.Data
import Data.List
import Data.Semigroup
import Data.String
import Prelude


newtype Str = Str {Str -> String
fromStr :: Fdn.String}
    deriving (Typeable Str
DataType
Constr
Typeable Str
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Str -> c Str)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Str)
-> (Str -> Constr)
-> (Str -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Str))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Str))
-> ((forall b. Data b => b -> b) -> Str -> Str)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Str -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Str -> r)
-> (forall u. (forall d. Data d => d -> u) -> Str -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Str -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Str -> m Str)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Str -> m Str)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Str -> m Str)
-> Data Str
Str -> DataType
Str -> Constr
(forall b. Data b => b -> b) -> Str -> Str
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Str -> c Str
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Str
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Str -> u
forall u. (forall d. Data d => d -> u) -> Str -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Str -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Str -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Str -> m Str
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Str -> m Str
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Str
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Str -> c Str
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Str)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Str)
$cStr :: Constr
$tStr :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Str -> m Str
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Str -> m Str
gmapMp :: (forall d. Data d => d -> m d) -> Str -> m Str
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Str -> m Str
gmapM :: (forall d. Data d => d -> m d) -> Str -> m Str
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Str -> m Str
gmapQi :: Int -> (forall d. Data d => d -> u) -> Str -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Str -> u
gmapQ :: (forall d. Data d => d -> u) -> Str -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Str -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Str -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Str -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Str -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Str -> r
gmapT :: (forall b. Data b => b -> b) -> Str -> Str
$cgmapT :: (forall b. Data b => b -> b) -> Str -> Str
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Str)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Str)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Str)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Str)
dataTypeOf :: Str -> DataType
$cdataTypeOf :: Str -> DataType
toConstr :: Str -> Constr
$ctoConstr :: Str -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Str
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Str
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Str -> c Str
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Str -> c Str
$cp1Data :: Typeable Str
Data,Typeable,Str -> Str -> Bool
(Str -> Str -> Bool) -> (Str -> Str -> Bool) -> Eq Str
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Str -> Str -> Bool
$c/= :: Str -> Str -> Bool
== :: Str -> Str -> Bool
$c== :: Str -> Str -> Bool
Eq,Eq Str
Eq Str
-> (Str -> Str -> Ordering)
-> (Str -> Str -> Bool)
-> (Str -> Str -> Bool)
-> (Str -> Str -> Bool)
-> (Str -> Str -> Bool)
-> (Str -> Str -> Str)
-> (Str -> Str -> Str)
-> Ord Str
Str -> Str -> Bool
Str -> Str -> Ordering
Str -> Str -> Str
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Str -> Str -> Str
$cmin :: Str -> Str -> Str
max :: Str -> Str -> Str
$cmax :: Str -> Str -> Str
>= :: Str -> Str -> Bool
$c>= :: Str -> Str -> Bool
> :: Str -> Str -> Bool
$c> :: Str -> Str -> Bool
<= :: Str -> Str -> Bool
$c<= :: Str -> Str -> Bool
< :: Str -> Str -> Bool
$c< :: Str -> Str -> Bool
compare :: Str -> Str -> Ordering
$ccompare :: Str -> Str -> Ordering
$cp1Ord :: Eq Str
Ord,b -> Str -> Str
NonEmpty Str -> Str
Str -> Str -> Str
(Str -> Str -> Str)
-> (NonEmpty Str -> Str)
-> (forall b. Integral b => b -> Str -> Str)
-> Semigroup Str
forall b. Integral b => b -> Str -> Str
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Str -> Str
$cstimes :: forall b. Integral b => b -> Str -> Str
sconcat :: NonEmpty Str -> Str
$csconcat :: NonEmpty Str -> Str
<> :: Str -> Str -> Str
$c<> :: Str -> Str -> Str
Semigroup,Semigroup Str
Str
Semigroup Str
-> Str -> (Str -> Str -> Str) -> ([Str] -> Str) -> Monoid Str
[Str] -> Str
Str -> Str -> Str
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Str] -> Str
$cmconcat :: [Str] -> Str
mappend :: Str -> Str -> Str
$cmappend :: Str -> Str -> Str
mempty :: Str
$cmempty :: Str
$cp1Monoid :: Semigroup Str
Monoid)

instance Show Str where show :: Str -> String
show = Str -> String
strUnpack
instance NFData Str where rnf :: Str -> ()
rnf Str
x = Str
x Str -> () -> ()
`seq` ()


type BStr = BS.ByteString

type LBStr = LBS.ByteString


strPack :: String -> Str
strPack :: String -> Str
strPack = String -> Str
Str (String -> Str) -> (String -> String) -> String -> Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. IsString a => String -> a
fromString

strUnpack :: Str -> String
strUnpack :: Str -> String
strUnpack = String -> String
forall l. IsList l => l -> [Item l]
Fdn.toList (String -> String) -> (Str -> String) -> Str -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> String
fromStr

strCons :: Char -> Str -> Str
strCons :: Char -> Str -> Str
strCons Char
c = String -> Str
Str (String -> Str) -> (Str -> String) -> Str -> Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element String -> String -> String
forall c. Sequential c => Element c -> c -> c
Fdn.cons Char
Element String
c (String -> String) -> (Str -> String) -> Str -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> String
fromStr

strCopy :: Str -> Str
strCopy :: Str -> Str
strCopy = String -> Str
Str (String -> Str) -> (Str -> String) -> Str -> Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Copy a => a -> a
Fdn.copy (String -> String) -> (Str -> String) -> Str -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> String
fromStr

strNull :: Str -> Bool
strNull :: Str -> Bool
strNull = String -> Bool
forall c. Collection c => c -> Bool
Fdn.null (String -> Bool) -> (Str -> String) -> Str -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> String
fromStr

bstrPack :: String -> BStr
bstrPack :: String -> BStr
bstrPack = String -> BStr
US.fromString

bstrUnpack :: BStr -> String
bstrUnpack :: BStr -> String
bstrUnpack = BStr -> String
US.toString

bstrReadFile :: FilePath -> IO BStr
bstrReadFile :: String -> IO BStr
bstrReadFile = String -> IO BStr
BS.readFile

bstrSplitInfix :: BStr -> BStr -> Maybe (BStr, BStr)
bstrSplitInfix :: BStr -> BStr -> Maybe (BStr, BStr)
bstrSplitInfix BStr
needle BStr
haystack
    | (BStr
a,BStr
b) <- BStr -> BStr -> (BStr, BStr)
BS.breakSubstring BStr
needle BStr
haystack
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ BStr -> Bool
BS.null BStr
b
    = (BStr, BStr) -> Maybe (BStr, BStr)
forall a. a -> Maybe a
Just (BStr
a, Int -> BStr -> BStr
BS.drop (BStr -> Int
BS.length BStr
needle) BStr
b)
bstrSplitInfix BStr
_ BStr
_ = Maybe (BStr, BStr)
forall a. Maybe a
Nothing

bstrNull :: BStr -> Bool
bstrNull :: BStr -> Bool
bstrNull = BStr -> Bool
BS.null

bstrStripPrefix :: BStr -> BStr -> Maybe BStr
bstrStripPrefix :: BStr -> BStr -> Maybe BStr
bstrStripPrefix BStr
needle BStr
x
    | BStr -> BStr -> Bool
BS.isPrefixOf BStr
needle BStr
x = BStr -> Maybe BStr
forall a. a -> Maybe a
Just (BStr -> Maybe BStr) -> BStr -> Maybe BStr
forall a b. (a -> b) -> a -> b
$ Int -> BStr -> BStr
BS.drop (BStr -> Int
BS.length BStr
needle) BStr
x
    | Bool
otherwise = Maybe BStr
forall a. Maybe a
Nothing

bstrTrimStart :: BStr -> BStr
bstrTrimStart :: BStr -> BStr
bstrTrimStart = (Char -> Bool) -> BStr -> BStr
BS.dropWhile Char -> Bool
isSpace

lbstrToChunks :: LBStr -> [BStr]
lbstrToChunks :: LBStr -> [BStr]
lbstrToChunks = LBStr -> [BStr]
LBS.toChunks

lbstrFromChunks :: [BStr] -> LBStr
lbstrFromChunks :: [BStr] -> LBStr
lbstrFromChunks = [BStr] -> LBStr
LBS.fromChunks

lbstrUnpack :: LBStr -> String
lbstrUnpack :: LBStr -> String
lbstrUnpack = LBStr -> String
LUS.toString

lbstrPack :: String -> LBStr
lbstrPack :: String -> LBStr
lbstrPack = String -> LBStr
LUS.fromString


type BStr0 = BStr

bstr0Join :: [String] -> BStr0
bstr0Join :: [String] -> BStr
bstr0Join = LBStr -> BStr
LBS.toStrict (LBStr -> BStr) -> ([String] -> LBStr) -> [String] -> BStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LBStr
LUS.fromString (String -> LBStr) -> ([String] -> String) -> [String] -> LBStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\0"

bstr0Split :: BStr0 -> [BStr]
bstr0Split :: BStr -> [BStr]
bstr0Split = Char -> BStr -> [BStr]
BS.split Char
'\0'