{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE CPP #-}
module Data.Text.ICU.Replace
(
Replace
, replace
, replace'
, replaceAll
, replaceAll'
, rgroup
, rtext
, rstring
, rfn
, rtfn
, rbuilder
) where
import Control.Applicative
import Data.Attoparsec.Text
import Data.Foldable
#if __GLASGOW_HASKELL__ >= 804
import Data.Semigroup (Semigroup)
#endif
import Data.Monoid
import Data.String
import qualified Data.Text as T
import Data.Text.ICU
import qualified Data.Text.ICU as ICU
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Data.Tuple
import Prelude hiding (span)
newtype Replace = Replace { Replace -> Match -> Builder
unReplace :: Match -> TB.Builder } deriving
( Semigroup Replace
Replace
[Replace] -> Replace
Replace -> Replace -> Replace
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Replace] -> Replace
$cmconcat :: [Replace] -> Replace
mappend :: Replace -> Replace -> Replace
$cmappend :: Replace -> Replace -> Replace
mempty :: Replace
$cmempty :: Replace
Monoid
#if __GLASGOW_HASKELL__ >= 804
, NonEmpty Replace -> Replace
Replace -> Replace -> Replace
forall b. Integral b => b -> Replace -> Replace
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Replace -> Replace
$cstimes :: forall b. Integral b => b -> Replace -> Replace
sconcat :: NonEmpty Replace -> Replace
$csconcat :: NonEmpty Replace -> Replace
<> :: Replace -> Replace -> Replace
$c<> :: Replace -> Replace -> Replace
Semigroup
#endif
)
instance IsString Replace where
fromString :: String -> Replace
fromString = Text -> Replace
parseReplace forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
type MatchState = (Match, Int)
replace :: Regex
-> Replace
-> T.Text
-> T.Text
replace :: Regex -> Replace -> Text -> Text
replace Regex
re Replace
r Text
t = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
t (Replace -> Match -> Text
replace' Replace
r) forall a b. (a -> b) -> a -> b
$ Regex -> Text -> Maybe Match
ICU.find Regex
re Text
t
replace' :: Replace
-> Match
-> T.Text
replace' :: Replace -> Match -> Text
replace' Replace
r Match
m =
Last MatchState -> Builder -> Text
finish (forall a. Maybe a -> Last a
Last (forall a. a -> Maybe a
Just (Match
m, Int
0))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
p forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ Replace -> Match -> Builder
unReplace Replace
r Match
m
where
p :: Builder
p = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Builder
TB.fromText forall a b. (a -> b) -> a -> b
$ Int -> Match -> Maybe Text
prefix Int
0 Match
m
replaceAll :: Regex
-> Replace
-> T.Text
-> T.Text
replaceAll :: Regex -> Replace -> Text -> Text
replaceAll Regex
re Replace
r Text
t = case Regex -> Text -> [Match]
ICU.findAll Regex
re Text
t of
[] -> Text
t
[Match]
ms -> Replace -> [Match] -> Text
replaceAll' Replace
r [Match]
ms
replaceAll' :: Replace
-> [Match]
-> T.Text
replaceAll' :: Replace -> [Match] -> Text
replaceAll' Replace
r =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Last MatchState -> Builder -> Text
finish forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Last MatchState, Builder) -> Match -> (Last MatchState, Builder)
step (forall a. Maybe a -> Last a
Last forall a. Maybe a
Nothing, forall a. Monoid a => a
mempty)
where
step :: (Last MatchState, TB.Builder)
-> Match
-> (Last MatchState, TB.Builder)
step :: (Last MatchState, Builder) -> Match -> (Last MatchState, Builder)
step (Last Maybe MatchState
prev, Builder
buffer) Match
m =
let s :: Text
s = Match -> Text
span Match
m
g :: Text
g = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ Int -> Match -> Maybe Text
group Int
0 Match
m
offset :: Int
offset = (forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
g) forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a b. (a, b) -> b
snd Maybe MatchState
prev
in ( forall a. Maybe a -> Last a
Last forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Match
m, Int
offset)
, Builder
buffer forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText Text
s forall a. Semigroup a => a -> a -> a
<> Replace -> Match -> Builder
unReplace Replace
r Match
m
)
finish :: Last MatchState
-> TB.Builder
-> T.Text
finish :: Last MatchState -> Builder -> Text
finish Last MatchState
m Builder
b = Text -> Text
TL.toStrict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend Builder
b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TB.fromText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
forall a b. (a -> b) -> a -> b
$ Int -> Match -> Maybe Text
suffix Int
0
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Last a -> Maybe a
getLast Last MatchState
m
rgroup :: Int
-> Replace
rgroup :: Int -> Replace
rgroup Int
g = (Match -> Builder) -> Replace
Replace forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Builder
TB.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Match -> Maybe Text
group Int
g
rtext :: T.Text
-> Replace
rtext :: Text -> Replace
rtext = Builder -> Replace
rbuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TB.fromText
rstring :: String
-> Replace
rstring :: String -> Replace
rstring = Builder -> Replace
rbuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
TB.fromString
rfn :: (Match -> TB.Builder)
-> Replace
rfn :: (Match -> Builder) -> Replace
rfn = (Match -> Builder) -> Replace
Replace
rtfn :: (Match -> T.Text)
-> Replace
rtfn :: (Match -> Text) -> Replace
rtfn = (Match -> Builder) -> Replace
Replace forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Builder
TB.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
rbuilder :: TB.Builder
-> Replace
rbuilder :: Builder -> Replace
rbuilder = (Match -> Builder) -> Replace
Replace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
parseReplace :: T.Text -> Replace
parseReplace :: Text -> Replace
parseReplace Text
t = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Text -> Replace
rtext Text
t) forall a. a -> a
id
forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Text -> Either String a
parseOnly (Parser Text Replace
replacement forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput) Text
t
replacement :: Parser Replace
replacement :: Parser Text Replace
replacement = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text Replace
dollarGroup forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Replace
raw)
dollarGroup :: Parser Replace
dollarGroup :: Parser Text Replace
dollarGroup = Char -> Parser Char
char Char
'$' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text Replace
grp forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Replace
escaped)
where curly :: Parser Text Int
curly = Char -> Parser Char
char Char
'{' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Integral a => Parser a
decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'}'
grp :: Parser Text Replace
grp = Int -> Replace
rgroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Integral a => Parser a
decimal forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Int
curly)
escaped :: Parser Text Replace
escaped = Text -> Replace
rtext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser Char
char Char
'$'
raw :: Parser Replace
raw :: Parser Text Replace
raw = Text -> Replace
rtext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
takeWhile1 (forall a. Eq a => a -> a -> Bool
/= Char
'$')