module Text.Replace
  (
  -- * Performing replacement
    replaceWithList, replaceWithMap, replaceWithTrie

  -- * Specifying replacements
  , Replace (..), ReplaceMap, listToMap, mapToAscList

  -- * Replacements in trie structure
  , Trie, Trie' (..), listToTrie, ascListToTrie, mapToTrie, drawTrie

  -- * Non-empty string
  , String' (..), string'fromString, string'head, string'tail

  ) where

-- base
import           Control.Arrow      ((>>>))
import qualified Data.Foldable      as Foldable
import           Data.Function      (on)
import           Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.String        (IsString (..))

-- containers
import           Data.Map        (Map)
import qualified Data.Map.Strict as Map
import           Data.Tree       (Tree)
import qualified Data.Tree       as Tree

{- | Apply a list of replacement rules to a string. The search for strings to replace is performed left-to-right, preferring longer matches to shorter ones.

Internally, the list will be converted to a 'ReplaceMap' using 'listToMap'. If the list contains more than one replacement for the same search string, the last mapping is used, and earlier mappings are ignored.

If you are going to be applying the same list of rules to multiple input strings, you should first convert the list to a 'Trie' using 'listToTrie' and then use 'replaceWithTrie' instead. -}
replaceWithList
  :: Foldable f
  => f Replace -- ^ List of replacement rules
  -> String    -- ^ Input string
  -> String    -- ^ Result after performing replacements on the input string
replaceWithList :: f Replace -> String -> String
replaceWithList = f Replace -> Trie
forall (f :: * -> *). Foldable f => f Replace -> Trie
listToTrie (f Replace -> Trie)
-> (Trie -> String -> String) -> f Replace -> String -> String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Trie -> String -> String
replaceWithTrie

{- | Apply a map of replacement rules to a string. The search for strings to replace is performed left-to-right, preferring longer matches to shorter ones.

If you are going to be applying the same list of rules to multiple input strings, you should first convert the 'Map' to a 'Trie' using 'mapToTrie' and then use 'replaceWithTrie' instead. -}
replaceWithMap
  :: ReplaceMap -- ^ Map of replacement rules
  -> String     -- ^ Input string
  -> String     -- ^ Result after performing replacements on the input string
replaceWithMap :: ReplaceMap -> String -> String
replaceWithMap = ReplaceMap -> Trie
mapToTrie (ReplaceMap -> Trie)
-> (Trie -> String -> String) -> ReplaceMap -> String -> String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Trie -> String -> String
replaceWithTrie

{- | Apply a trie of replacement rules to a string. The search for strings to replace is performed left-to-right, preferring longer matches to shorter ones.

To construct a 'Trie', you may use 'listToTrie' or 'mapToTrie'. -}
replaceWithTrie
  :: Trie   -- ^ Map of replacement rules, represented as a trie
  -> String -- ^ Input string
  -> String -- ^ Result after performing replacements on the input string
replaceWithTrie :: Trie -> String -> String
replaceWithTrie Trie
trie = String -> String
go
  where
    go :: String -> String
go [] = []
    go xs :: String
xs@(Char
x : String
xs') =
      case Trie -> String -> Maybe (String, String)
replaceWithTrie1 Trie
trie String
xs of
        Maybe (String, String)
Nothing -> Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs'
        Just (String
r, String
xs'') -> String
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
go String
xs''

replaceWithTrie1 :: Trie -> String -> Maybe (String, String)
replaceWithTrie1 :: Trie -> String -> Maybe (String, String)
replaceWithTrie1 Trie
_ [] = Maybe (String, String)
forall a. Maybe a
Nothing
replaceWithTrie1 Trie
trie (Char
x : String
xs) =
  case Char -> Trie -> Maybe Trie'
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
x Trie
trie of
    Maybe Trie'
Nothing                  -> Maybe (String, String)
forall a. Maybe a
Nothing
    Just (Trie' Maybe String
Nothing Trie
bs)  -> Trie -> String -> Maybe (String, String)
replaceWithTrie1 Trie
bs String
xs
    Just (Trie' (Just String
r) Trie
bs) -> case Trie -> String -> Maybe (String, String)
replaceWithTrie1 Trie
bs String
xs of
                                  Maybe (String, String)
Nothing -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
r, String
xs)
                                  Maybe (String, String)
longerMatch -> Maybe (String, String)
longerMatch

