{-# 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)

-- | Basic type for manipulating strings.
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

-- | Match the `word` against `searchValue` and replace matched strings with `replaceValue`.
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

-- | Match the `word` against `searchValue` and replace matched strings with the string resulting from invoking `f`.
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

-- | Match the `word` against `searchValue` and replace matched strings with the string resulting from invoking `f`.
-- 
-- The difference between this and `replaceWithFuncSingle` is that the `f` here takes two `String` arguments.
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