Don't strip the text surrounding a match when performing find and replace.
Meta: Cross-Reference: #2master
parent
809cca61b7
commit
444b5ea51d
|
@ -1,6 +1,5 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
|
||||
|
||||
|
@ -13,24 +12,25 @@ module Data.Text.ICU.Extras (
|
|||
#endif
|
||||
) where
|
||||
|
||||
import Prelude hiding (span)
|
||||
import Control.Applicative ((<$>), (*>), (<|>))
|
||||
import Control.Monad ((<=<))
|
||||
import Control.Error (hush)
|
||||
import Control.Monad (ap)
|
||||
import Data.Attoparsec.Text (Parser, char, digit, takeWhile1, string, many', parseOnly)
|
||||
import Data.Functor.Infix ((<$$>), (<&>))
|
||||
import Data.Maybe (isJust, fromJust)
|
||||
import Data.Monoid (Monoid(mconcat))
|
||||
import Data.Text (Text)
|
||||
import Data.Text.ICU (regex', find, group, Match)
|
||||
import Data.Text.ICU (regex', find, findAll, group, span, Match, suffix, groupCount)
|
||||
|
||||
match :: Text -> Maybe (Text -> Bool)
|
||||
match = isJust <$$> find <$$> hush . regex' []
|
||||
|
||||
findAndReplace :: Text -> Text -> Maybe (Text -> Maybe Text)
|
||||
findAndReplace pattern replacement = do
|
||||
findAnd <- find <$$> hush $ regex' [] pattern
|
||||
findAnd <- findAll <$$> hush $ regex' [] pattern
|
||||
replace <- flip runReplacement <$> parseReplacement replacement
|
||||
return $ replace <=< findAnd
|
||||
return $ replace . findAnd
|
||||
|
||||
type Replacement = [Segment]
|
||||
|
||||
|
@ -52,11 +52,19 @@ parseSegment = parseLiteral <|> parseReference <|> parseLiteralDollar
|
|||
parseReplacement :: Text -> Maybe Replacement
|
||||
parseReplacement = hush . parseOnly (many' parseSegment)
|
||||
|
||||
runReplacement :: Match -> Replacement -> Maybe Text
|
||||
runReplacement (flip group -> group) = mconcat <$$> invert . map dereference
|
||||
where dereference = \case
|
||||
Reference n -> group n
|
||||
Literal str -> Just str
|
||||
invert xs = if all isJust xs
|
||||
then Just $ fromJust <$> xs
|
||||
else Nothing
|
||||
runReplacement :: [Match] -> Replacement -> Maybe Text
|
||||
runReplacement matches replacement = mconcat <$$> invert . adornSuffix (last matches) $ do
|
||||
match <- matches
|
||||
Just (span match) : map (dereference $ flip group match) replacement
|
||||
|
||||
adornSuffix :: Match -> ([Maybe Text] -> [Maybe Text])
|
||||
adornSuffix match = (++ [ap (flip suffix) groupCount match])
|
||||
|
||||
dereference :: (Int -> Maybe Text) -> Segment -> Maybe Text
|
||||
dereference group = \case
|
||||
Reference n -> group n
|
||||
Literal str -> Just str
|
||||
|
||||
invert :: [Maybe a] -> Maybe [a]
|
||||
invert xs | all isJust xs = Just $ fromJust <$> xs
|
||||
| otherwise = Nothing
|
||||
|
|
|
@ -26,7 +26,8 @@ spec = do
|
|||
parseReplacement "$$" `shouldBe` Just [Literal "$", Literal "$"]
|
||||
describe "findAndReplace" $ do
|
||||
it "Should find and replace based upon a regular expression and pattern." $ do
|
||||
("barbaz" &) <$> findAndReplace "(.*)" "$1qux" `shouldBe` Just (Just "barbazqux")
|
||||
("barqux" &) <$> findAndReplace "(bar)" "$1baz" `shouldBe` Just (Just "barbazqux")
|
||||
("barqux" &) <$> findAndReplace "(qux)" "baz$1" `shouldBe` Just (Just "barbazqux")
|
||||
|
||||
instance Show (Text -> Bool) where
|
||||
show _ = "Text -> Bool"
|
||||
|
|
Loading…
Reference in New Issue