{-# LANGUAGE CPP, BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# OPTIONS_HADDOCK prune #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif

-- |
-- Module      : Data.ByteString.Char8
-- Copyright   : (c) Don Stewart 2006-2008
--               (c) Duncan Coutts 2006-2011
-- License     : BSD-style
--
-- Maintainer  : dons00@gmail.com, duncan@community.haskell.org
-- Stability   : stable
-- Portability : portable
--
-- Manipulate 'ByteString's using 'Char' operations. All Chars will be
-- truncated to 8 bits. It can be expected that these functions will run
-- at identical speeds to their 'Word8' equivalents in "Data.ByteString".
--
-- More specifically these byte strings are taken to be in the
-- subset of Unicode covered by code points 0-255. This covers
-- Unicode Basic Latin, Latin-1 Supplement and C0+C1 Controls.
--
-- See:
--
--  * <http://www.unicode.org/charts/>
--
--  * <http://www.unicode.org/charts/PDF/U0000.pdf>
--
--  * <http://www.unicode.org/charts/PDF/U0080.pdf>
--
-- This module is intended to be imported @qualified@, to avoid name
-- clashes with "Prelude" functions.  eg.
--
-- > import qualified Data.ByteString.Char8 as C
--
-- The Char8 interface to bytestrings provides an instance of IsString
-- for the ByteString type, enabling you to use string literals, and
-- have them implicitly packed to ByteStrings.
-- Use @{-\# LANGUAGE OverloadedStrings \#-}@ to enable this.
--

module Data.ByteString.Char8 (

        -- * The @ByteString@ type
        ByteString,             -- abstract, instances: Eq, Ord, Show, Read, Data, Typeable, Monoid

        -- * Introducing and eliminating 'ByteString's
        empty,                  -- :: ByteString
        singleton,              -- :: Char   -> ByteString
        pack,                   -- :: String -> ByteString
        unpack,                 -- :: ByteString -> String

        -- * Basic interface
        cons,                   -- :: Char -> ByteString -> ByteString
        snoc,                   -- :: ByteString -> Char -> ByteString
        append,                 -- :: ByteString -> ByteString -> ByteString
        head,                   -- :: ByteString -> Char
        uncons,                 -- :: ByteString -> Maybe (Char, ByteString)
        unsnoc,                 -- :: ByteString -> Maybe (ByteString, Char)
        last,                   -- :: ByteString -> Char
        tail,                   -- :: ByteString -> ByteString
        init,                   -- :: ByteString -> ByteString
        null,                   -- :: ByteString -> Bool
        length,                 -- :: ByteString -> Int

        -- * Transformating ByteStrings
        map,                    -- :: (Char -> Char) -> ByteString -> ByteString
        reverse,                -- :: ByteString -> ByteString
        intersperse,            -- :: Char -> ByteString -> ByteString
        intercalate,            -- :: ByteString -> [ByteString] -> ByteString
        transpose,              -- :: [ByteString] -> [ByteString]

        -- * Reducing 'ByteString's (folds)
        foldl,                  -- :: (a -> Char -> a) -> a -> ByteString -> a
        foldl',                 -- :: (a -> Char -> a) -> a -> ByteString -> a
        foldl1,                 -- :: (Char -> Char -> Char) -> ByteString -> Char
        foldl1',                -- :: (Char -> Char -> Char) -> ByteString -> Char

        foldr,                  -- :: (Char -> a -> a) -> a -> ByteString -> a
        foldr',                 -- :: (Char -> a -> a) -> a -> ByteString -> a
        foldr1,                 -- :: (Char -> Char -> Char) -> ByteString -> Char
        foldr1',                -- :: (Char -> Char -> Char) -> ByteString -> Char

        -- ** Special folds
        concat,                 -- :: [ByteString] -> ByteString
        concatMap,              -- :: (Char -> ByteString) -> ByteString -> ByteString
        any,                    -- :: (Char -> Bool) -> ByteString -> Bool
        all,                    -- :: (Char -> Bool) -> ByteString -> Bool
        maximum,                -- :: ByteString -> Char
        minimum,                -- :: ByteString -> Char

        -- * Building ByteStrings
        -- ** Scans
        scanl,                  -- :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString
        scanl1,                 -- :: (Char -> Char -> Char) -> ByteString -> ByteString
        scanr,                  -- :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString
        scanr1,                 -- :: (Char -> Char -> Char) -> ByteString -> ByteString

        -- ** Accumulating maps
        mapAccumL,              -- :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString)
        mapAccumR,              -- :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString)

        -- ** Generating and unfolding ByteStrings
        replicate,              -- :: Int -> Char -> ByteString
        unfoldr,                -- :: (a -> Maybe (Char, a)) -> a -> ByteString
        unfoldrN,               -- :: Int -> (a -> Maybe (Char, a)) -> a -> (ByteString, Maybe a)

        -- * Substrings

        -- ** Breaking strings
        take,                   -- :: Int -> ByteString -> ByteString
        drop,                   -- :: Int -> ByteString -> ByteString
        splitAt,                -- :: Int -> ByteString -> (ByteString, ByteString)
        takeWhile,              -- :: (Char -> Bool) -> ByteString -> ByteString
        dropWhile,              -- :: (Char -> Bool) -> ByteString -> ByteString
        span,                   -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
        spanEnd,                -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
        break,                  -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
        breakEnd,               -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
        group,                  -- :: ByteString -> [ByteString]
        groupBy,                -- :: (Char -> Char -> Bool) -> ByteString -> [ByteString]
        inits,                  -- :: ByteString -> [ByteString]
        tails,                  -- :: ByteString -> [ByteString]
        stripPrefix,            -- :: ByteString -> ByteString -> Maybe ByteString
        stripSuffix,            -- :: ByteString -> ByteString -> Maybe ByteString

        -- ** Breaking into many substrings
        split,                  -- :: Char -> ByteString -> [ByteString]
        splitWith,              -- :: (Char -> Bool) -> ByteString -> [ByteString]

        -- ** Breaking into lines and words
        lines,                  -- :: ByteString -> [ByteString]
        words,                  -- :: ByteString -> [ByteString]
        unlines,                -- :: [ByteString] -> ByteString
        unwords,                -- :: [ByteString] -> ByteString

        -- * Predicates
        isPrefixOf,             -- :: ByteString -> ByteString -> Bool
        isSuffixOf,             -- :: ByteString -> ByteString -> Bool
        isInfixOf,              -- :: ByteString -> ByteString -> Bool

        -- ** Search for arbitrary substrings
        breakSubstring,         -- :: ByteString -> ByteString -> (ByteString,ByteString)
        findSubstring,          -- :: ByteString -> ByteString -> Maybe Int
        findSubstrings,         -- :: ByteString -> ByteString -> [Int]

        -- * Searching ByteStrings

        -- ** Searching by equality
        elem,                   -- :: Char -> ByteString -> Bool
        notElem,                -- :: Char -> ByteString -> Bool

        -- ** Searching with a predicate
        find,                   -- :: (Char -> Bool) -> ByteString -> Maybe Char
        filter,                 -- :: (Char -> Bool) -> ByteString -> ByteString
--      partition               -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)

        -- * Indexing ByteStrings
        index,                  -- :: ByteString -> Int -> Char
        elemIndex,              -- :: Char -> ByteString -> Maybe Int
        elemIndices,            -- :: Char -> ByteString -> [Int]
        elemIndexEnd,           -- :: Char -> ByteString -> Maybe Int
        findIndex,              -- :: (Char -> Bool) -> ByteString -> Maybe Int
        findIndices,            -- :: (Char -> Bool) -> ByteString -> [Int]
        count,                  -- :: Char -> ByteString -> Int

        -- * Zipping and unzipping ByteStrings
        zip,                    -- :: ByteString -> ByteString -> [(Char,Char)]
        zipWith,                -- :: (Char -> Char -> c) -> ByteString -> ByteString -> [c]
        unzip,                  -- :: [(Char,Char)] -> (ByteString,ByteString)

        -- * Ordered ByteStrings
        sort,                   -- :: ByteString -> ByteString

        -- * Reading from ByteStrings
        readInt,                -- :: ByteString -> Maybe (Int, ByteString)
        readInteger,            -- :: ByteString -> Maybe (Integer, ByteString)

        -- * Low level CString conversions

        -- ** Copying ByteStrings
        copy,                   -- :: ByteString -> ByteString

        -- ** Packing CStrings and pointers
        packCString,            -- :: CString -> IO ByteString
        packCStringLen,         -- :: CStringLen -> IO ByteString

        -- ** Using ByteStrings as CStrings
        useAsCString,           -- :: ByteString -> (CString    -> IO a) -> IO a
        useAsCStringLen,        -- :: ByteString -> (CStringLen -> IO a) -> IO a

        -- * I\/O with 'ByteString's
        -- | ByteString I/O uses binary mode, without any character decoding
        -- or newline conversion. The fact that it does not respect the Handle
        -- newline mode is considered a flaw and may be changed in a future version.

        -- ** Standard input and output
        getLine,                -- :: IO ByteString
        getContents,            -- :: IO ByteString
        putStr,                 -- :: ByteString -> IO ()
        putStrLn,               -- :: ByteString -> IO ()
        interact,               -- :: (ByteString -> ByteString) -> IO ()

        -- ** Files
        readFile,               -- :: FilePath -> IO ByteString
        writeFile,              -- :: FilePath -> ByteString -> IO ()
        appendFile,             -- :: FilePath -> ByteString -> IO ()
