{-# LANGUAGE CPP
,MultiParamTypeClasses
,FlexibleInstances
,TypeFamilies
,TypeSynonymInstances
,UndecidableInstances #-}
{-# OPTIONS -fno-warn-orphans #-}
module Data.ListLike.UTF8 () where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as BSLC
import Data.ListLike.Base as LL
import Data.ListLike.FoldableLL
import Data.ListLike.IO
import Data.ListLike.String (StringLike(..))
import Data.Maybe (fromMaybe)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
#if !MIN_VERSION_utf8_string(1,0,2)
import Data.String (IsString(fromString))
#endif
import Data.String.UTF8 (UTF8)
import qualified Data.String.UTF8 as UTF8
import GHC.Exts (IsList(..))
#if 0
utf8rnf :: NFData a => UTF8 a -> ()
utf8rnf = rnf . UTF8.toRep
#endif
instance FoldableLL (UTF8 BS.ByteString) Char where
foldl :: forall a. (a -> Char -> a) -> a -> UTF8 ByteString -> a
foldl = forall string index a.
UTF8Bytes string index =>
(a -> Char -> a) -> a -> UTF8 string -> a
UTF8.foldl
foldr :: forall b. (Char -> b -> b) -> b -> UTF8 ByteString -> b
foldr = forall string index a.
UTF8Bytes string index =>
(Char -> a -> a) -> a -> UTF8 string -> a
UTF8.foldr
instance IsList (UTF8 BS.ByteString) where
type Item (UTF8 BS.ByteString) = Char
toList :: UTF8 ByteString -> [Item (UTF8 ByteString)]
toList = forall string index.
UTF8Bytes string index =>
UTF8 string -> String
UTF8.toString
fromList :: [Item (UTF8 ByteString)] -> UTF8 ByteString
fromList = forall full item. ListLike full item => [item] -> full
LL.fromList'
instance ListLike (UTF8 BS.ByteString) Char where
empty :: UTF8 ByteString
empty = forall a. Monoid a => a
mempty
singleton :: Char -> UTF8 ByteString
singleton Char
c = forall string index.
UTF8Bytes string index =>
String -> UTF8 string
UTF8.fromString [Char
c]
uncons :: UTF8 ByteString -> Maybe (Char, UTF8 ByteString)
uncons = forall string index.
UTF8Bytes string index =>
UTF8 string -> Maybe (Char, UTF8 string)
UTF8.uncons
head :: UTF8 ByteString -> Char
head = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"head") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall full item. ListLike full item => full -> Maybe (item, full)
uncons
tail :: UTF8 ByteString -> UTF8 ByteString
tail = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"tail") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall full item. ListLike full item => full -> Maybe (item, full)
uncons
null :: UTF8 ByteString -> Bool
null UTF8 ByteString
s = forall string index. UTF8Bytes string index => UTF8 string -> index
UTF8.length UTF8 ByteString
s forall a. Eq a => a -> a -> Bool
== Int
0
length :: UTF8 ByteString -> Int
length = forall string index. UTF8Bytes string index => UTF8 string -> index
UTF8.length
take :: Int -> UTF8 ByteString -> UTF8 ByteString
take = forall string index.
UTF8Bytes string index =>
index -> UTF8 string -> UTF8 string
UTF8.take
drop :: Int -> UTF8 ByteString -> UTF8 ByteString
drop = forall string index.
UTF8Bytes string index =>
index -> UTF8 string -> UTF8 string
UTF8.drop
splitAt :: Int -> UTF8 ByteString -> (UTF8 ByteString, UTF8 ByteString)
splitAt = forall string index.
UTF8Bytes string index =>
index -> UTF8 string -> (UTF8 string, UTF8 string)
UTF8.splitAt
span :: (Char -> Bool)
-> UTF8 ByteString -> (UTF8 ByteString, UTF8 ByteString)
span = forall string index.
UTF8Bytes string index =>
(Char -> Bool) -> UTF8 string -> (UTF8 string, UTF8 string)
UTF8.span
break :: (Char -> Bool)
-> UTF8 ByteString -> (UTF8 ByteString, UTF8 ByteString)
break = forall string index.
UTF8Bytes string index =>
(Char -> Bool) -> UTF8 string -> (UTF8 string, UTF8 string)
UTF8.break
instance ListLikeIO (UTF8 BS.ByteString) Char where
hGetLine :: Handle -> IO (UTF8 ByteString)
hGetLine Handle
h = forall string. string -> UTF8 string
UTF8.fromRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
BSC.hGetLine Handle
h
hGetContents :: Handle -> IO (UTF8 ByteString)
hGetContents Handle
h = forall string. string -> UTF8 string
UTF8.fromRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
BS.hGetContents Handle
h
hGet :: Handle -> Int -> IO (UTF8 ByteString)
hGet Handle
h Int
n = forall string. string -> UTF8 string
UTF8.fromRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
BS.hGet Handle
h Int
n
hGetNonBlocking :: Handle -> Int -> IO (UTF8 ByteString)
hGetNonBlocking Handle
h Int
n = forall string. string -> UTF8 string
UTF8.fromRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
BS.hGetNonBlocking Handle
h Int
n
hPutStr :: Handle -> UTF8 ByteString -> IO ()
hPutStr Handle
h UTF8 ByteString
s = Handle -> ByteString -> IO ()
BS.hPutStr Handle
h (forall string. UTF8 string -> string
UTF8.toRep UTF8 ByteString
s)
hPutStrLn :: Handle -> UTF8 ByteString -> IO ()
hPutStrLn Handle
h UTF8 ByteString
s = Handle -> ByteString -> IO ()
BSC.hPutStrLn Handle
h (forall string. UTF8 string -> string
UTF8.toRep UTF8 ByteString
s)
#if !MIN_VERSION_utf8_string(1,0,2)
instance IsString (UTF8 BS.ByteString) where
fromString = UTF8.fromString
#endif
instance StringLike (UTF8 BS.ByteString) where
toString :: UTF8 ByteString -> String
toString = forall string index.
UTF8Bytes string index =>
UTF8 string -> String
UTF8.toString
instance Semigroup (UTF8 BS.ByteString) where
UTF8 ByteString
a <> :: UTF8 ByteString -> UTF8 ByteString -> UTF8 ByteString
<> UTF8 ByteString
b = forall string. string -> UTF8 string
UTF8.fromRep forall a b. (a -> b) -> a -> b
$ forall string. UTF8 string -> string
UTF8.toRep UTF8 ByteString
a forall a. Semigroup a => a -> a -> a
<> forall string. UTF8 string -> string
UTF8.toRep UTF8 ByteString
b
instance Monoid (UTF8 BS.ByteString) where
mempty :: UTF8 ByteString
mempty = forall string index.
UTF8Bytes string index =>
String -> UTF8 string
UTF8.fromString []
mappend :: UTF8 ByteString -> UTF8 ByteString -> UTF8 ByteString
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance FoldableLL (UTF8 BSL.ByteString) Char where
foldl :: forall a. (a -> Char -> a) -> a -> UTF8 ByteString -> a
foldl = forall string index a.
UTF8Bytes string index =>
(a -> Char -> a) -> a -> UTF8 string -> a
UTF8.foldl
foldr :: forall b. (Char -> b -> b) -> b -> UTF8 ByteString -> b
foldr = forall string index a.
UTF8Bytes string index =>
(Char -> a -> a) -> a -> UTF8 string -> a
UTF8.foldr
instance IsList (UTF8 BSL.ByteString) where
type Item (UTF8 BSL.ByteString) = Char
toList :: UTF8 ByteString -> [Item (UTF8 ByteString)]
toList = forall string index.
UTF8Bytes string index =>
UTF8 string -> String
UTF8.toString
fromList :: [Item (UTF8 ByteString)] -> UTF8 ByteString
fromList = forall full item. ListLike full item => [item] -> full
LL.fromList'
instance ListLike (UTF8 BSL.ByteString) Char where
empty :: UTF8 ByteString
empty = forall a. Monoid a => a
mempty
singleton :: Char -> UTF8 ByteString
singleton Char
c = forall string index.
UTF8Bytes string index =>
String -> UTF8 string
UTF8.fromString [Char
c]
uncons :: UTF8 ByteString -> Maybe (Char, UTF8 ByteString)
uncons = forall string index.
UTF8Bytes string index =>
UTF8 string -> Maybe (Char, UTF8 string)
UTF8.uncons
head :: UTF8 ByteString -> Char
head = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"head") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall full item. ListLike full item => full -> Maybe (item, full)
uncons
tail :: UTF8 ByteString -> UTF8 ByteString
tail = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"tail") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall full item. ListLike full item => full -> Maybe (item, full)
uncons
null :: UTF8 ByteString -> Bool
null UTF8 ByteString
s = forall string index. UTF8Bytes string index => UTF8 string -> index
UTF8.length UTF8 ByteString
s forall a. Eq a => a -> a -> Bool
== Int64
0
length :: UTF8 ByteString -> Int
length = forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string index. UTF8Bytes string index => UTF8 string -> index
UTF8.length
take :: Int -> UTF8 ByteString -> UTF8 ByteString
take = forall string index.
UTF8Bytes string index =>
index -> UTF8 string -> UTF8 string
UTF8.take forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger
drop :: Int -> UTF8 ByteString -> UTF8 ByteString
drop = forall string index.
UTF8Bytes string index =>
index -> UTF8 string -> UTF8 string
UTF8.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger
splitAt :: Int -> UTF8 ByteString -> (UTF8 ByteString, UTF8 ByteString)
splitAt = forall string index.
UTF8Bytes string index =>
index -> UTF8 string -> (UTF8 string, UTF8 string)
UTF8.splitAt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger
span :: (Char -> Bool)
-> UTF8 ByteString -> (UTF8 ByteString, UTF8 ByteString)
span = forall string index.
UTF8Bytes string index =>
(Char -> Bool) -> UTF8 string -> (UTF8 string, UTF8 string)
UTF8.span
break :: (Char -> Bool)
-> UTF8 ByteString -> (UTF8 ByteString, UTF8 ByteString)
break = forall string index.
UTF8Bytes string index =>
(Char -> Bool) -> UTF8 string -> (UTF8 string, UTF8 string)
UTF8.break
instance ListLikeIO (UTF8 BSL.ByteString) Char where
hGetLine :: Handle -> IO (UTF8 ByteString)
hGetLine Handle
h = (forall string. string -> UTF8 string
UTF8.fromRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
BSC.hGetLine Handle
h
hGetContents :: Handle -> IO (UTF8 ByteString)
hGetContents Handle
h = (forall string. string -> UTF8 string
UTF8.fromRep) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
BSL.hGetContents Handle
h
hGet :: Handle -> Int -> IO (UTF8 ByteString)
hGet Handle
h Int
n = forall string. string -> UTF8 string
UTF8.fromRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
BSL.hGet Handle
h Int
n
hGetNonBlocking :: Handle -> Int -> IO (UTF8 ByteString)
hGetNonBlocking Handle
h Int
n = forall string. string -> UTF8 string
UTF8.fromRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
BSL.hGetNonBlocking Handle
h Int
n
hPutStr :: Handle -> UTF8 ByteString -> IO ()
hPutStr Handle
h UTF8 ByteString
s = Handle -> ByteString -> IO ()
BSL.hPutStr Handle
h (forall string. UTF8 string -> string
UTF8.toRep UTF8 ByteString
s)
hPutStrLn :: Handle -> UTF8 ByteString -> IO ()
hPutStrLn Handle
h UTF8 ByteString
s = Handle -> ByteString -> IO ()
BSLC.hPutStrLn Handle
h (forall string. UTF8 string -> string
UTF8.toRep UTF8 ByteString
s)
#if !MIN_VERSION_utf8_string(1,0,2)
instance IsString (UTF8 BSL.ByteString) where
fromString = UTF8.fromString
#endif
instance StringLike (UTF8 BSL.ByteString) where
toString :: UTF8 ByteString -> String
toString = forall string index.
UTF8Bytes string index =>
UTF8 string -> String
UTF8.toString
instance Semigroup (UTF8 BSL.ByteString) where
UTF8 ByteString
a <> :: UTF8 ByteString -> UTF8 ByteString -> UTF8 ByteString
<> UTF8 ByteString
b = forall string. string -> UTF8 string
UTF8.fromRep forall a b. (a -> b) -> a -> b
$ forall string. UTF8 string -> string
UTF8.toRep UTF8 ByteString
a forall a. Semigroup a => a -> a -> a
<> forall string. UTF8 string -> string
UTF8.toRep UTF8 ByteString
b
instance Monoid (UTF8 BSL.ByteString) where
mempty :: UTF8 ByteString
mempty = forall string index.
UTF8Bytes string index =>
String -> UTF8 string
UTF8.fromString []
mappend :: UTF8 ByteString -> UTF8 ByteString -> UTF8 ByteString
mappend = forall a. Semigroup a => a -> a -> a
(<>)
{-# RULES "fromListLike/a" fromListLike = id :: a -> a #-}