-- | Non-empty string.
newtype String' = String' (NonEmpty Char)
  deriving (String' -> String' -> Bool
(String' -> String' -> Bool)
-> (String' -> String' -> Bool) -> Eq String'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: String' -> String' -> Bool
$c/= :: String' -> String' -> Bool
== :: String' -> String' -> Bool
$c== :: String' -> String' -> Bool
Eq, Eq String'
Eq String'
-> (String' -> String' -> Ordering)
-> (String' -> String' -> Bool)
-> (String' -> String' -> Bool)
-> (String' -> String' -> Bool)
-> (String' -> String' -> Bool)
-> (String' -> String' -> String')
-> (String' -> String' -> String')
-> Ord String'
String' -> String' -> Bool
String' -> String' -> Ordering
String' -> String' -> String'
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: String' -> String' -> String'
$cmin :: String' -> String' -> String'
max :: String' -> String' -> String'
$cmax :: String' -> String' -> String'
>= :: String' -> String' -> Bool
$c>= :: String' -> String' -> Bool
> :: String' -> String' -> Bool
$c> :: String' -> String' -> Bool
<= :: String' -> String' -> Bool
$c<= :: String' -> String' -> Bool
< :: String' -> String' -> Bool
$c< :: String' -> String' -> Bool
compare :: String' -> String' -> Ordering
$ccompare :: String' -> String' -> Ordering
$cp1Ord :: Eq String'
Ord)

instance Show String'
  where
    showsPrec :: Int -> String' -> String -> String
showsPrec Int
i (String' NonEmpty Char
x) = Int -> String -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
i (NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Char
x)

{- | @'fromString' = 'string'fromString'@

🌶️ Warning: @('fromString' "" :: 'String'') = ⊥@ -}
instance IsString String'
  where
    fromString :: String -> String'
fromString = String -> String'
string'fromString

{- | Convert an ordinary 'String' to a non-empty 'String''.

🌶️ Warning: @string'fromString "" = ⊥@ -}
string'fromString :: String -> String'
string'fromString :: String -> String'
string'fromString = String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NonEmpty.fromList (String -> NonEmpty Char)
-> (NonEmpty Char -> String') -> String -> String'
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> NonEmpty Char -> String'
String'

{- | The first character of a non-empty string. -}
string'head :: String' -> Char
string'head :: String' -> Char
string'head (String' NonEmpty Char
x) = NonEmpty Char -> Char
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty Char
x

{- | All characters of a non-empty string except the first. -}
string'tail :: String' -> String
string'tail :: String' -> String
string'tail (String' NonEmpty Char
x) = NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NonEmpty.tail NonEmpty Char
x

{- | A replacement rule.

> Replace "abc" "xyz"

means

/When you encounter the string __@abc@__ in the input text, replace it with __@xyz@__./

The first argument must be a non-empty string, because there is no sensible way to interpret "replace all occurrences of the empty string." -}
data Replace =
  Replace
    { Replace -> String'
replaceFrom :: String' -- ^ A string we're looking for
    , Replace -> String
replaceTo   :: String  -- ^ A string we're replacing it with
    }
    deriving (Replace -> Replace -> Bool
(Replace -> Replace -> Bool)
-> (Replace -> Replace -> Bool) -> Eq Replace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Replace -> Replace -> Bool
$c/= :: Replace -> Replace -> Bool
== :: Replace -> Replace -> Bool
$c== :: Replace -> Replace -> Bool
Eq, Int -> Replace -> String -> String
[Replace] -> String -> String
Replace -> String
(Int -> Replace -> String -> String)
-> (Replace -> String)
-> ([Replace] -> String -> String)
-> Show Replace
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Replace] -> String -> String
$cshowList :: [Replace] -> String -> String
show :: Replace -> String
$cshow :: Replace -> String
showsPrec :: Int -> Replace -> String -> String
$cshowsPrec :: Int -> Replace -> String -> String
Show)

{- | A map where the keys are strings we're looking for, and the values are strings with which we're replacing a key that we find.

You may use 'listToMap' to construct a 'ReplaceMap' from a list of replacement rules, and you may use 'mapToAscList' to convert back to a list. -}
type ReplaceMap = Map String' String

{- | Construct a 'ReplaceMap' from a list of replacement rules.

If the list contains more than one replacement for the same search string, the last mapping is used, and earlier mappings are ignored. -}
listToMap :: Foldable f => f Replace -> ReplaceMap
listToMap :: f Replace -> ReplaceMap
listToMap = f Replace -> [Replace]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (f Replace -> [Replace])
-> ([Replace] -> ReplaceMap) -> f Replace -> ReplaceMap
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Replace -> (String', String)) -> [Replace] -> [(String', String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Replace -> (String', String)
toTuple ([Replace] -> [(String', String)])
-> ([(String', String)] -> ReplaceMap) -> [Replace] -> ReplaceMap
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [(String', String)] -> ReplaceMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  where
    toTuple :: Replace -> (String', String)
toTuple Replace
x = (Replace -> String'
replaceFrom Replace
x, Replace -> String
replaceTo Replace
x)

{- | Convert a replacement map to a list of replacement rules. The rules in the list will be sorted according to their 'replaceFrom' field in ascending order. -}
mapToAscList :: ReplaceMap -> [Replace]
mapToAscList :: ReplaceMap -> [Replace]
mapToAscList = ReplaceMap -> [(String', String)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (ReplaceMap -> [(String', String)])
-> ([(String', String)] -> [Replace]) -> ReplaceMap -> [Replace]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((String', String) -> Replace) -> [(String', String)] -> [Replace]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(String'
x, String
y) -> String' -> String -> Replace
Replace String'
x String
y)

{- | A representation of a 'ReplaceMap' designed for efficient lookups when we perform the replacements in 'replaceWithTrie'.

You may construct a 'Trie' using 'listToTrie' or 'mapToTrie'. -}
type Trie = Map Char Trie'

{- | A variant of 'Trie' which may contain a value at the root of the tree. -}
data Trie' =
  Trie'
    { Trie' -> Maybe String
trieRoot     :: Maybe String
    , Trie' -> Trie
trieBranches :: Trie
    }
  deriving (Trie' -> Trie' -> Bool
(Trie' -> Trie' -> Bool) -> (Trie' -> Trie' -> Bool) -> Eq Trie'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Trie' -> Trie' -> Bool
$c/= :: Trie' -> Trie' -> Bool
== :: Trie' -> Trie' -> Bool
$c== :: Trie' -> Trie' -> Bool
Eq, Int -> Trie' -> String -> String
[Trie'] -> String -> String
Trie' -> String
(Int -> Trie' -> String -> String)
-> (Trie' -> String) -> ([Trie'] -> String -> String) -> Show Trie'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Trie'] -> String -> String
$cshowList :: [Trie'] -> String -> String
show :: Trie' -> String
$cshow :: Trie' -> String
showsPrec :: Int -> Trie' -> String -> String
$cshowsPrec :: Int -> Trie' -> String -> String
Show)

{- | Draws a text diagram of a trie; useful for debugging. -}
drawTrie :: Trie -> String
drawTrie :: Trie -> String
drawTrie = Trie -> Forest String
trieForest (Trie -> Forest String)
-> (Forest String -> String) -> Trie -> String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Forest String -> String
Tree.drawForest

trieForest :: Trie -> Tree.Forest String
trieForest :: Trie -> Forest String
trieForest =
  Trie -> [(Char, Trie')]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Trie -> [(Char, Trie')])
-> ([(Char, Trie')] -> Forest String) -> Trie -> Forest String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  ((Char, Trie') -> Tree String) -> [(Char, Trie')] -> Forest String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Char
c, Trie'
t) -> String -> Trie' -> Tree String
trieTree [Char
c] Trie'
t)

trieTree :: String -> Trie' -> Tree String
trieTree :: String -> Trie' -> Tree String
trieTree String
c (Trie' Maybe String
r Trie
bs) =
  case (Maybe String
r, Trie -> [(Char, Trie')]
forall k a. Map k a -> [(k, a)]
Map.toAscList Trie
bs) of
    (Maybe String
Nothing, [(Char
c', Trie'
t)]) -> String -> Trie' -> Tree String
trieTree (String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c']) Trie'
t
    (Maybe String, [(Char, Trie')])
_ -> String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node (String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
rr -> String
" - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
rr) Maybe String
r)
                   (Trie -> Forest String
trieForest Trie
bs)

{- | Convert a replacement map to a trie, which is used to efficiently implement 'replaceWithTrie'. -}
mapToTrie :: ReplaceMap -> Trie
mapToTrie :: ReplaceMap -> Trie
mapToTrie = ReplaceMap -> [Replace]
mapToAscList (ReplaceMap -> [Replace])
-> ([Replace] -> Trie) -> ReplaceMap -> Trie
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Replace] -> Trie
forall (f :: * -> *). Foldable f => f Replace -> Trie
ascListToTrie

{- | Convert a list of replacement rules to a trie, which is used to efficiently implement 'replaceWithTrie'.

If the list contains more than one replacement for the same search string, the last mapping is used, and earlier mappings are ignored. -}
listToTrie :: Foldable f => f Replace -> Trie
listToTrie :: f Replace -> Trie
listToTrie = f Replace -> ReplaceMap
forall (f :: * -> *). Foldable f => f Replace -> ReplaceMap
listToMap (f Replace -> ReplaceMap)
-> (ReplaceMap -> Trie) -> f Replace -> Trie
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ReplaceMap -> Trie
mapToTrie

{- | Convert a list of replacement rules to a 'Trie', where the rules must be sorted in ascending order by the 'replaceFrom' field.

🌶️ Warning: this precondition is not checked. If you are not sure, it is safer to use 'listToTrie' instead. -}
ascListToTrie
  :: Foldable f
  => f Replace  -- ^ This list must be sorted according to the 'replaceFrom'
                --   field in ascending order
                --
                -- 🌶️ Warning: this precondition is not checked
  -> Trie
ascListToTrie :: f Replace -> Trie
ascListToTrie =
  (Replace -> Replace -> Bool) -> f Replace -> [NonEmpty Replace]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NonEmpty.groupBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Char -> Char -> Bool)
-> (Replace -> Char) -> Replace -> Replace -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Replace -> String'
replaceFrom (Replace -> String') -> (String' -> Char) -> Replace -> Char
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> String' -> Char
string'head)) (f Replace -> [NonEmpty Replace])
-> ([NonEmpty Replace] -> Trie) -> f Replace -> Trie
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  (NonEmpty Replace -> (Char, Trie'))
-> [NonEmpty Replace] -> [(Char, Trie')]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NonEmpty Replace
xs -> (NonEmpty Replace -> Char
firstChar NonEmpty Replace
xs, NonEmpty Replace -> Trie'
subtrie NonEmpty Replace
xs)) ([NonEmpty Replace] -> [(Char, Trie')])
-> ([(Char, Trie')] -> Trie) -> [NonEmpty Replace] -> Trie
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  [(Char, Trie')] -> Trie
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList
  where
    firstChar :: NonEmpty Replace -> Char
firstChar = NonEmpty Replace -> Replace
forall a. NonEmpty a -> a
NonEmpty.head (NonEmpty Replace -> Replace)
-> (Replace -> Char) -> NonEmpty Replace -> Char
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Replace -> String'
replaceFrom (Replace -> String') -> (String' -> Char) -> Replace -> Char
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> String' -> Char
string'head
    subtrie :: NonEmpty Replace -> Trie'
subtrie = (Replace -> (String, String))
-> NonEmpty Replace -> NonEmpty (String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Replace String'
x String
y) -> (String' -> String
string'tail String'
x, String
y)) (NonEmpty Replace -> NonEmpty (String, String))
-> (NonEmpty (String, String) -> Trie')
-> NonEmpty Replace
-> Trie'
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> NonEmpty (String, String) -> Trie'
forall (f :: * -> *). Foldable f => f (String, String) -> Trie'
ascListToTrie'

ascListToTrie'
  :: Foldable f
  => f (String, String)  -- ^ This list must be sorted according to the left
                         --   field of the tuple in ascending order
                         --
                         -- 🌶️ Warning: this precondition is not checked
  -> Trie'
ascListToTrie' :: f (String, String) -> Trie'
ascListToTrie' = f (String, String) -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (f (String, String) -> [(String, String)])
-> ([(String, String)] -> Trie') -> f (String, String) -> Trie'
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [(String, String)] -> Trie'
f
  where
    f :: [(String, String)] -> Trie'
    f :: [(String, String)] -> Trie'
f (([], String
x) : [(String, String)]
xs) = Maybe String -> Trie -> Trie'
Trie' (String -> Maybe String
forall a. a -> Maybe a
Just String
x) ([(String, String)] -> Trie
forall (f :: * -> *).
(Foldable f, Functor f) =>
f (String, String) -> Trie
g [(String, String)]
xs)
    f [(String, String)]
xs             = Maybe String -> Trie -> Trie'
Trie' Maybe String
forall a. Maybe a
Nothing ([(String, String)] -> Trie
forall (f :: * -> *).
(Foldable f, Functor f) =>
f (String, String) -> Trie
g [(String, String)]
xs)

    g :: (Foldable f, Functor f) => f (String, String) -> Trie
    g :: f (String, String) -> Trie
g = ((String, String) -> Replace) -> f (String, String) -> f Replace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(String
x, String
y) -> String' -> String -> Replace
Replace (String -> String'
string'fromString String
x) String
y) (f (String, String) -> f Replace)
-> (f Replace -> Trie) -> f (String, String) -> Trie
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> f Replace -> Trie
forall (f :: * -> *). Foldable f => f Replace -> Trie
ascListToTrie