--      mmapFile,               -- :: FilePath -> IO ByteString

        -- ** I\/O with Handles
        hGetLine,               -- :: Handle -> IO ByteString
        hGetContents,           -- :: Handle -> IO ByteString
        hGet,                   -- :: Handle -> Int -> IO ByteString
        hGetSome,               -- :: Handle -> Int -> IO ByteString
        hGetNonBlocking,        -- :: Handle -> Int -> IO ByteString
        hPut,                   -- :: Handle -> ByteString -> IO ()
        hPutNonBlocking,        -- :: Handle -> ByteString -> IO ByteString
        hPutStr,                -- :: Handle -> ByteString -> IO ()
        hPutStrLn,              -- :: Handle -> ByteString -> IO ()

  ) 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

-- Listy functions transparently exported
import Data.ByteString (empty,null,length,tail,init,append
                       ,inits,tails,reverse,transpose
                       ,concat,take,drop,splitAt,intercalate
                       ,sort,isPrefixOf,isSuffixOf,isInfixOf
                       ,stripPrefix,stripSuffix
                       ,findSubstring,findSubstrings,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

import Data.Char    ( isSpace )
#if MIN_VERSION_base(4,9,0)
-- See bytestring #70
import GHC.Char (eqChar)
#endif
import qualified Data.List as List (intersperse)

import System.IO    (Handle,stdout)
import Foreign


------------------------------------------------------------------------

-- | /O(1)/ Convert a 'Char' into a 'ByteString'
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 #-}

-- | /O(n)/ Convert a 'String' into a 'ByteString'
--
-- For applications with large numbers of string literals, pack can be a
-- bottleneck.
pack :: String -> ByteString
pack :: String -> ByteString
pack = String -> ByteString
packChars
{-# INLINE pack #-}

-- | /O(n)/ Converts a 'ByteString' to a 'String'.
unpack :: ByteString -> [Char]
unpack :: ByteString -> String
unpack = ByteString -> String
B.unpackChars
{-# INLINE unpack #-}

infixr 5 `cons` --same as list (:)
infixl 5 `snoc`

-- | /O(n)/ 'cons' is analogous to (:) for lists, but of different
-- complexity, as it requires a memcpy.
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 #-}

-- | /O(n)/ Append a Char to the end of a 'ByteString'. Similar to
-- 'cons', this function performs a memcpy.
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 #-}

-- | /O(1)/ Extract the head and tail of a ByteString, returning Nothing
-- if it is empty.
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 #-}

-- | /O(1)/ Extract the 'init' and 'last' of a ByteString, returning Nothing
-- if it is empty.
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 #-}

-- | /O(1)/ Extract the first element of a ByteString, which must be non-empty.
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 #-}

-- | /O(1)/ Extract the last element of a packed string, which must be non-empty.
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 #-}

-- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each element of @xs@
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 #-}

-- | /O(n)/ The 'intersperse' function takes a Char and a 'ByteString'
-- and \`intersperses\' that Char between the elements of the
-- 'ByteString'.  It is analogous to the intersperse function on Lists.
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', applied to a binary operator, a starting value (typically
-- the left-identity of the operator), and a ByteString, reduces the
-- ByteString using the binary operator, from left to right.
foldl :: (a -> Char -> a) -> a -> ByteString -> a
foldl :: (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'' is like foldl, but strict in the accumulator.
foldl' :: (a -> Char -> a) -> a -> ByteString -> a
foldl' :: (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', applied to a binary operator, a starting value
-- (typically the right-identity of the operator), and a packed string,
-- reduces the packed string using the binary operator, from right to left.
foldr :: (Char -> a -> a) -> a -> ByteString -> a
foldr :: (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 (\Word8
c a
a -> Char -> a -> a
f (Word8 -> Char
w2c Word8
c) a
a)
{-# INLINE foldr #-}

-- | 'foldr'' is a strict variant of foldr
foldr' :: (Char -> a -> a) -> a -> ByteString -> a
foldr' :: (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' (\Word8
c a
a -> Char -> a -> a
f (Word8 -> Char
w2c Word8
c) a
a)
{-# INLINE foldr' #-}

-- | 'foldl1' is a variant of 'foldl' that has no starting value
-- argument, and thus must be applied to non-empty 'ByteStrings'.
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 #-}

-- | A strict version of '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' is a variant of 'foldr' that has no starting value argument,
-- and thus must be applied to non-empty 'ByteString's
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 #-}

-- | A strict variant of 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' #-}

-- | Map a function over a 'ByteString' and concatenate the results
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 #-}

-- | Applied to a predicate and a ByteString, 'any' determines if
-- any element of the 'ByteString' satisfies the predicate.
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 #-}

-- | Applied to a predicate and a 'ByteString', 'all' determines if
-- all elements of the 'ByteString' satisfy the predicate.
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' returns the maximum value from a 'ByteString'
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' returns the minimum value from a 'ByteString'
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 #-}

-- | The 'mapAccumL' function behaves like a combination of 'map' and
-- 'foldl'; it applies a function to each element of a ByteString,
-- passing an accumulating parameter from left to right, and returning a
-- final value of this accumulator together with the new list.
mapAccumL :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString)
mapAccumL :: (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))

-- | The 'mapAccumR' function behaves like a combination of 'map' and
-- 'foldr'; it applies a function to each element of a ByteString,
-- passing an accumulating parameter from right to left, and returning a
-- final value of this accumulator together with the new ByteString.
mapAccumR :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString)
mapAccumR :: (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' is similar to 'foldl', but returns a list of successive
-- reduced values from the left:
--
-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
--
-- Note that
--
-- > last (scanl f z xs) == foldl f z xs.
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' is a variant of 'scanl' that has no starting value argument:
--
-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
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 is the right-to-left dual of scanl.
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' is a variant of 'scanr' that has no starting value argument.
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)))

-- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@
-- the value of every element. The following holds:
--
-- > replicate w c = unfoldr w (\u -> Just (u,u)) c
--
-- This implemenation uses @memset(3)@
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 #-}

-- | /O(n)/, where /n/ is the length of the result.  The 'unfoldr'
-- function is analogous to the List \'unfoldr\'.  'unfoldr' builds a
-- ByteString from a seed value.  The function takes the element and
-- returns 'Nothing' if it is done producing the ByteString or returns
-- 'Just' @(a,b)@, in which case, @a@ is the next character in the string,
-- and @b@ is the seed value for further production.
--
-- Examples:
--
-- > unfoldr (\x -> if x <= '9' then Just (x, succ x) else Nothing) '0' == "0123456789"
unfoldr :: (a -> Maybe (Char, a)) -> a -> ByteString
unfoldr :: (a -> Maybe (Char, a)) -> a -> ByteString
unfoldr a -> Maybe (Char, a)
f a
x = (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
External instance of the constraint type Functor Maybe
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) a
x
    where k :: (Char, b) -> (Word8, b)
k (Char
i, b
j) = (Char -> Word8
c2w Char
i, b
j)

-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ByteString from a seed
-- value.  However, the length of the result is limited by the first
-- argument to 'unfoldrN'.  This function is more efficient than 'unfoldr'
-- when the maximum length of the result is known.
--
-- The following equation relates 'unfoldrN' and 'unfoldr':
--
-- > unfoldrN n f s == take n (unfoldr f s)
unfoldrN :: Int -> (a -> Maybe (Char, a)) -> a -> (ByteString, Maybe a)
unfoldrN :: 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
External instance of the constraint type Functor Maybe
`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', applied to a predicate @p@ and a ByteString @xs@,
-- returns the longest prefix (possibly empty) of @xs@ of elements that
-- satisfy @p@.
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 #-}

-- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@.
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
  #-}

-- | 'break' @p@ is equivalent to @'span' ('not' . p)@.
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 #-}

-- See bytestring #70
#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

-- INTERNAL:

-- | 'breakChar' breaks its ByteString argument at the first occurence
-- of the specified char. It is more efficient than 'break' as it is
-- implemented with @memchr(3)@. I.e.
--
-- > break (=='c') "abcd" == breakChar 'c' "abcd"
--
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' @p xs@ breaks the ByteString into two segments. It is
-- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@
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' behaves like 'span' but from the end of the 'ByteString'.
-- We have
--
-- > spanEnd (not.isSpace) "x y z" == ("x y ","z")
--
-- and
--
-- > spanEnd (not . isSpace) ps
-- >    ==
-- > let (x,y) = span (not.isSpace) (reverse ps) in (reverse y, reverse x)
--
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' behaves like 'break' but from the end of the 'ByteString'
--
-- breakEnd p == spanEnd (not.p)
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 #-}

-- | /O(n)/ Break a 'ByteString' into pieces separated by the byte
-- argument, consuming the delimiter. I.e.
--
-- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"]
-- > split 'a'  "aXaXaXa"    == ["","X","X","X",""]
-- > split 'x'  "x"          == ["",""]
--
-- and
--
-- > intercalate [c] . split c == id
-- > split == splitWith . (==)
--
-- As for all splitting functions in this library, this function does
-- not copy the substrings, it just constructs new 'ByteStrings' that
-- are slices of the original.
--
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 #-}

-- | /O(n)/ Splits a 'ByteString' into components delimited by
-- separators, where the predicate returns True for a separator element.
-- The resulting components do not contain the separators.  Two adjacent
-- separators result in an empty component in the output.  eg.
--
-- > splitWith (=='a') "aabbaca" == ["","","bb","c",""]
--
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 #-}
-- the inline makes a big difference here.

{-
-- | Like 'splitWith', except that sequences of adjacent separators are
-- treated as a single separator. eg.
--
-- > tokens (=='a') "aabbaca" == ["bb","c"]
--
tokens :: (Char -> Bool) -> ByteString -> [ByteString]
tokens f = B.tokens (f . w2c)
{-# INLINE tokens #-}
-}

-- | The 'groupBy' function is the non-overloaded version of 'group'.
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))

-- | /O(1)/ 'ByteString' index (subscript) operator, starting from 0.
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 #-}

-- | /O(n)/ The 'elemIndex' function returns the index of the first
-- element in the given 'ByteString' which is equal (by memchr) to the
-- query element, or 'Nothing' if there is no such element.
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 #-}

-- | /O(n)/ The 'elemIndexEnd' function returns the last index of the
-- element in the given 'ByteString' which is equal to the query
-- element, or 'Nothing' if there is no such element. The following
-- holds:
--
-- > elemIndexEnd c xs ==
-- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs)
--
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 #-}

-- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning
-- the indices of all elements equal to the query element, in ascending order.
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 #-}

-- | The 'findIndex' function takes a predicate and a 'ByteString' and
-- returns the index of the first element in the ByteString satisfying the predicate.
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 findIndex #-}

-- | The 'findIndices' function extends 'findIndex', by returning the
-- indices of all elements satisfying the predicate, in ascending order.
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)

