module Text.Replace
(
replaceWithList, replaceWithMap, replaceWithTrie
, Replace (..), ReplaceMap, listToMap, mapToAscList
, Trie, Trie' (..), listToTrie, ascListToTrie, mapToTrie, drawTrie
, String' (..), string'fromString, string'head, string'tail
) where
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 (..))
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Tree (Tree)
import qualified Data.Tree as Tree
replaceWithList
:: Foldable f
=> f Replace
-> String
-> 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
replaceWithMap
:: ReplaceMap
-> String
-> 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
replaceWithTrie
:: Trie
-> String
-> 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
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)
instance IsString String'
where
fromString :: String -> String'
fromString = String -> String'
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'
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
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
data Replace =
Replace
{ Replace -> String'
replaceFrom :: String'
, Replace -> String
replaceTo :: String
}
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)
type ReplaceMap = Map String' String
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)
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)
type Trie = Map Char Trie'
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)
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)
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
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
ascListToTrie
:: Foldable f
=> f Replace
-> 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)
-> 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