{- |  simple (no regex) fast replace on 'B.ByteString's 

All occurrences are replaced. There is no Once option

see 'S.replace' for detail   -}
module Text.Regex.Do.Replace.Fast where

import qualified Data.ByteString.Search as S
import Data.ByteString as B 
import qualified Data.ByteString.Lazy as L
import Text.Regex.Do.Match.Matchf


{- | >>> replace "\n" "," "a\nbc\nde"

    "a,bc,de"       -}
replace::ByteString -- ^ Pattern 
        -> ByteString  -- ^ Replacement
        -> ByteString   -- ^ Body
        -> ByteString
replace :: ByteString -> ByteString -> ByteString -> ByteString
replace pat0 :: ByteString
pat0
  replacement0 :: ByteString
replacement0
  body0 :: ByteString
body0 = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
l
  where l :: ByteString
l = ByteString -> ByteString -> ByteString -> ByteString
forall rep.
Substitution rep =>
ByteString -> rep -> ByteString -> ByteString
S.replace ByteString
pat1 ByteString
replacement0 ByteString
body0
        !pat1 :: ByteString
pat1 = ByteString -> ByteString
checkPattern ByteString
pat0