-- | count returns the number of times its argument appears in the ByteString
--
-- > count = length . elemIndices
--
-- Also
--
-- > count '\n' == length . lines
--
-- But more efficiently than using length on the intermediate list.
count :: Char -> ByteString -> Int
count :: Char -> ByteString -> Int
count Char
c = Word8 -> ByteString -> Int
B.count (Char -> Word8
c2w Char
c)

-- | /O(n)/ 'elem' is the 'ByteString' membership predicate. This
-- implementation uses @memchr(3)@.
elem :: Char -> ByteString -> Bool
elem :: Char -> ByteString -> Bool
elem    Char
c = Word8 -> ByteString -> Bool
B.elem (Char -> Word8
c2w Char
c)
{-# INLINE elem #-}

-- | /O(n)/ 'notElem' is the inverse of 'elem'
notElem :: Char -> ByteString -> Bool
notElem :: Char -> ByteString -> Bool
notElem Char
c = Word8 -> ByteString -> Bool
B.notElem (Char -> Word8
c2w Char
c)
{-# INLINE notElem #-}

-- | /O(n)/ 'filter', applied to a predicate and a ByteString,
-- returns a ByteString containing those characters that satisfy the
-- predicate.
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 #-}

{-
-- | /O(n)/ and /O(n\/c) space/ A first order equivalent of /filter .
-- (==)/, for the common case of filtering a single Char. It is more
-- efficient to use /filterChar/ in this case.
--
-- > filterChar == filter . (==)
--
-- filterChar is around 10x faster, and uses much less space, than its
-- filter equivalent
--
filterChar :: Char -> ByteString -> ByteString
filterChar c ps = replicate (count c ps) c
{-# INLINE filterChar #-}

{-# RULES
"ByteString specialise filter (== x)" forall x.
    filter ((==) x) = filterChar x
"ByteString specialise filter (== x)" forall x.
    filter (== x) = filterChar x
  #-}
-}

-- | /O(n)/ The 'find' function takes a predicate and a ByteString,
-- and returns the first element in matching the predicate, or 'Nothing'
-- if there is no such element.
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
External instance of the constraint type Functor Maybe
`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 #-}

{-
-- | /O(n)/ A first order equivalent of /filter . (==)/, for the common
-- case of filtering a single Char. It is more efficient to use
-- filterChar in this case.
--
-- > filterChar == filter . (==)
--
-- filterChar is around 10x faster, and uses much less space, than its
-- filter equivalent
--
filterChar :: Char -> ByteString -> ByteString
filterChar c = B.filterByte (c2w c)
{-# INLINE filterChar #-}

-- | /O(n)/ A first order equivalent of /filter . (\/=)/, for the common
-- case of filtering a single Char out of a list. It is more efficient
-- to use /filterNotChar/ in this case.
--
-- > filterNotChar == filter . (/=)
--
-- filterNotChar is around 3x faster, and uses much less space, than its
-- filter equivalent
--
filterNotChar :: Char -> ByteString -> ByteString
filterNotChar c = B.filterNotByte (c2w c)
{-# INLINE filterNotChar #-}
-}

-- | /O(n)/ 'zip' takes two ByteStrings and returns a list of
-- corresponding pairs of Chars. If one input ByteString is short,
-- excess elements of the longer ByteString are discarded. This is
-- equivalent to a pair of 'unpack' operations, and so space
-- usage may be large for multi-megabyte ByteStrings
zip :: ByteString -> ByteString -> [(Char,Char)]
zip :: ByteString -> ByteString -> [(Char, Char)]
zip ByteString
ps ByteString
qs
    | ByteString -> Bool
B.null ByteString
ps Bool -> Bool -> Bool
|| ByteString -> Bool
B.null ByteString
qs = []
    | Bool
otherwise = (ByteString -> Char
unsafeHead ByteString
ps, ByteString -> Char
unsafeHead ByteString
qs) (Char, Char) -> [(Char, Char)] -> [(Char, Char)]
forall a. a -> [a] -> [a]
: ByteString -> ByteString -> [(Char, Char)]
zip (ByteString -> ByteString
B.unsafeTail ByteString
ps) (ByteString -> ByteString
B.unsafeTail ByteString
qs)

-- | 'zipWith' generalises 'zip' by zipping with the function given as
-- the first argument, instead of a tupling function.  For example,
-- @'zipWith' (+)@ is applied to two ByteStrings to produce the list
-- of corresponding sums.
zipWith :: (Char -> Char -> a) -> ByteString -> ByteString -> [a]
zipWith :: (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)

-- | 'unzip' transforms a list of pairs of Chars into a pair of
-- ByteStrings. Note that this performs two 'pack' operations.
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 #-}

-- | A variety of 'head' for non-empty ByteStrings. 'unsafeHead' omits
-- the check for the empty case, which is good for performance, but
-- there is an obligation on the programmer to provide a proof that the
-- ByteString is non-empty.
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 #-}

-- ---------------------------------------------------------------------
-- Things that depend on the encoding

{-# RULES
"ByteString specialise break -> breakSpace"
    break isSpace = breakSpace
  #-}

-- | 'breakSpace' returns the pair of ByteStrings when the argument is
-- broken at the first whitespace byte. I.e.
--
-- > break isSpace == breakSpace
--
breakSpace :: ByteString -> (ByteString,ByteString)
breakSpace :: ByteString -> (ByteString, ByteString)
breakSpace (PS ForeignPtr Word8
x Int
s 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
withForeignPtr 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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Int
0 Int
l
    (ByteString, ByteString) -> IO (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type Eq Int
== Int
0    -> (ByteString
empty, ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x Int
s Int
l)
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
l    -> (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x Int
s Int
l, ByteString
empty)
        | Bool
otherwise -> (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x Int
s Int
i, ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
i) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-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
External instance of the constraint type Ord Int
>= Int
m    = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Int
n
    | Bool
otherwise = do Word8
w <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
External instance of the constraint type Storable Word8
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
External instance of the constraint type Num Int
+Int
1) Int
m else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Int
n

-- | 'dropSpace' efficiently returns the 'ByteString' argument with
-- white space Chars removed from the front. It is more efficient than
-- calling dropWhile for removing whitespace. I.e.
--
-- > dropWhile isSpace == dropSpace
--
dropSpace :: ByteString -> ByteString
dropSpace :: ByteString -> ByteString
dropSpace (PS ForeignPtr Word8
x Int
s 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
withForeignPtr 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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Int
0 Int
l
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type Eq Int
== Int
l then ByteString
empty else ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
i) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-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
External instance of the constraint type Ord Int
>= Int
m    = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Int
n
    | Bool
otherwise = do Word8
w <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
External instance of the constraint type Storable Word8
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
External instance of the constraint type Num Int
+Int
1) Int
m else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Int
n

{-
-- | 'dropSpaceEnd' efficiently returns the 'ByteString' argument with
-- white space removed from the end. I.e.
--
-- > reverse . (dropWhile isSpace) . reverse == dropSpaceEnd
--
-- but it is more efficient than using multiple reverses.
--
dropSpaceEnd :: ByteString -> ByteString
dropSpaceEnd (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do
    i <- lastnonspace (p `plusPtr` s) (l-1)
    return $! if i == (-1) then empty else PS x s (i+1)
{-# INLINE dropSpaceEnd #-}

lastnonspace :: Ptr Word8 -> Int -> IO Int
lastnonspace ptr n
    | n < 0     = return n
    | otherwise = do w <- peekElemOff ptr n
                     if isSpaceWord8 w then lastnonspace ptr (n-1) else return n
-}

-- | 'lines' breaks a ByteString up into a list of ByteStrings at
-- newline Chars. The resulting strings do not contain newlines.
--
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
External instance of the constraint type Num Int
+Int
1) ByteString
ps)
    where search :: ByteString -> Maybe Int
search = Char -> ByteString -> Maybe Int
elemIndex Char
'\n'

{-
-- Just as fast, but more complex. Should be much faster, I thought.
lines :: ByteString -> [ByteString]
lines (PS _ _ 0) = []
lines (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do
        let ptr = p `plusPtr` s

            loop n = do
                let q = memchr (ptr `plusPtr` n) 0x0a (fromIntegral (l-n))
                if q == nullPtr
                    then return [PS x (s+n) (l-n)]
                    else do let i = q `minusPtr` ptr
                            ls <- loop (i+1)
                            return $! PS x (s+n) (i-n) : ls
        loop 0
-}

-- | 'unlines' is an inverse operation to 'lines'.  It joins lines,
-- after appending a terminating newline to each.
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 -- half as much space
    where nl :: ByteString
nl = Char -> ByteString
singleton Char
'\n'

-- | 'words' breaks a ByteString up into a list of words, which
-- were delimited by Chars representing white space.
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 #-}

-- | The 'unwords' function is analogous to the 'unlines' function, on words.
unwords :: [ByteString] -> ByteString
unwords :: [ByteString] -> ByteString
unwords = ByteString -> [ByteString] -> ByteString
intercalate (Char -> ByteString
singleton Char
' ')
{-# INLINE unwords #-}

-- ---------------------------------------------------------------------
-- Reading from ByteStrings

-- | readInt reads an Int from the beginning of the ByteString.  If there is no
-- integer at the beginning of the string, it returns Nothing, otherwise
-- it just returns the int read, and the rest of the string.
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)
External instance of the constraint type Num Int
External instance of the constraint type Num Int
External instance of the constraint type Eq Int
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
External instance of the constraint type Ord Word8
>= Word8
0x30
                     Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word8
<= Word8
0x39 -> Bool -> Int -> Int -> ByteString -> Maybe (Int, ByteString)
loop Bool
neg (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
1)
                                          (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral Word8
fromIntegral Word8
w Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- 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)
External instance of the constraint type Num Int
External instance of the constraint type Num Int
External instance of the constraint type Eq Int
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
Evidence bound by a type signature of the constraint type Num 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 reads an Integer from the beginning of the ByteString.  If
-- there is no integer at the beginning of the string, it returns Nothing,
-- otherwise it just returns the int read, and the rest of the string.
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
External instance of the constraint type Monad Maybe
>>= \(Integer
n, ByteString
bs) -> (Integer, ByteString) -> Maybe (Integer, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Maybe
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
External instance of the constraint type Ord Word8
>= Word8
0x30 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word8
<= 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
External instance of the constraint type Num Int
External instance of the constraint type Integral Word8
fromIntegral Word8
w Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- 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)
External instance of the constraint type Integral Int
External instance of the constraint type Integral Int
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
External instance of the constraint type Ord Word8
>= Word8
0x30 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word8
<= Word8
0x39 ->
                       if Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
9 then Int -> Int -> [Integer] -> ByteString -> (Integer, ByteString)
loop Int
1 (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral Word8
fromIntegral Word8
w Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
0x30)
                                           (Int -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral Int
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
External instance of the constraint type Num Int
+Int
1)
                                           (Int
10Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral Word8
fromIntegral Word8
w Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- 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)
External instance of the constraint type Integral Int
External instance of the constraint type Integral Int
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
Evidence bound by a type signature of the constraint type Integral a
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
Evidence bound by a type signature of the constraint type Integral b
External instance of the constraint type Num Integer
^b
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
* Integer -> [Integer] -> Integer
forall {a}. Num a => a -> [a] -> a
External instance of the constraint type Num Integer
combine1 Integer
1000000000 [Integer]
ns Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+ a -> Integer
forall a. Integral a => a -> Integer
Evidence bound by a type signature of the constraint type Integral a
toInteger a
acc, b
ps)

          combine1 :: a -> [a] -> a
combine1 a
_ [a
n] = a
n
          combine1 a
b [a]
ns  = a -> [a] -> a
combine1 (a
ba -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
*a
b) ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a]
forall {a}. Num a => a -> [a] -> [a]
Evidence bound by a type signature of the constraint type Num a
combine2 a
b [a]
ns

          combine2 :: a -> [a] -> [a]
combine2 a
b (a
n:a
m:[a]
ns) = let t :: a
t = a
ma -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
*a
b a -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
+ a
n in a
t a -> [a] -> [a]
`seq` (a
t a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
combine2 a
b [a]
ns)
          combine2 a
_ [a]
ns       = [a]
ns

------------------------------------------------------------------------
-- For non-binary text processing:

-- | Write a ByteString to a handle, appending a newline byte
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
External instance of the constraint type Ord Int
< 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
External instance of the constraint type Monad IO
>> Handle -> ByteString -> IO ()
hPut Handle
h (Word8 -> ByteString
B.singleton Word8
0x0a) -- don't copy

-- | Write a ByteString to stdout, appending a newline byte
putStrLn :: ByteString -> IO ()
putStrLn :: ByteString -> IO ()
putStrLn = Handle -> ByteString -> IO ()
hPutStrLn Handle
stdout