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

-- |
-- Module      : Data.ByteString.Lazy.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 /lazy/ '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 'Data.Word.Word8' equivalents in
-- "Data.ByteString.Lazy".
--
-- This module is intended to be imported @qualified@, to avoid name
-- clashes with "Prelude" functions.  eg.
--
-- > import qualified Data.ByteString.Lazy.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.Lazy.Char8 (

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

        -- * Introducing and eliminating 'ByteString's
        empty,                  -- :: ByteString
        singleton,              -- :: Char   -> ByteString
        pack,                   -- :: String -> ByteString
        unpack,                 -- :: ByteString -> String
        fromChunks,             -- :: [Strict.ByteString] -> ByteString
        toChunks,               -- :: ByteString -> [Strict.ByteString]
        fromStrict,             -- :: Strict.ByteString -> ByteString
        toStrict,               -- :: ByteString -> Strict.ByteString

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

        -- * Transforming 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
        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)

        -- ** Infinite ByteStrings
        repeat,                 -- :: Char -> ByteString
        replicate,              -- :: Int64 -> Char -> ByteString
        cycle,                  -- :: ByteString -> ByteString
        iterate,                -- :: (Char -> Char) -> Char -> ByteString

        -- ** Unfolding ByteStrings
        unfoldr,                -- :: (a -> Maybe (Char, a)) -> a -> ByteString

        -- * Substrings

        -- ** Breaking strings
        take,                   -- :: Int64 -> ByteString -> ByteString
        drop,                   -- :: Int64 -> ByteString -> ByteString
        splitAt,                -- :: Int64 -> ByteString -> (ByteString, ByteString)
        takeWhile,              -- :: (Char -> Bool) -> ByteString -> ByteString
        dropWhile,              -- :: (Char -> Bool) -> ByteString -> ByteString
        span,                   -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
        break,                  -- :: (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

        -- * 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 -> Int64 -> Char
        elemIndex,              -- :: Char -> ByteString -> Maybe Int64
        elemIndices,            -- :: Char -> ByteString -> [Int64]
        findIndex,              -- :: (Char -> Bool) -> ByteString -> Maybe Int64
        findIndices,            -- :: (Char -> Bool) -> ByteString -> [Int64]
        count,                  -- :: Char -> ByteString -> Int64

        -- * 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

        -- * Low level conversions
        -- ** Copying ByteStrings
        copy,                   -- :: ByteString -> ByteString

        -- * Reading from ByteStrings
        readInt,
        readInteger,

        -- * 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
        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 ()

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

  ) where

-- Functions transparently exported
import Data.ByteString.Lazy 
        (fromChunks, toChunks, fromStrict, toStrict
        ,empty,null,length,tail,init,append,reverse,transpose,cycle
        ,concat,take,drop,splitAt,intercalate
        ,isPrefixOf,isSuffixOf,group,inits,tails,copy
        ,stripPrefix,stripSuffix
        ,hGetContents, hGet, hPut, getContents
        ,hGetNonBlocking, hPutNonBlocking
        ,putStr, hPutStr, interact
        ,readFile,writeFile,appendFile)

-- Functions we need to wrap.
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as S (ByteString) -- typename only
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import Data.ByteString.Lazy.Internal

import Data.ByteString.Internal (w2c, c2w, isSpaceWord8)

import Data.Int (Int64)
import qualified Data.List as List

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,foldl1,foldr1
        ,readFile,writeFile,appendFile,replicate,getContents,getLine,putStr,putStrLn
        ,zip,zipWith,unzip,notElem,repeat,iterate,interact,cycle)

import System.IO            (Handle, stdout)

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

-- | /O(1)/ Convert a 'Char' into a 'ByteString'
singleton :: Char -> ByteString
singleton :: Char -> ByteString
singleton = Word8 -> ByteString
L.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'. 
pack :: [Char] -> ByteString
pack :: [Char] -> ByteString
pack = [Char] -> ByteString
packChars

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

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

