{-# LANGUAGE CPP, BangPatterns #-}
{-# OPTIONS_HADDOCK prune #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
module Data.ByteString.Char8 (
ByteString,
empty,
singleton,
pack,
unpack,
B.fromStrict,
B.toStrict,
cons,
snoc,
append,
head,
uncons,
unsnoc,
last,
tail,
init,
null,
length,
map,
reverse,
intersperse,
intercalate,
transpose,
foldl,
foldl',
foldl1,
foldl1',
foldr,
foldr',
foldr1,
foldr1',
concat,
concatMap,
any,
all,
maximum,
minimum,
scanl,
scanl1,
scanr,
scanr1,
mapAccumL,
mapAccumR,
replicate,
unfoldr,
unfoldrN,
take,
takeEnd,
drop,
dropEnd,
splitAt,
takeWhile,
takeWhileEnd,
dropWhile,
dropWhileEnd,
dropSpace,
span,
spanEnd,
break,
breakEnd,
group,
groupBy,
inits,
tails,
strip,
stripPrefix,
stripSuffix,
split,
splitWith,
lines,
words,
unlines,
unwords,
isPrefixOf,
isSuffixOf,
isInfixOf,
breakSubstring,
elem,
notElem,
find,
filter,
partition,
index,
indexMaybe,
(!?),
elemIndex,
elemIndices,
elemIndexEnd,
findIndex,
findIndices,
findIndexEnd,
count,
zip,
zipWith,
packZipWith,
unzip,
sort,
readInt,
readInteger,
copy,
packCString,
packCStringLen,
useAsCString,
useAsCStringLen,
getLine,
getContents,
putStr,
putStrLn,
interact,
readFile,
writeFile,
appendFile,
hGetLine,
hGetContents,
hGet,
hGetSome,
hGetNonBlocking,
hPut,
hPutNonBlocking,
hPutStr,
hPutStrLn,
) where
import qualified Prelude as P
import Prelude hiding (reverse,head,tail,last,init,null
,length,map,lines,foldl,foldr,unlines
,concat,any,take,drop,splitAt,takeWhile
,dropWhile,span,break,elem,filter,unwords
,words,maximum,minimum,all,concatMap
,scanl,scanl1,scanr,scanr1
,appendFile,readFile,writeFile
,foldl1,foldr1,replicate
,getContents,getLine,putStr,putStrLn,interact
,zip,zipWith,unzip,notElem)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Unsafe as B
import Data.ByteString (empty,null,length,tail,init,append
,inits,tails,reverse,transpose
,concat,take,takeEnd,drop,dropEnd,splitAt
,intercalate,sort,isPrefixOf,isSuffixOf
,isInfixOf,stripPrefix,stripSuffix
,breakSubstring,copy,group
,getLine, getContents, putStr, interact
,readFile, writeFile, appendFile
,hGetContents, hGet, hGetSome, hPut, hPutStr
,hGetLine, hGetNonBlocking, hPutNonBlocking
,packCString,packCStringLen
,useAsCString,useAsCStringLen
)
import Data.ByteString.Internal
#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative ((<$>))
#endif
import Data.Char ( isSpace )
#if MIN_VERSION_base(4,9,0)
import GHC.Char (eqChar)
#endif
import qualified Data.List as List (intersperse)
import System.IO (Handle,stdout)
import Foreign
singleton :: Char -> ByteString
singleton :: Char -> ByteString
singleton = Word8 -> ByteString
B.singleton (Word8 -> ByteString) -> (Char -> Word8) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE singleton #-}
pack :: String -> ByteString
pack :: String -> ByteString
pack = String -> ByteString
packChars
{-# INLINE pack #-}
unpack :: ByteString -> [Char]
unpack :: ByteString -> String
unpack = ByteString -> String
B.unpackChars
{-# INLINE unpack #-}
infixr 5 `cons`
infixl 5 `snoc`
cons :: Char -> ByteString -> ByteString
cons :: Char -> ByteString -> ByteString
cons = Word8 -> ByteString -> ByteString
B.cons (Word8 -> ByteString -> ByteString)
-> (Char -> Word8) -> Char -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE cons #-}
snoc :: ByteString -> Char -> ByteString
snoc :: ByteString -> Char -> ByteString
snoc ByteString
p = ByteString -> Word8 -> ByteString
B.snoc ByteString
p (Word8 -> ByteString) -> (Char -> Word8) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE snoc #-}
uncons :: ByteString -> Maybe (Char, ByteString)
uncons :: ByteString -> Maybe (Char, ByteString)
uncons ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> Maybe (Char, ByteString)
forall a. Maybe a
Nothing
Just (Word8
w, ByteString
bs') -> (Char, ByteString) -> Maybe (Char, ByteString)
forall a. a -> Maybe a
Just (Word8 -> Char
w2c Word8
w, ByteString
bs')
{-# INLINE uncons #-}
unsnoc :: ByteString -> Maybe (ByteString, Char)
unsnoc :: ByteString -> Maybe (ByteString, Char)
unsnoc ByteString
bs = case ByteString -> Maybe (ByteString, Word8)
B.unsnoc ByteString
bs of
Maybe (ByteString, Word8)
Nothing -> Maybe (ByteString, Char)
forall a. Maybe a
Nothing
Just (ByteString
bs', Word8
w) -> (ByteString, Char) -> Maybe (ByteString, Char)
forall a. a -> Maybe a
Just (ByteString
bs', Word8 -> Char
w2c Word8
w)
{-# INLINE unsnoc #-}
head :: ByteString -> Char
head :: ByteString -> Char
head = Word8 -> Char
w2c (Word8 -> Char) -> (ByteString -> Word8) -> ByteString -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word8
B.head
{-# INLINE head #-}
last :: ByteString -> Char
last :: ByteString -> Char
last = Word8 -> Char
w2c (Word8 -> Char) -> (ByteString -> Word8) -> ByteString -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word8
B.last
{-# INLINE last #-}
map :: (Char -> Char) -> ByteString -> ByteString
map :: (Char -> Char) -> ByteString -> ByteString
map Char -> Char
f = (Word8 -> Word8) -> ByteString -> ByteString
B.map (Char -> Word8
c2w (Char -> Word8) -> (Word8 -> Char) -> Word8 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
f (Char -> Char) -> (Word8 -> Char) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE map #-}
intersperse :: Char -> ByteString -> ByteString
intersperse :: Char -> ByteString -> ByteString
intersperse = Word8 -> ByteString -> ByteString
B.intersperse (Word8 -> ByteString -> ByteString)
-> (Char -> Word8) -> Char -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE intersperse #-}
foldl :: (a -> Char -> a) -> a -> ByteString -> a
foldl :: forall a. (a -> Char -> a) -> a -> ByteString -> a
foldl a -> Char -> a
f = (a -> Word8 -> a) -> a -> ByteString -> a
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl (\a
a Word8
c -> a -> Char -> a
f a
a (Word8 -> Char
w2c Word8
c))
{-# INLINE foldl #-}
foldl' :: (a -> Char -> a) -> a -> ByteString -> a
foldl' :: forall a. (a -> Char -> a) -> a -> ByteString -> a
foldl' a -> Char -> a
f = (a -> Word8 -> a) -> a -> ByteString -> a
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' (\a
a Word8
c -> a -> Char -> a
f a
a (Word8 -> Char
w2c Word8
c))
{-# INLINE foldl' #-}
foldr :: (Char -> a -> a) -> a -> ByteString -> a
foldr :: forall a. (Char -> a -> a) -> a -> ByteString -> a
foldr Char -> a -> a
f = (Word8 -> a -> a) -> a -> ByteString -> a
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
B.foldr (Char -> a -> a
f (Char -> a -> a) -> (Word8 -> Char) -> Word8 -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE foldr #-}
foldr' :: (Char -> a -> a) -> a -> ByteString -> a
foldr' :: forall a. (Char -> a -> a) -> a -> ByteString -> a
foldr' Char -> a -> a
f = (Word8 -> a -> a) -> a -> ByteString -> a
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
B.foldr' (Char -> a -> a
f (Char -> a -> a) -> (Word8 -> Char) -> Word8 -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE foldr' #-}
foldl1 :: (Char -> Char -> Char) -> ByteString -> Char
foldl1 :: (Char -> Char -> Char) -> ByteString -> Char
foldl1 Char -> Char -> Char
f ByteString
ps = Word8 -> Char
w2c ((Word8 -> Word8 -> Word8) -> ByteString -> Word8
B.foldl1 (\Word8
x Word8
y -> Char -> Word8
c2w (Char -> Char -> Char
f (Word8 -> Char
w2c Word8
x) (Word8 -> Char
w2c Word8
y))) ByteString
ps)
{-# INLINE foldl1 #-}
foldl1' :: (Char -> Char -> Char) -> ByteString -> Char
foldl1' :: (Char -> Char -> Char) -> ByteString -> Char
foldl1' Char -> Char -> Char
f ByteString
ps = Word8 -> Char
w2c ((Word8 -> Word8 -> Word8) -> ByteString -> Word8
B.foldl1' (\Word8
x Word8
y -> Char -> Word8
c2w (Char -> Char -> Char
f (Word8 -> Char
w2c Word8
x) (Word8 -> Char
w2c Word8
y))) ByteString
ps)
{-# INLINE foldl1' #-}
foldr1 :: (Char -> Char -> Char) -> ByteString -> Char
foldr1 :: (Char -> Char -> Char) -> ByteString -> Char
foldr1 Char -> Char -> Char
f ByteString
ps = Word8 -> Char
w2c ((Word8 -> Word8 -> Word8) -> ByteString -> Word8
B.foldr1 (\Word8
x Word8
y -> Char -> Word8
c2w (Char -> Char -> Char
f (Word8 -> Char
w2c Word8
x) (Word8 -> Char
w2c Word8
y))) ByteString
ps)
{-# INLINE foldr1 #-}
foldr1' :: (Char -> Char -> Char) -> ByteString -> Char
foldr1' :: (Char -> Char -> Char) -> ByteString -> Char
foldr1' Char -> Char -> Char
f ByteString
ps = Word8 -> Char
w2c ((Word8 -> Word8 -> Word8) -> ByteString -> Word8
B.foldr1' (\Word8
x Word8
y -> Char -> Word8
c2w (Char -> Char -> Char
f (Word8 -> Char
w2c Word8
x) (Word8 -> Char
w2c Word8
y))) ByteString
ps)
{-# INLINE foldr1' #-}
concatMap :: (Char -> ByteString) -> ByteString -> ByteString
concatMap :: (Char -> ByteString) -> ByteString -> ByteString
concatMap Char -> ByteString
f = (Word8 -> ByteString) -> ByteString -> ByteString
B.concatMap (Char -> ByteString
f (Char -> ByteString) -> (Word8 -> Char) -> Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE concatMap #-}
any :: (Char -> Bool) -> ByteString -> Bool
any :: (Char -> Bool) -> ByteString -> Bool
any Char -> Bool
f = (Word8 -> Bool) -> ByteString -> Bool
B.any (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE any #-}
all :: (Char -> Bool) -> ByteString -> Bool
all :: (Char -> Bool) -> ByteString -> Bool
all Char -> Bool
f = (Word8 -> Bool) -> ByteString -> Bool
B.all (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE all #-}
maximum :: ByteString -> Char
maximum :: ByteString -> Char
maximum = Word8 -> Char
w2c (Word8 -> Char) -> (ByteString -> Word8) -> ByteString -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word8
B.maximum
{-# INLINE maximum #-}
minimum :: ByteString -> Char
minimum :: ByteString -> Char
minimum = Word8 -> Char
w2c (Word8 -> Char) -> (ByteString -> Word8) -> ByteString -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word8
B.minimum
{-# INLINE minimum #-}
mapAccumL :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString)
mapAccumL :: forall acc.
(acc -> Char -> (acc, Char))
-> acc -> ByteString -> (acc, ByteString)
mapAccumL acc -> Char -> (acc, Char)
f = (acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
B.mapAccumL (\acc
acc Word8
w -> case acc -> Char -> (acc, Char)
f acc
acc (Word8 -> Char
w2c Word8
w) of (acc
acc', Char
c) -> (acc
acc', Char -> Word8
c2w Char
c))
mapAccumR :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString)
mapAccumR :: forall acc.
(acc -> Char -> (acc, Char))
-> acc -> ByteString -> (acc, ByteString)
mapAccumR acc -> Char -> (acc, Char)
f = (acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
B.mapAccumR (\acc
acc Word8
w -> case acc -> Char -> (acc, Char)
f acc
acc (Word8 -> Char
w2c Word8
w) of (acc
acc', Char
c) -> (acc
acc', Char -> Word8
c2w Char
c))
scanl :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString
scanl :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString
scanl Char -> Char -> Char
f Char
z = (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
B.scanl (\Word8
a Word8
b -> Char -> Word8
c2w (Char -> Char -> Char
f (Word8 -> Char
w2c Word8
a) (Word8 -> Char
w2c Word8
b))) (Char -> Word8
c2w Char
z)
scanl1 :: (Char -> Char -> Char) -> ByteString -> ByteString
scanl1 :: (Char -> Char -> Char) -> ByteString -> ByteString
scanl1 Char -> Char -> Char
f = (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
B.scanl1 (\Word8
a Word8
b -> Char -> Word8
c2w (Char -> Char -> Char
f (Word8 -> Char
w2c Word8
a) (Word8 -> Char
w2c Word8
b)))
scanr :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString
scanr :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString
scanr Char -> Char -> Char
f Char
z = (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
B.scanr (\Word8
a Word8
b -> Char -> Word8
c2w (Char -> Char -> Char
f (Word8 -> Char
w2c Word8
a) (Word8 -> Char
w2c Word8
b))) (Char -> Word8
c2w Char
z)
scanr1 :: (Char -> Char -> Char) -> ByteString -> ByteString
scanr1 :: (Char -> Char -> Char) -> ByteString -> ByteString
scanr1 Char -> Char -> Char
f = (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
B.scanr1 (\Word8
a Word8
b -> Char -> Word8
c2w (Char -> Char -> Char
f (Word8 -> Char
w2c Word8
a) (Word8 -> Char
w2c Word8
b)))
replicate :: Int -> Char -> ByteString
replicate :: Int -> Char -> ByteString
replicate Int
n = Int -> Word8 -> ByteString
B.replicate Int
n (Word8 -> ByteString) -> (Char -> Word8) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE replicate #-}
unfoldr :: (a -> Maybe (Char, a)) -> a -> ByteString
unfoldr :: forall a. (a -> Maybe (Char, a)) -> a -> ByteString
unfoldr a -> Maybe (Char, a)
f = (a -> Maybe (Word8, a)) -> a -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
B.unfoldr (((Char, a) -> (Word8, a)) -> Maybe (Char, a) -> Maybe (Word8, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, a) -> (Word8, a)
forall {b}. (Char, b) -> (Word8, b)
k (Maybe (Char, a) -> Maybe (Word8, a))
-> (a -> Maybe (Char, a)) -> a -> Maybe (Word8, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe (Char, a)
f)
where k :: (Char, b) -> (Word8, b)
k (Char
i, b
j) = (Char -> Word8
c2w Char
i, b
j)
unfoldrN :: Int -> (a -> Maybe (Char, a)) -> a -> (ByteString, Maybe a)
unfoldrN :: forall a.
Int -> (a -> Maybe (Char, a)) -> a -> (ByteString, Maybe a)
unfoldrN Int
n a -> Maybe (Char, a)
f = Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
B.unfoldrN Int
n (((Char, a) -> (Word8, a)
forall {b}. (Char, b) -> (Word8, b)
k ((Char, a) -> (Word8, a)) -> Maybe (Char, a) -> Maybe (Word8, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`) (Maybe (Char, a) -> Maybe (Word8, a))
-> (a -> Maybe (Char, a)) -> a -> Maybe (Word8, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe (Char, a)
f)
where k :: (Char, b) -> (Word8, b)
k (Char
i,b
j) = (Char -> Word8
c2w Char
i, b
j)
{-# INLINE unfoldrN #-}
takeWhile :: (Char -> Bool) -> ByteString -> ByteString
takeWhile :: (Char -> Bool) -> ByteString -> ByteString
takeWhile Char -> Bool
f = (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE takeWhile #-}
takeWhileEnd :: (Char -> Bool) -> ByteString -> ByteString
takeWhileEnd :: (Char -> Bool) -> ByteString -> ByteString
takeWhileEnd Char -> Bool
f = (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhileEnd (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE takeWhileEnd #-}
dropWhile :: (Char -> Bool) -> ByteString -> ByteString
dropWhile :: (Char -> Bool) -> ByteString -> ByteString
dropWhile Char -> Bool
f = (Word8 -> Bool) -> ByteString -> ByteString
B.dropWhile (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE [1] dropWhile #-}
{-# RULES
"ByteString specialise dropWhile isSpace -> dropSpace"
dropWhile isSpace = dropSpace
#-}
dropWhileEnd :: (Char -> Bool) -> ByteString -> ByteString
dropWhileEnd :: (Char -> Bool) -> ByteString -> ByteString
dropWhileEnd Char -> Bool
f = (Word8 -> Bool) -> ByteString -> ByteString
B.dropWhileEnd (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE dropWhileEnd #-}
break :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
break :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
break Char -> Bool
f = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE [1] break #-}
#if MIN_VERSION_base(4,9,0)
{-# RULES
"ByteString specialise break (x==)" forall x.
break (x `eqChar`) = breakChar x
"ByteString specialise break (==x)" forall x.
break (`eqChar` x) = breakChar x
#-}
#else
{-# RULES
"ByteString specialise break (x==)" forall x.
break (x ==) = breakChar x
"ByteString specialise break (==x)" forall x.
break (== x) = breakChar x
#-}
#endif
breakChar :: Char -> ByteString -> (ByteString, ByteString)
breakChar :: Char -> ByteString -> (ByteString, ByteString)
breakChar Char
c ByteString
p = case Char -> ByteString -> Maybe Int
elemIndex Char
c ByteString
p of
Maybe Int
Nothing -> (ByteString
p,ByteString
empty)
Just Int
n -> (Int -> ByteString -> ByteString
B.unsafeTake Int
n ByteString
p, Int -> ByteString -> ByteString
B.unsafeDrop Int
n ByteString
p)
{-# INLINE breakChar #-}
span :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
span :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
span Char -> Bool
f = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE span #-}
spanEnd :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
spanEnd :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
spanEnd Char -> Bool
f = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.spanEnd (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE spanEnd #-}
breakEnd :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
breakEnd :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
breakEnd Char -> Bool
f = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.breakEnd (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE breakEnd #-}
split :: Char -> ByteString -> [ByteString]
split :: Char -> ByteString -> [ByteString]
split = Word8 -> ByteString -> [ByteString]
B.split (Word8 -> ByteString -> [ByteString])
-> (Char -> Word8) -> Char -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE split #-}
splitWith :: (Char -> Bool) -> ByteString -> [ByteString]
splitWith :: (Char -> Bool) -> ByteString -> [ByteString]
splitWith Char -> Bool
f = (Word8 -> Bool) -> ByteString -> [ByteString]
B.splitWith (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE splitWith #-}
groupBy :: (Char -> Char -> Bool) -> ByteString -> [ByteString]
groupBy :: (Char -> Char -> Bool) -> ByteString -> [ByteString]
groupBy Char -> Char -> Bool
k = (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
B.groupBy (\Word8
a Word8
b -> Char -> Char -> Bool
k (Word8 -> Char
w2c Word8
a) (Word8 -> Char
w2c Word8
b))
index :: ByteString -> Int -> Char
index :: ByteString -> Int -> Char
index = (Word8 -> Char
w2c (Word8 -> Char) -> (Int -> Word8) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int -> Word8) -> Int -> Char)
-> (ByteString -> Int -> Word8) -> ByteString -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
B.index
{-# INLINE index #-}
indexMaybe :: ByteString -> Int -> Maybe Char
indexMaybe :: ByteString -> Int -> Maybe Char
indexMaybe = ((Word8 -> Char) -> Maybe Word8 -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Char
w2c (Maybe Word8 -> Maybe Char)
-> (Int -> Maybe Word8) -> Int -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int -> Maybe Word8) -> Int -> Maybe Char)
-> (ByteString -> Int -> Maybe Word8)
-> ByteString
-> Int
-> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Maybe Word8
B.indexMaybe
{-# INLINE indexMaybe #-}
(!?) :: ByteString -> Int -> Maybe Char
!? :: ByteString -> Int -> Maybe Char
(!?) = ByteString -> Int -> Maybe Char
indexMaybe
{-# INLINE (!?) #-}
elemIndex :: Char -> ByteString -> Maybe Int
elemIndex :: Char -> ByteString -> Maybe Int
elemIndex = Word8 -> ByteString -> Maybe Int
B.elemIndex (Word8 -> ByteString -> Maybe Int)
-> (Char -> Word8) -> Char -> ByteString -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE elemIndex #-}
elemIndexEnd :: Char -> ByteString -> Maybe Int
elemIndexEnd :: Char -> ByteString -> Maybe Int
elemIndexEnd = Word8 -> ByteString -> Maybe Int
B.elemIndexEnd (Word8 -> ByteString -> Maybe Int)
-> (Char -> Word8) -> Char -> ByteString -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE elemIndexEnd #-}
elemIndices :: Char -> ByteString -> [Int]
elemIndices :: Char -> ByteString -> [Int]
elemIndices = Word8 -> ByteString -> [Int]
B.elemIndices (Word8 -> ByteString -> [Int])
-> (Char -> Word8) -> Char -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE elemIndices #-}
findIndex :: (Char -> Bool) -> ByteString -> Maybe Int
findIndex :: (Char -> Bool) -> ByteString -> Maybe Int
findIndex Char -> Bool
f = (Word8 -> Bool) -> ByteString -> Maybe Int
B.findIndex (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE [1] findIndex #-}
findIndexEnd :: (Char -> Bool) -> ByteString -> Maybe Int
findIndexEnd :: (Char -> Bool) -> ByteString -> Maybe Int
findIndexEnd Char -> Bool
f = (Word8 -> Bool) -> ByteString -> Maybe Int
B.findIndexEnd (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE [1] findIndexEnd #-}
findIndices :: (Char -> Bool) -> ByteString -> [Int]
findIndices :: (Char -> Bool) -> ByteString -> [Int]
findIndices Char -> Bool
f = (Word8 -> Bool) -> ByteString -> [Int]
B.findIndices (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE [1] findIndices #-}
#if MIN_VERSION_base(4,9,0)
{-# RULES
"ByteString specialise findIndex (x==)" forall x.
findIndex (x `eqChar`) = elemIndex x
"ByteString specialise findIndex (==x)" forall x.
findIndex (`eqChar` x) = elemIndex x
"ByteString specialise findIndices (x==)" forall x.
findIndices (x `eqChar`) = elemIndices x
"ByteString specialise findIndices (==x)" forall x.
findIndices (`eqChar` x) = elemIndices x
#-}
#else
{-# RULES
"ByteString specialise findIndex (x==)" forall x.
findIndex (x==) = elemIndex x
"ByteString specialise findIndex (==x)" forall x.
findIndex (==x) = elemIndex x
"ByteString specialise findIndices (x==)" forall x.
findIndices (x==) = elemIndices x
"ByteString specialise findIndices (==x)" forall x.
findIndices (==x) = elemIndices x
#-}
#endif
count :: Char -> ByteString -> Int
count :: Char -> ByteString -> Int
count Char
c = Word8 -> ByteString -> Int
B.count (Char -> Word8
c2w Char
c)
elem :: Char -> ByteString -> Bool
elem :: Char -> ByteString -> Bool
elem Char
c = Word8 -> ByteString -> Bool
B.elem (Char -> Word8
c2w Char
c)
{-# INLINE elem #-}
notElem :: Char -> ByteString -> Bool
notElem :: Char -> ByteString -> Bool
notElem Char
c = Word8 -> ByteString -> Bool
B.notElem (Char -> Word8
c2w Char
c)
{-# INLINE notElem #-}
filter :: (Char -> Bool) -> ByteString -> ByteString
filter :: (Char -> Bool) -> ByteString -> ByteString
filter Char -> Bool
f = (Word8 -> Bool) -> ByteString -> ByteString
B.filter (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE filter #-}
partition :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
partition :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
partition Char -> Bool
f = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.partition (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE partition #-}
find :: (Char -> Bool) -> ByteString -> Maybe Char
find :: (Char -> Bool) -> ByteString -> Maybe Char
find Char -> Bool
f ByteString
ps = Word8 -> Char
w2c (Word8 -> Char) -> Maybe Word8 -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Word8 -> Bool) -> ByteString -> Maybe Word8
B.find (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c) ByteString
ps
{-# INLINE find #-}
zip :: ByteString -> ByteString -> [(Char,Char)]
zip :: ByteString -> ByteString -> [(Char, Char)]
zip ByteString
ps ByteString
qs = case ByteString -> Maybe (Char, ByteString)
uncons ByteString
ps of
Maybe (Char, ByteString)
Nothing -> []
Just (Char
psH, ByteString
psT) -> case ByteString -> Maybe (Char, ByteString)
uncons ByteString
qs of
Maybe (Char, ByteString)
Nothing -> []
Just (Char
qsH, ByteString
qsT) -> (Char
psH, Char
qsH) (Char, Char) -> [(Char, Char)] -> [(Char, Char)]
forall a. a -> [a] -> [a]
: ByteString -> ByteString -> [(Char, Char)]
zip ByteString
psT ByteString
qsT
zipWith :: (Char -> Char -> a) -> ByteString -> ByteString -> [a]
zipWith :: forall a. (Char -> Char -> a) -> ByteString -> ByteString -> [a]
zipWith Char -> Char -> a
f = (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
B.zipWith (((Char -> a) -> (Word8 -> Char) -> Word8 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c) ((Char -> a) -> Word8 -> a)
-> (Word8 -> Char -> a) -> Word8 -> Word8 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> a
f (Char -> Char -> a) -> (Word8 -> Char) -> Word8 -> Char -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
packZipWith :: (Char -> Char -> Char) -> ByteString -> ByteString -> ByteString
packZipWith :: (Char -> Char -> Char) -> ByteString -> ByteString -> ByteString
packZipWith Char -> Char -> Char
f = (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
B.packZipWith Word8 -> Word8 -> Word8
f'
where
f' :: Word8 -> Word8 -> Word8
f' Word8
c1 Word8
c2 = Char -> Word8
c2w (Char -> Word8) -> Char -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Char
f (Word8 -> Char
w2c Word8
c1) (Word8 -> Char
w2c Word8
c2)
{-# INLINE packZipWith #-}
unzip :: [(Char,Char)] -> (ByteString,ByteString)
unzip :: [(Char, Char)] -> (ByteString, ByteString)
unzip [(Char, Char)]
ls = (String -> ByteString
pack (((Char, Char) -> Char) -> [(Char, Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
P.map (Char, Char) -> Char
forall a b. (a, b) -> a
fst [(Char, Char)]
ls), String -> ByteString
pack (((Char, Char) -> Char) -> [(Char, Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
P.map (Char, Char) -> Char
forall a b. (a, b) -> b
snd [(Char, Char)]
ls))
{-# INLINE unzip #-}
unsafeHead :: ByteString -> Char
unsafeHead :: ByteString -> Char
unsafeHead = Word8 -> Char
w2c (Word8 -> Char) -> (ByteString -> Word8) -> ByteString -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word8
B.unsafeHead
{-# INLINE unsafeHead #-}
{-# RULES
"ByteString specialise break -> breakSpace"
break isSpace = breakSpace
#-}
breakSpace :: ByteString -> (ByteString,ByteString)
breakSpace :: ByteString -> (ByteString, ByteString)
breakSpace (BS ForeignPtr Word8
x Int
l) = IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a. IO a -> a
accursedUnutterablePerformIO (IO (ByteString, ByteString) -> (ByteString, ByteString))
-> IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8
-> (Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString))
-> (Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Int
i <- Ptr Word8 -> Int -> Int -> IO Int
firstspace Ptr Word8
p Int
0 Int
l
(ByteString, ByteString) -> IO (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, ByteString) -> IO (ByteString, ByteString))
-> (ByteString, ByteString) -> IO (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$! case () of {()
_
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> (ByteString
empty, ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
x Int
l)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l -> (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
x Int
l, ByteString
empty)
| Bool
otherwise -> (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
x Int
i, ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
i) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i))
}
{-# INLINE breakSpace #-}
firstspace :: Ptr Word8 -> Int -> Int -> IO Int
firstspace :: Ptr Word8 -> Int -> Int -> IO Int
firstspace !Ptr Word8
ptr !Int
n !Int
m
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
| Bool
otherwise = do Word8
w <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
ptr Int
n
if (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
isSpaceWord8) Word8
w then Ptr Word8 -> Int -> Int -> IO Int
firstspace Ptr Word8
ptr (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
m else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
dropSpace :: ByteString -> ByteString
dropSpace :: ByteString -> ByteString
dropSpace (BS ForeignPtr Word8
x Int
l) = IO ByteString -> ByteString
forall a. IO a -> a
accursedUnutterablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Int
i <- Ptr Word8 -> Int -> Int -> IO Int
firstnonspace Ptr Word8
p Int
0 Int
l
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l then ByteString
empty else ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
i) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)
{-# INLINE dropSpace #-}
firstnonspace :: Ptr Word8 -> Int -> Int -> IO Int
firstnonspace :: Ptr Word8 -> Int -> Int -> IO Int
firstnonspace !Ptr Word8
ptr !Int
n !Int
m
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
| Bool
otherwise = do Word8
w <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
ptr Int
n
if Word8 -> Bool
isSpaceWord8 Word8
w then Ptr Word8 -> Int -> Int -> IO Int
firstnonspace Ptr Word8
ptr (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
m else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
strip :: ByteString -> ByteString
strip :: ByteString -> ByteString
strip = (Char -> Bool) -> ByteString -> ByteString
dropWhile Char -> Bool
isSpace (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
dropWhileEnd Char -> Bool
isSpace
lines :: ByteString -> [ByteString]
lines :: ByteString -> [ByteString]
lines ByteString
ps
| ByteString -> Bool
null ByteString
ps = []
| Bool
otherwise = case ByteString -> Maybe Int
search ByteString
ps of
Maybe Int
Nothing -> [ByteString
ps]
Just Int
n -> Int -> ByteString -> ByteString
take Int
n ByteString
ps ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
lines (Int -> ByteString -> ByteString
drop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ByteString
ps)
where search :: ByteString -> Maybe Int
search = Char -> ByteString -> Maybe Int
elemIndex Char
'\n'
unlines :: [ByteString] -> ByteString
unlines :: [ByteString] -> ByteString
unlines [] = ByteString
empty
unlines [ByteString]
ss = [ByteString] -> ByteString
concat (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
List.intersperse ByteString
nl [ByteString]
ss) ByteString -> ByteString -> ByteString
`append` ByteString
nl
where nl :: ByteString
nl = Char -> ByteString
singleton Char
'\n'
words :: ByteString -> [ByteString]
words :: ByteString -> [ByteString]
words = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
B.null) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> [ByteString]
B.splitWith Word8 -> Bool
isSpaceWord8
{-# INLINE words #-}
unwords :: [ByteString] -> ByteString
unwords :: [ByteString] -> ByteString
unwords = ByteString -> [ByteString] -> ByteString
intercalate (Char -> ByteString
singleton Char
' ')
{-# INLINE unwords #-}
readInt :: ByteString -> Maybe (Int, ByteString)
readInt :: ByteString -> Maybe (Int, ByteString)
readInt ByteString
as
| ByteString -> Bool
null ByteString
as = Maybe (Int, ByteString)
forall a. Maybe a
Nothing
| Bool
otherwise =
case ByteString -> Char
unsafeHead ByteString
as of
Char
'-' -> Bool -> Int -> Int -> ByteString -> Maybe (Int, ByteString)
loop Bool
True Int
0 Int
0 (ByteString -> ByteString
B.unsafeTail ByteString
as)
Char
'+' -> Bool -> Int -> Int -> ByteString -> Maybe (Int, ByteString)
loop Bool
False Int
0 Int
0 (ByteString -> ByteString
B.unsafeTail ByteString
as)
Char
_ -> Bool -> Int -> Int -> ByteString -> Maybe (Int, ByteString)
loop Bool
False Int
0 Int
0 ByteString
as
where loop :: Bool -> Int -> Int -> ByteString -> Maybe (Int, ByteString)
loop :: Bool -> Int -> Int -> ByteString -> Maybe (Int, ByteString)
loop Bool
neg !Int
i !Int
n !ByteString
ps
| ByteString -> Bool
null ByteString
ps = Bool -> Int -> Int -> ByteString -> Maybe (Int, ByteString)
forall {a} {a} {b}.
(Eq a, Num a, Num a) =>
Bool -> a -> a -> b -> Maybe (a, b)
end Bool
neg Int
i Int
n ByteString
ps
| Bool
otherwise =
case ByteString -> Word8
B.unsafeHead ByteString
ps of
Word8
w | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x30
Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x39 -> Bool -> Int -> Int -> ByteString -> Maybe (Int, ByteString)
loop Bool
neg (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
(Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x30))
(ByteString -> ByteString
B.unsafeTail ByteString
ps)
| Bool
otherwise -> Bool -> Int -> Int -> ByteString -> Maybe (Int, ByteString)
forall {a} {a} {b}.
(Eq a, Num a, Num a) =>
Bool -> a -> a -> b -> Maybe (a, b)
end Bool
neg Int
i Int
n ByteString
ps
end :: Bool -> a -> a -> b -> Maybe (a, b)
end Bool
_ a
0 a
_ b
_ = Maybe (a, b)
forall a. Maybe a
Nothing
end Bool
True a
_ a
n b
ps = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a -> a
forall a. Num a => a -> a
negate a
n, b
ps)
end Bool
_ a
_ a
n b
ps = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
n, b
ps)
readInteger :: ByteString -> Maybe (Integer, ByteString)
readInteger :: ByteString -> Maybe (Integer, ByteString)
readInteger ByteString
as
| ByteString -> Bool
null ByteString
as = Maybe (Integer, ByteString)
forall a. Maybe a
Nothing
| Bool
otherwise =
case ByteString -> Char
unsafeHead ByteString
as of
Char
'-' -> ByteString -> Maybe (Integer, ByteString)
first (ByteString -> ByteString
B.unsafeTail ByteString
as) Maybe (Integer, ByteString)
-> ((Integer, ByteString) -> Maybe (Integer, ByteString))
-> Maybe (Integer, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Integer
n, ByteString
bs) -> (Integer, ByteString) -> Maybe (Integer, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (-Integer
n, ByteString
bs)
Char
'+' -> ByteString -> Maybe (Integer, ByteString)
first (ByteString -> ByteString
B.unsafeTail ByteString
as)
Char
_ -> ByteString -> Maybe (Integer, ByteString)
first ByteString
as
where first :: ByteString -> Maybe (Integer, ByteString)
first ByteString
ps | ByteString -> Bool
null ByteString
ps = Maybe (Integer, ByteString)
forall a. Maybe a
Nothing
| Bool
otherwise =
case ByteString -> Word8
B.unsafeHead ByteString
ps of
Word8
w | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x30 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x39 -> (Integer, ByteString) -> Maybe (Integer, ByteString)
forall a. a -> Maybe a
Just ((Integer, ByteString) -> Maybe (Integer, ByteString))
-> (Integer, ByteString) -> Maybe (Integer, ByteString)
forall a b. (a -> b) -> a -> b
$
Int -> Int -> [Integer] -> ByteString -> (Integer, ByteString)
loop Int
1 (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x30) [] (ByteString -> ByteString
B.unsafeTail ByteString
ps)
| Bool
otherwise -> Maybe (Integer, ByteString)
forall a. Maybe a
Nothing
loop :: Int -> Int -> [Integer]
-> ByteString -> (Integer, ByteString)
loop :: Int -> Int -> [Integer] -> ByteString -> (Integer, ByteString)
loop !Int
d !Int
acc [Integer]
ns !ByteString
ps
| ByteString -> Bool
null ByteString
ps = Int -> Int -> [Integer] -> ByteString -> (Integer, ByteString)
forall {a} {b} {b}.
(Integral a, Integral b) =>
b -> a -> [Integer] -> b -> (Integer, b)
combine Int
d Int
acc [Integer]
ns ByteString
empty
| Bool
otherwise =
case ByteString -> Word8
B.unsafeHead ByteString
ps of
Word8
w | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x30 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x39 ->
if Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9 then Int -> Int -> [Integer] -> ByteString -> (Integer, ByteString)
loop Int
1 (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x30)
(Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
acc Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ns)
(ByteString -> ByteString
B.unsafeTail ByteString
ps)
else Int -> Int -> [Integer] -> ByteString -> (Integer, ByteString)
loop (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
(Int
10Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x30))
[Integer]
ns (ByteString -> ByteString
B.unsafeTail ByteString
ps)
| Bool
otherwise -> Int -> Int -> [Integer] -> ByteString -> (Integer, ByteString)
forall {a} {b} {b}.
(Integral a, Integral b) =>
b -> a -> [Integer] -> b -> (Integer, b)
combine Int
d Int
acc [Integer]
ns ByteString
ps
combine :: b -> a -> [Integer] -> b -> (Integer, b)
combine b
_ a
acc [] b
ps = (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
acc, b
ps)
combine b
d a
acc [Integer]
ns b
ps =
(Integer
10Integer -> b -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^b
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> [Integer] -> Integer
forall {t}. Num t => t -> [t] -> t
combine1 Integer
1000000000 [Integer]
ns Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ a -> Integer
forall a. Integral a => a -> Integer
toInteger a
acc, b
ps)
combine1 :: t -> [t] -> t
combine1 t
_ [t
n] = t
n
combine1 t
b [t]
ns = t -> [t] -> t
combine1 (t
bt -> t -> t
forall a. Num a => a -> a -> a
*t
b) ([t] -> t) -> [t] -> t
forall a b. (a -> b) -> a -> b
$ t -> [t] -> [t]
forall {t}. Num t => t -> [t] -> [t]
combine2 t
b [t]
ns
combine2 :: t -> [t] -> [t]
combine2 t
b (t
n:t
m:[t]
ns) = let !t :: t
t = t
mt -> t -> t
forall a. Num a => a -> a -> a
*t
b t -> t -> t
forall a. Num a => a -> a -> a
+ t
n in t
t t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t] -> [t]
combine2 t
b [t]
ns
combine2 t
_ [t]
ns = [t]
ns
hPutStrLn :: Handle -> ByteString -> IO ()
hPutStrLn :: Handle -> ByteString -> IO ()
hPutStrLn Handle
h ByteString
ps
| ByteString -> Int
length ByteString
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1024 = Handle -> ByteString -> IO ()
hPut Handle
h (ByteString
ps ByteString -> Word8 -> ByteString
`B.snoc` Word8
0x0a)
| Bool
otherwise = Handle -> ByteString -> IO ()
hPut Handle
h ByteString
ps IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> ByteString -> IO ()
hPut Handle
h (Word8 -> ByteString
B.singleton Word8
0x0a)
putStrLn :: ByteString -> IO ()
putStrLn :: ByteString -> IO ()
putStrLn = Handle -> ByteString -> IO ()
hPutStrLn Handle
stdout