{-# LANGUAGE NamedFieldPuns #-}
module Data.Owoify.Internal.Entity.Word
( InnerWord(..)
, innerReplace
, innerReplaceWithFuncSingle
, innerReplaceWithFuncMultiple
, toText
)
where
import Prelude
import Data.Maybe (listToMaybe)
import Data.Text.Lazy (strip, Text)
import qualified Data.Text.Lazy (replace)
import Text.RE.PCRE.Text.Lazy ((*=~), anyMatches, matches, RE)
import Text.RE.Replace (replaceAll)
import Data.List (nub)
data InnerWord = InnerWord
{ InnerWord -> Text
innerWord :: Text
, InnerWord -> [Text]
innerReplacedWords :: [Text]
} deriving (InnerWord -> InnerWord -> Bool
(InnerWord -> InnerWord -> Bool)
-> (InnerWord -> InnerWord -> Bool) -> Eq InnerWord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InnerWord -> InnerWord -> Bool
$c/= :: InnerWord -> InnerWord -> Bool
== :: InnerWord -> InnerWord -> Bool
$c== :: InnerWord -> InnerWord -> Bool
Eq, Int -> InnerWord -> ShowS
[InnerWord] -> ShowS
InnerWord -> String
(Int -> InnerWord -> ShowS)
-> (InnerWord -> String)
-> ([InnerWord] -> ShowS)
-> Show InnerWord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InnerWord] -> ShowS
$cshowList :: [InnerWord] -> ShowS
show :: InnerWord -> String
$cshow :: InnerWord -> String
showsPrec :: Int -> InnerWord -> ShowS
$cshowsPrec :: Int -> InnerWord -> ShowS
Show)
toText :: InnerWord -> Text
toText :: InnerWord -> Text
toText InnerWord{ Text
innerWord :: Text
innerWord :: InnerWord -> Text
innerWord } = Text
innerWord
testAndGetReplacingWord :: RE -> Text -> Text -> Text
testAndGetReplacingWord :: RE -> Text -> Text -> Text
testAndGetReplacingWord RE
searchValue Text
replaceValue Text
str =
let matchedItems :: Matches Text
matchedItems = Text
str Text -> RE -> Matches Text
*=~ RE
searchValue in
if Matches Text -> Bool
forall a. Matches a -> Bool
anyMatches Matches Text
matchedItems then
case [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Matches Text -> [Text]
forall a. Matches a -> [a]
matches Matches Text
matchedItems of
Maybe Text
Nothing -> Text
str
Just Text
hd -> Text -> Text -> Text -> Text
Data.Text.Lazy.replace Text
hd Text
replaceValue Text
str
else
Text
str
containsReplacedWords :: InnerWord -> RE -> Text -> Bool
containsReplacedWords :: InnerWord -> RE -> Text -> Bool
containsReplacedWords InnerWord { [Text]
innerReplacedWords :: [Text]
innerReplacedWords :: InnerWord -> [Text]
innerReplacedWords } RE
searchValue Text
replaceValue =
(Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
s -> let matchedItems :: Matches Text
matchedItems = Text
s Text -> RE -> Matches Text
*=~ RE
searchValue in
Matches Text -> Bool
forall a. Matches a -> Bool
anyMatches Matches Text
matchedItems Bool -> Bool -> Bool
&& (
let replacedWord :: Text
replacedWord = Text -> Text -> Text -> Text
Data.Text.Lazy.replace ([Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Matches Text -> [Text]
forall a. Matches a -> [a]
matches Matches Text
matchedItems) Text
replaceValue Text
s in
Text
replacedWord Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s)) [Text]
innerReplacedWords
buildCollection :: RE -> Text -> [Text]
buildCollection :: RE -> Text -> [Text]
buildCollection RE
searchValue Text
str = Matches Text -> [Text]
forall a. Matches a -> [a]
matches (Matches Text -> [Text]) -> Matches Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
str Text -> RE -> Matches Text
*=~ RE
searchValue
buildReplacedWords :: Functor f => Text -> f Text -> f Text
buildReplacedWords :: forall (f :: * -> *). Functor f => Text -> f Text -> f Text
buildReplacedWords Text
replaceValue f Text
texts = (\Text
s -> Text -> Text -> Text -> Text
Data.Text.Lazy.replace Text
s Text
replaceValue Text
s) (Text -> Text) -> f Text -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Text
texts
innerReplace :: InnerWord -> RE -> Text -> Bool -> InnerWord
innerReplace :: InnerWord -> RE -> Text -> Bool -> InnerWord
innerReplace word :: InnerWord
word@InnerWord { Text
innerWord :: Text
innerWord :: InnerWord -> Text
innerWord, [Text]
innerReplacedWords :: [Text]
innerReplacedWords :: InnerWord -> [Text]
innerReplacedWords } RE
searchValue Text
replaceValue Bool
replaceReplacedWords
| Bool -> Bool
not Bool
replaceReplacedWords Bool -> Bool -> Bool
&& InnerWord -> RE -> Text -> Bool
containsReplacedWords InnerWord
word RE
searchValue Text
replaceValue = InnerWord
word
| Bool
otherwise = if Text
replacingWord Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
innerWord then InnerWord
word else InnerWord :: Text -> [Text] -> InnerWord
InnerWord { innerWord :: Text
innerWord = Text
replacingWord, innerReplacedWords :: [Text]
innerReplacedWords = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
innerReplacedWords [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
replacedWords }
where
matchedItems :: Matches Text
matchedItems = Text
innerWord Text -> RE -> Matches Text
*=~ RE
searchValue
collection :: [Text]
collection = Matches Text -> [Text]
forall a. Matches a -> [a]
matches Matches Text
matchedItems
replacingWord :: Text
replacingWord = case [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
collection of
Maybe Text
Nothing -> Text
innerWord
Just Text
_ -> Text -> Text
strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Matches Text -> Text
forall a. Replace a => a -> Matches a -> a
replaceAll Text
replaceValue Matches Text
matchedItems
replacedWords :: [Text]
replacedWords = Text -> [Text] -> [Text]
forall (f :: * -> *). Functor f => Text -> f Text -> f Text
buildReplacedWords Text
replaceValue [Text]
collection
innerReplaceWithFuncSingle :: InnerWord -> RE -> (() -> Text) -> Bool -> InnerWord
innerReplaceWithFuncSingle :: InnerWord -> RE -> (() -> Text) -> Bool -> InnerWord
innerReplaceWithFuncSingle word :: InnerWord
word@InnerWord { Text
innerWord :: Text
innerWord :: InnerWord -> Text
innerWord, [Text]
innerReplacedWords :: [Text]
innerReplacedWords :: InnerWord -> [Text]
innerReplacedWords } RE
searchValue () -> Text
f Bool
replaceReplacedWords
| Bool -> Bool
not Bool
replaceReplacedWords Bool -> Bool -> Bool
&& InnerWord -> RE -> Text -> Bool
containsReplacedWords InnerWord
word RE
searchValue Text
replaceValue = InnerWord
word
| Text
replacingWord Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
innerWord = InnerWord
word
| Bool
otherwise = InnerWord :: Text -> [Text] -> InnerWord
InnerWord { innerWord :: Text
innerWord = Text
replacingWord, innerReplacedWords :: [Text]
innerReplacedWords = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
innerReplacedWords [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
replacedWords }
where
replaceValue :: Text
replaceValue = () -> Text
f ()
replacingWord :: Text
replacingWord
= Text -> Text
strip
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ RE -> Text -> Text -> Text
testAndGetReplacingWord RE
searchValue Text
replaceValue Text
innerWord
collection :: [Text]
collection = RE -> Text -> [Text]
buildCollection RE
searchValue Text
replaceValue
replacedWords :: [Text]
replacedWords = Text -> [Text] -> [Text]
forall (f :: * -> *). Functor f => Text -> f Text -> f Text
buildReplacedWords Text
replaceValue [Text]
collection
innerReplaceWithFuncMultiple :: InnerWord -> RE -> (Text -> Text -> Text) -> Bool -> InnerWord
innerReplaceWithFuncMultiple :: InnerWord -> RE -> (Text -> Text -> Text) -> Bool -> InnerWord
innerReplaceWithFuncMultiple word :: InnerWord
word@InnerWord { Text
innerWord :: Text
innerWord :: InnerWord -> Text
innerWord, [Text]
innerReplacedWords :: [Text]
innerReplacedWords :: InnerWord -> [Text]
innerReplacedWords } RE
searchValue Text -> Text -> Text
f Bool
replaceReplacedWords
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Matches Text -> Bool
forall a. Matches a -> Bool
anyMatches Matches Text
matchedItems = InnerWord
word
| Bool
otherwise =
if (Bool -> Bool
not Bool
replaceReplacedWords Bool -> Bool -> Bool
&& InnerWord -> RE -> Text -> Bool
containsReplacedWords InnerWord
word RE
searchValue Text
replaceValue) Bool -> Bool -> Bool
|| (Text
replacingWord Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
innerWord) then InnerWord
word
else InnerWord :: Text -> [Text] -> InnerWord
InnerWord { innerWord :: Text
innerWord = Text
replacingWord, innerReplacedWords :: [Text]
innerReplacedWords = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
innerReplacedWords [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
replacedWords }
where
matchedItems :: Matches Text
matchedItems = Text
innerWord Text -> RE -> Matches Text
*=~ RE
searchValue
collection :: [Text]
collection = Matches Text -> [Text]
forall a. Matches a -> [a]
matches Matches Text
matchedItems
(Text
s1 : Text
s2 : Text
s3 : [Text]
_) = if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
collection Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 then [Text]
collection else [Text
innerWord, Text
innerWord, Text
innerWord]
replaceValue :: Text
replaceValue = Text -> Text -> Text
f Text
s2 Text
s3
replacingWord :: Text
replacingWord = Text -> Text
strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
Data.Text.Lazy.replace Text
s1 Text
replaceValue Text
innerWord
replacedWords :: [Text]
replacedWords = Text -> [Text] -> [Text]
forall (f :: * -> *). Functor f => Text -> f Text -> f Text
buildReplacedWords Text
replaceValue [Text]
collection