-- | /O(1)/ 'cons' is analogous to '(:)' for lists.
cons :: Char -> ByteString -> ByteString
cons :: Char -> ByteString -> ByteString
cons = Word8 -> ByteString -> ByteString
L.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(1)/ Unlike 'cons', 'cons'' is
-- strict in the ByteString that we are consing onto. More precisely, it forces
-- the head and the first chunk. It does this because, for space efficiency, it
-- may coalesce the new byte onto the first \'chunk\' rather than starting a
-- new \'chunk\'.
--
-- So that means you can't use a lazy recursive contruction like this:
--
-- > let xs = cons' c xs in xs
--
-- You can however use 'cons', as well as 'repeat' and 'cycle', to build
-- infinite lazy ByteStrings.
--
cons' :: Char -> ByteString -> ByteString
cons' :: Char -> ByteString -> ByteString
cons' = Word8 -> ByteString -> ByteString
L.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
L.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 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
L.head
{-# INLINE head #-}

-- | /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)
L.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(n\/c)/ 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)
L.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 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
L.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
L.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
L.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
L.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
L.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
L.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
L.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'' is like 'foldl1', but strict in the accumulator.
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
L.foldl1' (\Word8
x Word8
y -> Char -> Word8
c2w (Char -> Char -> Char
f (Word8 -> Char
w2c Word8
x) (Word8 -> Char
w2c Word8
y))) ByteString
ps)

-- | '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
L.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
L.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
L.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
L.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
L.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
L.minimum
{-# INLINE minimum #-}

-- ---------------------------------------------------------------------
-- Building ByteStrings

-- | 'scanl' is similar to 'foldl', but returns a list of successive
-- reduced values from the left. This function will fuse.
--
-- > 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
L.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)

-- | 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 ByteString.
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)
L.mapAccumL (\acc
a Word8
w -> case acc -> Char -> (acc, Char)
f acc
a (Word8 -> Char
w2c Word8
w) of (acc
a',Char
c) -> (acc
a', 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)
L.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))

------------------------------------------------------------------------
-- Generating and unfolding ByteStrings

-- | @'iterate' f x@ returns an infinite ByteString of repeated applications
-- of @f@ to @x@:
--
-- > iterate f x == [x, f x, f (f x), ...]
--
iterate :: (Char -> Char) -> Char -> ByteString
iterate :: (Char -> Char) -> Char -> ByteString
iterate Char -> Char
f = (Word8 -> Word8) -> Word8 -> ByteString
L.iterate (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) (Word8 -> ByteString) -> (Char -> Word8) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w

-- | @'repeat' x@ is an infinite ByteString, with @x@ the value of every
-- element.
--
repeat :: Char -> ByteString
repeat :: Char -> ByteString
repeat = Word8 -> ByteString
L.repeat (Word8 -> ByteString) -> (Char -> Word8) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w

-- | /O(n)/ @'replicate' n x@ is a ByteString of length @n@ with @x@
-- the value of every element.
--
replicate :: Int64 -> Char -> ByteString
replicate :: Int64 -> Char -> ByteString
replicate Int64
w Char
c = Int64 -> Word8 -> ByteString
L.replicate Int64
w (Char -> Word8
c2w Char
c)

-- | /O(n)/ 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 a
-- prepending to the ByteString and @b@ is used as the next element in a
-- recursive call.
unfoldr :: (a -> Maybe (Char, a)) -> a -> ByteString
unfoldr :: (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
L.unfoldr ((a -> Maybe (Word8, a)) -> a -> ByteString)
-> (a -> Maybe (Word8, a)) -> a -> ByteString
forall a b. (a -> b) -> a -> b
$ \a
a -> case a -> Maybe (Char, a)
f a
a of
                                    Maybe (Char, a)
Nothing      -> Maybe (Word8, a)
forall a. Maybe a
Nothing
                                    Just (Char
c, a
a') -> (Word8, a) -> Maybe (Word8, a)
forall a. a -> Maybe a
Just (Char -> Word8
c2w Char
c, a
a')

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

-- | '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
L.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
L.dropWhile (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE dropWhile #-}

-- | '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)
L.break (Char -> Bool
f (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE break #-}

-- | '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)
L.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 #-}

{-
-- | '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 = L.breakByte . c2w
{-# INLINE breakChar #-}

-- | 'spanChar' breaks its ByteString argument at the first
-- occurence of a Char other than its argument. It is more efficient
-- than 'span (==)'
--
-- > span  (=='c') "abcd" == spanByte 'c' "abcd"
--
spanChar :: Char -> ByteString -> (ByteString, ByteString)
spanChar = L.spanByte . c2w
{-# INLINE spanChar #-}
-}

--
-- TODO, more rules for breakChar*
--

-- | /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]
L.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]
L.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 '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]
L.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 -> Int64 -> Char
index :: ByteString -> Int64 -> Char
index = (Word8 -> Char
w2c (Word8 -> Char) -> (Int64 -> Word8) -> Int64 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int64 -> Word8) -> Int64 -> Char)
-> (ByteString -> Int64 -> Word8) -> ByteString -> Int64 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64 -> Word8
L.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 Int64
elemIndex :: Char -> ByteString -> Maybe Int64
elemIndex = Word8 -> ByteString -> Maybe Int64
L.elemIndex (Word8 -> ByteString -> Maybe Int64)
-> (Char -> Word8) -> Char -> ByteString -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE elemIndex #-}

-- | /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 -> [Int64]
elemIndices :: Char -> ByteString -> [Int64]
elemIndices = Word8 -> ByteString -> [Int64]
L.elemIndices (Word8 -> ByteString -> [Int64])
-> (Char -> Word8) -> Char -> ByteString -> [Int64]
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 Int64
findIndex :: (Char -> Bool) -> ByteString -> Maybe Int64
findIndex Char -> Bool
f = (Word8 -> Bool) -> ByteString -> Maybe Int64
L.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 -> [Int64]
findIndices :: (Char -> Bool) -> ByteString -> [Int64]
findIndices Char -> Bool
f = (Word8 -> Bool) -> ByteString -> [Int64]
L.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
-- > count '\n' == length . lines
--
-- But more efficiently than using length on the intermediate list.
count :: Char -> ByteString -> Int64
count :: Char -> ByteString -> Int64
count Char
c = Word8 -> ByteString -> Int64
L.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
L.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
L.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
L.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
  #-}

{-# RULES
  "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
L.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 = L.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 = L.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
L.null ByteString
ps Bool -> Bool -> Bool
|| ByteString -> Bool
L.null ByteString
qs = []
    | Bool
otherwise = (ByteString -> Char
head ByteString
ps, ByteString -> Char
head ByteString
qs) (Char, Char) -> [(Char, Char)] -> [(Char, Char)]
forall a. a -> [a] -> [a]
: ByteString -> ByteString -> [(Char, Char)]
zip (ByteString -> ByteString
L.tail ByteString
ps) (ByteString -> ByteString
L.tail 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]
L.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)

-- | 'lines' breaks a ByteString up into a list of ByteStrings at
-- newline Chars. The resulting strings do not contain newlines.
--
-- As of bytestring 0.9.0.3, this function is stricter than its 
-- list cousin.
--
lines :: ByteString -> [ByteString]
lines :: ByteString -> [ByteString]
lines ByteString
Empty          = []
lines (Chunk ByteString
c0 ByteString
cs0) = ByteString -> ByteString -> [ByteString]
loop0 ByteString
c0 ByteString
cs0
    where
    -- this is a really performance sensitive function but the
    -- chunked representation makes the general case a bit expensive
    -- however assuming a large chunk size and normalish line lengths
    -- we will find line endings much more frequently than chunk
    -- endings so it makes sense to optimise for that common case.
    -- So we partition into two special cases depending on whether we
    -- are keeping back a list of chunks that will eventually be output
    -- once we get to the end of the current line.

    -- the common special case where we have no existing chunks of
    -- the current line
    loop0 :: S.ByteString -> ByteString -> [ByteString]
    loop0 :: ByteString -> ByteString -> [ByteString]
loop0 ByteString
c ByteString
cs =
        case Word8 -> ByteString -> Maybe Int
B.elemIndex (Char -> Word8
c2w Char
'\n') ByteString
c of
            Maybe Int
Nothing -> case ByteString
cs of
                           ByteString
Empty  | ByteString -> Bool
B.null ByteString
c  ->                 []
                                  | Bool
otherwise -> ByteString -> ByteString -> ByteString
Chunk ByteString
c ByteString
Empty ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: []
                           (Chunk ByteString
c' ByteString
cs')
                               | ByteString -> Bool
B.null ByteString
c  -> ByteString -> ByteString -> [ByteString]
loop0 ByteString
c'     ByteString
cs'
                               | Bool
otherwise -> ByteString -> [ByteString] -> ByteString -> [ByteString]
loop  ByteString
c' [ByteString
c] ByteString
cs'

            Just Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
/= Int
0    -> ByteString -> ByteString -> ByteString
Chunk (Int -> ByteString -> ByteString
B.unsafeTake Int
n ByteString
c) ByteString
Empty
                                ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> ByteString -> [ByteString]
loop0 (Int -> ByteString -> ByteString
B.unsafeDrop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
1) ByteString
c) ByteString
cs
                   | Bool
otherwise -> ByteString
Empty
                                ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> ByteString -> [ByteString]
loop0 (ByteString -> ByteString
B.unsafeTail ByteString
c) ByteString
cs

    -- the general case when we are building a list of chunks that are
    -- part of the same line
    loop :: S.ByteString -> [S.ByteString] -> ByteString -> [ByteString]
    loop :: ByteString -> [ByteString] -> ByteString -> [ByteString]
loop ByteString
c [ByteString]
line ByteString
cs =
        case Word8 -> ByteString -> Maybe Int
B.elemIndex (Char -> Word8
c2w Char
'\n') ByteString
c of
            Maybe Int
Nothing ->
                case ByteString
cs of
                    ByteString
Empty -> let c' :: ByteString
c' = [ByteString] -> ByteString
revChunks (ByteString
c ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
line)
                              in ByteString
c' ByteString -> [ByteString] -> [ByteString]
`seq` (ByteString
c' ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [])

                    (Chunk ByteString
c' ByteString
cs') -> ByteString -> [ByteString] -> ByteString -> [ByteString]
loop ByteString
c' (ByteString
c ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
line) ByteString
cs'

            Just Int
n ->
                let c' :: ByteString
c' = [ByteString] -> ByteString
revChunks (Int -> ByteString -> ByteString
B.unsafeTake Int
n ByteString
c ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
line)
                 in ByteString
c' ByteString -> [ByteString] -> [ByteString]
`seq` (ByteString
c' ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> ByteString -> [ByteString]
loop0 (Int -> ByteString -> ByteString
B.unsafeDrop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
1) ByteString
c) ByteString
cs)

{-

This function is too strict!  Consider,

> prop_lazy =
    (L.unpack . head . lazylines $ L.append (L.pack "a\nb\n") (error "failed"))
  ==
    "a"

fails.  Here's a properly lazy version of 'lines' for lazy bytestrings

    lazylines           :: L.ByteString -> [L.ByteString]
    lazylines s
        | L.null s  = []
        | otherwise =
            let (l,s') = L.break ((==) '\n') s
            in l : if L.null s' then []
                                else lazylines (L.tail s')

we need a similarly lazy, but efficient version.

-}


-- | '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. And
--
-- > tokens isSpace = words
--
words :: ByteString -> [ByteString]
words :: ByteString -> [ByteString]
words = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
L.null) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> [ByteString]
L.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 #-}

-- | 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)
{-# INLINE readInt #-}
readInt :: ByteString -> Maybe (Int, ByteString)
readInt ByteString
Empty        = Maybe (Int, ByteString)
forall a. Maybe a
Nothing
readInt (Chunk ByteString
x ByteString
xs) = case Word8 -> Char
w2c (ByteString -> Word8
B.unsafeHead ByteString
x) of
    Char
'-' -> Bool
-> Int
-> Int
-> ByteString
-> ByteString
-> Maybe (Int, ByteString)
loop Bool
True  Int
0 Int
0 (ByteString -> ByteString
B.unsafeTail ByteString
x) ByteString
xs
    Char
'+' -> Bool
-> Int
-> Int
-> ByteString
-> ByteString
-> Maybe (Int, ByteString)
loop Bool
False Int
0 Int
0 (ByteString -> ByteString
B.unsafeTail ByteString
x) ByteString
xs
    Char
_   -> Bool
-> Int
-> Int
-> ByteString
-> ByteString
-> Maybe (Int, ByteString)
loop Bool
False Int
0 Int
0 ByteString
x ByteString
xs

    where loop :: Bool -> Int -> Int
                -> S.ByteString -> ByteString -> Maybe (Int, ByteString)
          loop :: Bool
-> Int
-> Int
-> ByteString
-> ByteString
-> Maybe (Int, ByteString)
loop Bool
neg !Int
i !Int
n !ByteString
c ByteString
cs
              | ByteString -> Bool
B.null ByteString
c = case ByteString
cs of
                             ByteString
Empty          -> Bool
-> Int
-> Int
-> ByteString
-> ByteString
-> Maybe (Int, ByteString)
forall {a} {p}.
(Eq a, Num a, Num p) =>
Bool -> a -> p -> ByteString -> ByteString -> Maybe (p, ByteString)
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
c  ByteString
cs
                             (Chunk ByteString
c' ByteString
cs') -> Bool
-> Int
-> Int
-> ByteString
-> ByteString
-> Maybe (Int, ByteString)
loop Bool
neg Int
i Int
n ByteString
c' ByteString
cs'
              | Bool
otherwise =
                  case ByteString -> Word8
B.unsafeHead ByteString
c 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
-> 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
c) ByteString
cs
                      | Bool
otherwise -> Bool
-> Int
-> Int
-> ByteString
-> ByteString
-> Maybe (Int, ByteString)
forall {a} {p}.
(Eq a, Num a, Num p) =>
Bool -> a -> p -> ByteString -> ByteString -> Maybe (p, ByteString)
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
c ByteString
cs

          {-# INLINE end #-}
          end :: Bool -> a -> p -> ByteString -> ByteString -> Maybe (p, ByteString)
end Bool
_   a
0 p
_ ByteString
_  ByteString
_ = Maybe (p, ByteString)
forall a. Maybe a
Nothing
          end Bool
neg a
_ p
n ByteString
c ByteString
cs = Maybe (p, ByteString)
e
                where n' :: p
n' = if Bool
neg then p -> p
forall a. Num a => a -> a
Evidence bound by a type signature of the constraint type Num p
negate p
n else p
n
                      c' :: ByteString
c' = ByteString -> ByteString -> ByteString
chunk ByteString
c ByteString
cs
                      e :: Maybe (p, ByteString)
e  = p
n' p -> Maybe (p, ByteString) -> Maybe (p, ByteString)
`seq` ByteString
c' ByteString -> Maybe (p, ByteString) -> Maybe (p, ByteString)
`seq` (p, ByteString) -> Maybe (p, ByteString)
forall a. a -> Maybe a
Just (p
n',ByteString
c')
         --                  in n' `seq` c' `seq` JustS n' c'


-- | 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
Empty = Maybe (Integer, ByteString)
forall a. Maybe a
Nothing
readInteger (Chunk ByteString
c0 ByteString
cs0) =
        case Word8 -> Char
w2c (ByteString -> Word8
B.unsafeHead ByteString
c0) of
            Char
'-' -> ByteString -> ByteString -> Maybe (Integer, ByteString)
first (ByteString -> ByteString
B.unsafeTail ByteString
c0) ByteString
cs0 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
cs') -> (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
cs')
            Char
'+' -> ByteString -> ByteString -> Maybe (Integer, ByteString)
first (ByteString -> ByteString
B.unsafeTail ByteString
c0) ByteString
cs0
            Char
_   -> ByteString -> ByteString -> Maybe (Integer, ByteString)
first ByteString
c0 ByteString
cs0

    where first :: ByteString -> ByteString -> Maybe (Integer, ByteString)
first ByteString
c ByteString
cs
              | ByteString -> Bool
B.null ByteString
c = case ByteString
cs of
                  ByteString
Empty          -> Maybe (Integer, ByteString)
forall a. Maybe a
Nothing
                  (Chunk ByteString
c' ByteString
cs') -> ByteString -> ByteString -> Maybe (Integer, ByteString)
first' ByteString
c' ByteString
cs'
              | Bool
otherwise = ByteString -> ByteString -> Maybe (Integer, ByteString)
first' ByteString
c ByteString
cs

          first' :: ByteString -> ByteString -> Maybe (Integer, ByteString)
first' ByteString
c ByteString
cs = case ByteString -> Word8
B.unsafeHead ByteString
c 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
-> 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
c) ByteString
cs
                | Bool
otherwise              -> Maybe (Integer, ByteString)
forall a. Maybe a
Nothing

          loop :: Int -> Int -> [Integer]
               -> S.ByteString -> ByteString -> (Integer, ByteString)
          loop :: Int
-> Int
-> [Integer]
-> ByteString
-> ByteString
-> (Integer, ByteString)
loop !Int
d !Int
acc [Integer]
ns !ByteString
c ByteString
cs
              | ByteString -> Bool
B.null ByteString
c = case ByteString
cs of
                             ByteString
Empty          -> Int
-> Int
-> [Integer]
-> ByteString
-> ByteString
-> (Integer, ByteString)
forall {a} {b} {a}.
(Integral a, Integral b, Num a) =>
b -> a -> [a] -> ByteString -> ByteString -> (a, ByteString)
External instance of the constraint type Num Integer
External instance of the constraint type Integral Int
External instance of the constraint type Integral Int
combine Int
d Int
acc [Integer]
ns ByteString
c ByteString
cs
                             (Chunk ByteString
c' ByteString
cs') -> Int
-> Int
-> [Integer]
-> ByteString
-> ByteString
-> (Integer, ByteString)
loop Int
d Int
acc [Integer]
ns ByteString
c' ByteString
cs'
              | Bool
otherwise =
                  case ByteString -> Word8
B.unsafeHead ByteString
c 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. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
9 then Int
-> Int
-> [Integer]
-> ByteString
-> 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
c) ByteString
cs
                                else Int
-> Int
-> [Integer]
-> ByteString
-> 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 b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral Int
fromIntegral Int
acc Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ns)
                                          (ByteString -> ByteString
B.unsafeTail ByteString
c) ByteString
cs
                     | Bool
otherwise -> Int
-> Int
-> [Integer]
-> ByteString
-> ByteString
-> (Integer, ByteString)
forall {a} {b} {a}.
(Integral a, Integral b, Num a) =>
b -> a -> [a] -> ByteString -> ByteString -> (a, ByteString)
External instance of the constraint type Num Integer
External instance of the constraint type Integral Int
External instance of the constraint type Integral Int
combine Int
d Int
acc [Integer]
ns ByteString
c ByteString
cs

          combine :: b -> a -> [a] -> ByteString -> ByteString -> (a, ByteString)
combine b
_ a
acc [] ByteString
c ByteString
cs = a -> ByteString -> ByteString -> (a, ByteString)
forall {a}. a -> ByteString -> ByteString -> (a, ByteString)
end (a -> a
forall a b. (Integral a, Num b) => a -> b
Evidence bound by a type signature of the constraint type Num a
Evidence bound by a type signature of the constraint type Integral a
fromIntegral a
acc) ByteString
c ByteString
cs
          combine b
d a
acc [a]
ns ByteString
c ByteString
cs =
              a -> ByteString -> ByteString -> (a, ByteString)
forall {a}. a -> ByteString -> ByteString -> (a, ByteString)
end (a
10a -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
Evidence bound by a type signature of the constraint type Integral b
Evidence bound by a type signature of the constraint type Num a
^b
d a -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
* a -> [a] -> a
forall {a}. Num a => a -> [a] -> a
Evidence bound by a type signature of the constraint type Num a
combine1 a
1000000000 [a]
ns a -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
Evidence bound by a type signature of the constraint type Num a
Evidence bound by a type signature of the constraint type Integral a
fromIntegral a
acc) ByteString
c ByteString
cs

          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
na -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
+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 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

          end :: a -> ByteString -> ByteString -> (a, ByteString)
end a
n ByteString
c ByteString
cs = let c' :: ByteString
c' = ByteString -> ByteString -> ByteString
chunk ByteString
c ByteString
cs
                        in ByteString
c' ByteString -> (a, ByteString) -> (a, ByteString)
`seq` (a
n, ByteString
c')


-- | Write a ByteString to a handle, appending a newline byte
--
hPutStrLn :: Handle -> ByteString -> IO ()
hPutStrLn :: Handle -> ByteString -> IO ()
hPutStrLn Handle
h ByteString
ps = 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
L.singleton Word8
0x0a)

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

-- ---------------------------------------------------------------------
-- Internal utilities

-- reverse a list of possibly-empty chunks into a lazy ByteString
revChunks :: [S.ByteString] -> ByteString
revChunks :: [ByteString] -> ByteString
revChunks [ByteString]
cs = (ByteString -> ByteString -> ByteString)
-> ByteString -> [ByteString] -> ByteString
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
List.foldl' ((ByteString -> ByteString -> ByteString)
-> ByteString -> ByteString -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> ByteString -> ByteString
chunk) ByteString
Empty [ByteString]
cs