{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}

module Brassica.Paradigm.Apply
       ( ResultsTree(..)
       , applyParadigm
       , formatNested
       , depth
       ) where

import Brassica.Paradigm.Types

import Data.Functor ((<&>))
import Data.List (sortOn, foldl', intercalate)
import Data.Maybe (mapMaybe)
import Data.Ord (Down(Down))

-- | Results from applying a 'Paradigm' to a word, represented as a tree
-- containing each possible choice of 'Grammeme's.
data ResultsTree a = Node [ResultsTree a] | Result a
    deriving (Int -> ResultsTree a -> ShowS
[ResultsTree a] -> ShowS
ResultsTree a -> String
(Int -> ResultsTree a -> ShowS)
-> (ResultsTree a -> String)
-> ([ResultsTree a] -> ShowS)
-> Show (ResultsTree a)
forall a. Show a => Int -> ResultsTree a -> ShowS
forall a. Show a => [ResultsTree a] -> ShowS
forall a. Show a => ResultsTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ResultsTree a -> ShowS
showsPrec :: Int -> ResultsTree a -> ShowS
$cshow :: forall a. Show a => ResultsTree a -> String
show :: ResultsTree a -> String
$cshowList :: forall a. Show a => [ResultsTree a] -> ShowS
showList :: [ResultsTree a] -> ShowS
Show, (forall a b. (a -> b) -> ResultsTree a -> ResultsTree b)
-> (forall a b. a -> ResultsTree b -> ResultsTree a)
-> Functor ResultsTree
forall a b. a -> ResultsTree b -> ResultsTree a
forall a b. (a -> b) -> ResultsTree a -> ResultsTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ResultsTree a -> ResultsTree b
fmap :: forall a b. (a -> b) -> ResultsTree a -> ResultsTree b
$c<$ :: forall a b. a -> ResultsTree b -> ResultsTree a
<$ :: forall a b. a -> ResultsTree b -> ResultsTree a
Functor, (forall m. Monoid m => ResultsTree m -> m)
-> (forall m a. Monoid m => (a -> m) -> ResultsTree a -> m)
-> (forall m a. Monoid m => (a -> m) -> ResultsTree a -> m)
-> (forall a b. (a -> b -> b) -> b -> ResultsTree a -> b)
-> (forall a b. (a -> b -> b) -> b -> ResultsTree a -> b)
-> (forall b a. (b -> a -> b) -> b -> ResultsTree a -> b)
-> (forall b a. (b -> a -> b) -> b -> ResultsTree a -> b)
-> (forall a. (a -> a -> a) -> ResultsTree a -> a)
-> (forall a. (a -> a -> a) -> ResultsTree a -> a)
-> (forall a. ResultsTree a -> [a])
-> (forall a. ResultsTree a -> Bool)
-> (forall a. ResultsTree a -> Int)
-> (forall a. Eq a => a -> ResultsTree a -> Bool)
-> (forall a. Ord a => ResultsTree a -> a)
-> (forall a. Ord a => ResultsTree a -> a)
-> (forall a. Num a => ResultsTree a -> a)
-> (forall a. Num a => ResultsTree a -> a)
-> Foldable ResultsTree
forall a. Eq a => a -> ResultsTree a -> Bool
forall a. Num a => ResultsTree a -> a
forall a. Ord a => ResultsTree a -> a
forall m. Monoid m => ResultsTree m -> m
forall a. ResultsTree a -> Bool
forall a. ResultsTree a -> Int
forall a. ResultsTree a -> [a]
forall a. (a -> a -> a) -> ResultsTree a -> a
forall m a. Monoid m => (a -> m) -> ResultsTree a -> m
forall b a. (b -> a -> b) -> b -> ResultsTree a -> b
forall a b. (a -> b -> b) -> b -> ResultsTree a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ResultsTree m -> m
fold :: forall m. Monoid m => ResultsTree m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ResultsTree a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ResultsTree a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ResultsTree a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ResultsTree a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ResultsTree a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ResultsTree a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ResultsTree a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ResultsTree a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ResultsTree a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ResultsTree a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ResultsTree a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ResultsTree a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ResultsTree a -> a
foldr1 :: forall a. (a -> a -> a) -> ResultsTree a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ResultsTree a -> a
foldl1 :: forall a. (a -> a -> a) -> ResultsTree a -> a
$ctoList :: forall a. ResultsTree a -> [a]
toList :: forall a. ResultsTree a -> [a]
$cnull :: forall a. ResultsTree a -> Bool
null :: forall a. ResultsTree a -> Bool
$clength :: forall a. ResultsTree a -> Int
length :: forall a. ResultsTree a -> Int
$celem :: forall a. Eq a => a -> ResultsTree a -> Bool
elem :: forall a. Eq a => a -> ResultsTree a -> Bool
$cmaximum :: forall a. Ord a => ResultsTree a -> a
maximum :: forall a. Ord a => ResultsTree a -> a
$cminimum :: forall a. Ord a => ResultsTree a -> a
minimum :: forall a. Ord a => ResultsTree a -> a
$csum :: forall a. Num a => ResultsTree a -> a
sum :: forall a. Num a => ResultsTree a -> a
$cproduct :: forall a. Num a => ResultsTree a -> a
product :: forall a. Num a => ResultsTree a -> a
Foldable)

addLevel :: (a -> [a]) -> ResultsTree a -> ResultsTree a
addLevel :: forall a. (a -> [a]) -> ResultsTree a -> ResultsTree a
addLevel a -> [a]
f (Result a
r) = [ResultsTree a] -> ResultsTree a
forall a. [ResultsTree a] -> ResultsTree a
Node ([ResultsTree a] -> ResultsTree a)
-> [ResultsTree a] -> ResultsTree a
forall a b. (a -> b) -> a -> b
$ a -> ResultsTree a
forall a. a -> ResultsTree a
Result (a -> ResultsTree a) -> [a] -> [ResultsTree a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
f a
r
addLevel a -> [a]
f (Node [ResultsTree a]
rs) = [ResultsTree a] -> ResultsTree a
forall a. [ResultsTree a] -> ResultsTree a
Node ([ResultsTree a] -> ResultsTree a)
-> [ResultsTree a] -> ResultsTree a
forall a b. (a -> b) -> a -> b
$ (a -> [a]) -> ResultsTree a -> ResultsTree a
forall a. (a -> [a]) -> ResultsTree a -> ResultsTree a
addLevel a -> [a]
f (ResultsTree a -> ResultsTree a)
-> [ResultsTree a] -> [ResultsTree a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsTree a]
rs

-- | Depth of a 'ResultsTree': i.e. how many levels of 'Node's it
-- contains.
depth :: ResultsTree a -> Int
depth :: forall a. ResultsTree a -> Int
depth (Node [ResultsTree a]
ts) = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (ResultsTree a -> Int) -> ResultsTree a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultsTree a -> Int
forall a. ResultsTree a -> Int
depth (ResultsTree a -> Int) -> [ResultsTree a] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsTree a]
ts
depth (Result a
_) = Int
0

-- | Formats a 'ResultsTree' in a nested way, where the lowest-level
-- elements are separated by one space, the second-lowest are
-- separated by one newline, the third-lowest by two newlines, and so
-- on.
formatNested :: (a -> String) -> ResultsTree a -> String
formatNested :: forall a. (a -> String) -> ResultsTree a -> String
formatNested a -> String
f = (Int, String) -> String
forall a b. (a, b) -> b
snd ((Int, String) -> String)
-> (ResultsTree a -> (Int, String)) -> ResultsTree a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultsTree a -> (Int, String)
go
  where
    go :: ResultsTree a -> (Int, String)
go (Result a
a) = (Int
0, a -> String
f a
a)
    go (Node [ResultsTree a]
rts) =
        let ([Int]
depths, [String]
formatted) = [(Int, String)] -> ([Int], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, String)] -> ([Int], [String]))
-> [(Int, String)] -> ([Int], [String])
forall a b. (a -> b) -> a -> b
$ ResultsTree a -> (Int, String)
go (ResultsTree a -> (Int, String))
-> [ResultsTree a] -> [(Int, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsTree a]
rts
            depth' :: Int
depth' = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
depths
            separator :: String
separator =
                if Int
depth' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then String
" "
                else Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
depth' Char
'\n'
        in (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
depth', String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
separator [String]
formatted)

-- | Apply the given 'Paradigm' to a root, to produce all possible
-- derived forms.
applyParadigm :: Paradigm -> String -> ResultsTree String
applyParadigm :: Paradigm -> String -> ResultsTree String
applyParadigm Paradigm
p String
w =
    let fs :: [Feature]
fs = (Statement -> Maybe Feature) -> Paradigm -> [Feature]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Statement -> Maybe Feature
getFeature Paradigm
p
        ms :: [([AbstractGrammeme], Affix)]
ms = (Statement -> Maybe ([AbstractGrammeme], Affix))
-> Paradigm -> [([AbstractGrammeme], Affix)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Statement -> Maybe ([AbstractGrammeme], Affix)
getMapping Paradigm
p
    in String -> Affix -> String
applyTo String
w (Affix -> String) -> ([Grammeme] -> Affix) -> [Grammeme] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([AbstractGrammeme], Affix)] -> [Grammeme] -> Affix
expand [([AbstractGrammeme], Affix)]
ms ([Grammeme] -> String)
-> ResultsTree [Grammeme] -> ResultsTree String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Feature] -> ResultsTree [Grammeme]
combinations [Feature]
fs
  where
    getFeature :: Statement -> Maybe Feature
getFeature (NewFeature Feature
f) = Feature -> Maybe Feature
forall a. a -> Maybe a
Just Feature
f
    getFeature Statement
_ = Maybe Feature
forall a. Maybe a
Nothing

    getMapping :: Statement -> Maybe ([AbstractGrammeme], Affix)
getMapping (NewMapping [AbstractGrammeme]
k Affix
v) = ([AbstractGrammeme], Affix) -> Maybe ([AbstractGrammeme], Affix)
forall a. a -> Maybe a
Just ([AbstractGrammeme]
k,Affix
v)
    getMapping Statement
_ = Maybe ([AbstractGrammeme], Affix)
forall a. Maybe a
Nothing

combinations :: [Feature] -> ResultsTree [Grammeme]
combinations :: [Feature] -> ResultsTree [Grammeme]
combinations =
    (([(Maybe FeatureName, Grammeme)] -> [Grammeme])
-> ResultsTree [(Maybe FeatureName, Grammeme)]
-> ResultsTree [Grammeme]
forall a b. (a -> b) -> ResultsTree a -> ResultsTree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(([(Maybe FeatureName, Grammeme)] -> [Grammeme])
 -> ResultsTree [(Maybe FeatureName, Grammeme)]
 -> ResultsTree [Grammeme])
-> (((Maybe FeatureName, Grammeme) -> Grammeme)
    -> [(Maybe FeatureName, Grammeme)] -> [Grammeme])
-> ((Maybe FeatureName, Grammeme) -> Grammeme)
-> ResultsTree [(Maybe FeatureName, Grammeme)]
-> ResultsTree [Grammeme]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Maybe FeatureName, Grammeme) -> Grammeme)
-> [(Maybe FeatureName, Grammeme)] -> [Grammeme]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Maybe FeatureName, Grammeme) -> Grammeme
forall a b. (a, b) -> b
snd (ResultsTree [(Maybe FeatureName, Grammeme)]
 -> ResultsTree [Grammeme])
-> ([Feature] -> ResultsTree [(Maybe FeatureName, Grammeme)])
-> [Feature]
-> ResultsTree [Grammeme]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResultsTree [(Maybe FeatureName, Grammeme)]
 -> Feature -> ResultsTree [(Maybe FeatureName, Grammeme)])
-> ResultsTree [(Maybe FeatureName, Grammeme)]
-> [Feature]
-> ResultsTree [(Maybe FeatureName, Grammeme)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ResultsTree [(Maybe FeatureName, Grammeme)]
-> Feature -> ResultsTree [(Maybe FeatureName, Grammeme)]
go ([(Maybe FeatureName, Grammeme)]
-> ResultsTree [(Maybe FeatureName, Grammeme)]
forall a. a -> ResultsTree a
Result [])
  where
    addFeature
        :: Feature
        -> [(Maybe FeatureName, Grammeme)]
        -> [[(Maybe FeatureName, Grammeme)]]
    addFeature :: Feature
-> [(Maybe FeatureName, Grammeme)]
-> [[(Maybe FeatureName, Grammeme)]]
addFeature (Feature Condition
c Maybe FeatureName
n [Grammeme]
gs) [(Maybe FeatureName, Grammeme)]
acc
        | (FeatureName -> Maybe Grammeme) -> Condition -> Bool
satisfied ((Maybe FeatureName
 -> [(Maybe FeatureName, Grammeme)] -> Maybe Grammeme)
-> [(Maybe FeatureName, Grammeme)]
-> Maybe FeatureName
-> Maybe Grammeme
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe FeatureName
-> [(Maybe FeatureName, Grammeme)] -> Maybe Grammeme
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Maybe FeatureName, Grammeme)]
acc (Maybe FeatureName -> Maybe Grammeme)
-> (FeatureName -> Maybe FeatureName)
-> FeatureName
-> Maybe Grammeme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FeatureName -> Maybe FeatureName
forall a. a -> Maybe a
Just) Condition
c
        = [Grammeme]
gs [Grammeme]
-> (Grammeme -> [(Maybe FeatureName, Grammeme)])
-> [[(Maybe FeatureName, Grammeme)]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Grammeme
g -> (Maybe FeatureName
n, Grammeme
g)(Maybe FeatureName, Grammeme)
-> [(Maybe FeatureName, Grammeme)]
-> [(Maybe FeatureName, Grammeme)]
forall a. a -> [a] -> [a]
:[(Maybe FeatureName, Grammeme)]
acc
        | Bool
otherwise
        = [[(Maybe FeatureName, Grammeme)]
acc]

    go  :: ResultsTree [(Maybe FeatureName, Grammeme)]
        -> Feature
        -> ResultsTree [(Maybe FeatureName, Grammeme)]
    go :: ResultsTree [(Maybe FeatureName, Grammeme)]
-> Feature -> ResultsTree [(Maybe FeatureName, Grammeme)]
go ResultsTree [(Maybe FeatureName, Grammeme)]
rt Feature
f = ([(Maybe FeatureName, Grammeme)]
 -> [[(Maybe FeatureName, Grammeme)]])
-> ResultsTree [(Maybe FeatureName, Grammeme)]
-> ResultsTree [(Maybe FeatureName, Grammeme)]
forall a. (a -> [a]) -> ResultsTree a -> ResultsTree a
addLevel (Feature
-> [(Maybe FeatureName, Grammeme)]
-> [[(Maybe FeatureName, Grammeme)]]
addFeature Feature
f) ResultsTree [(Maybe FeatureName, Grammeme)]
rt

    satisfied
        :: (FeatureName -> Maybe Grammeme)
        -> Condition
        -> Bool
    satisfied :: (FeatureName -> Maybe Grammeme) -> Condition -> Bool
satisfied FeatureName -> Maybe Grammeme
_ Condition
Always = Bool
True
    satisfied FeatureName -> Maybe Grammeme
l (Is FeatureName
n Grammeme
g) = case FeatureName -> Maybe Grammeme
l FeatureName
n of
        Just Grammeme
g' -> Grammeme
g Grammeme -> Grammeme -> Bool
forall a. Eq a => a -> a -> Bool
== Grammeme
g'
        Maybe Grammeme
Nothing -> Bool
False
    satisfied FeatureName -> Maybe Grammeme
l (Not FeatureName
n Grammeme
g) = case FeatureName -> Maybe Grammeme
l FeatureName
n of
        Just Grammeme
g' -> Grammeme
g Grammeme -> Grammeme -> Bool
forall a. Eq a => a -> a -> Bool
/= Grammeme
g'
        Maybe Grammeme
Nothing -> Bool
True

expand :: [([AbstractGrammeme], Affix)] -> [Grammeme] -> [Process]
expand :: [([AbstractGrammeme], Affix)] -> [Grammeme] -> Affix
expand [([AbstractGrammeme], Affix)]
ms = [Affix] -> Affix
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Affix] -> Affix)
-> ([Grammeme] -> [Affix]) -> [Grammeme] -> Affix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Affix] -> [Affix] -> [Affix]
forall a. [a] -> [a] -> [a]
(++) ([Affix] -> [Affix] -> [Affix])
-> ([Grammeme] -> [Affix]) -> [Grammeme] -> [Affix] -> [Affix]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Grammeme] -> [Affix]
concretes ([Grammeme] -> [Affix] -> [Affix])
-> ([Grammeme] -> [Affix]) -> [Grammeme] -> [Affix]
forall a b.
([Grammeme] -> a -> b) -> ([Grammeme] -> a) -> [Grammeme] -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([AbstractGrammeme] -> [Affix]
replace ([AbstractGrammeme] -> [Affix])
-> ([Grammeme] -> [AbstractGrammeme]) -> [Grammeme] -> [Affix]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Grammeme] -> [AbstractGrammeme]
filterAbstract))
  where
    concretes :: [Grammeme] -> [Affix]
    concretes :: [Grammeme] -> [Affix]
concretes = (Grammeme -> Maybe Affix) -> [Grammeme] -> [Affix]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Grammeme -> Maybe Affix) -> [Grammeme] -> [Affix])
-> (Grammeme -> Maybe Affix) -> [Grammeme] -> [Affix]
forall a b. (a -> b) -> a -> b
$ \case
        Concrete Affix
affix -> Affix -> Maybe Affix
forall a. a -> Maybe a
Just Affix
affix
        Abstract AbstractGrammeme
_ -> Maybe Affix
forall a. Maybe a
Nothing

    filterAbstract :: [Grammeme] -> [AbstractGrammeme]
    filterAbstract :: [Grammeme] -> [AbstractGrammeme]
filterAbstract = (Grammeme -> Maybe AbstractGrammeme)
-> [Grammeme] -> [AbstractGrammeme]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Grammeme -> Maybe AbstractGrammeme)
 -> [Grammeme] -> [AbstractGrammeme])
-> (Grammeme -> Maybe AbstractGrammeme)
-> [Grammeme]
-> [AbstractGrammeme]
forall a b. (a -> b) -> a -> b
$ \case
        Concrete Affix
_ -> Maybe AbstractGrammeme
forall a. Maybe a
Nothing
        Abstract AbstractGrammeme
g -> AbstractGrammeme -> Maybe AbstractGrammeme
forall a. a -> Maybe a
Just AbstractGrammeme
g

    replace :: [AbstractGrammeme] -> [Affix]
    replace :: [AbstractGrammeme] -> [Affix]
replace [AbstractGrammeme]
gs = do
        ([AbstractGrammeme]
condition, Affix
replacement) <- [([AbstractGrammeme], Affix)]
ms
        if [AbstractGrammeme]
condition [AbstractGrammeme] -> [AbstractGrammeme] -> Bool
forall {t :: * -> *} {t :: * -> *} {a}.
(Foldable t, Foldable t, Eq a) =>
t a -> t a -> Bool
`subsetOf` [AbstractGrammeme]
gs
           then Affix -> [Affix]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return Affix
replacement
           else []

    t a
xs subsetOf :: t a -> t a -> Bool
`subsetOf` t a
ys = (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
ys) t a
xs

applyTo :: String -> [Process] -> String
applyTo :: String -> Affix -> String
applyTo String
w Affix
is =
    let ps :: String
ps = ((Int, String) -> String) -> [(Int, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, String) -> String
forall a b. (a, b) -> b
snd ([(Int, String)] -> String) -> [(Int, String)] -> String
forall a b. (a -> b) -> a -> b
$ ((Int, String) -> Down Int) -> [(Int, String)] -> [(Int, String)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int)
-> ((Int, String) -> Int) -> (Int, String) -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, String) -> Int
forall a b. (a, b) -> a
fst) ([(Int, String)] -> [(Int, String)])
-> [(Int, String)] -> [(Int, String)]
forall a b. (a -> b) -> a -> b
$ (Process -> Maybe (Int, String)) -> Affix -> [(Int, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Process -> Maybe (Int, String)
getPrefix Affix
is
        ss :: String
ss = ((Int, String) -> String) -> [(Int, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, String) -> String
forall a b. (a, b) -> b
snd ([(Int, String)] -> String) -> [(Int, String)] -> String
forall a b. (a -> b) -> a -> b
$ ((Int, String) -> Int) -> [(Int, String)] -> [(Int, String)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn         (Int, String) -> Int
forall a b. (a, b) -> a
fst  ([(Int, String)] -> [(Int, String)])
-> [(Int, String)] -> [(Int, String)]
forall a b. (a -> b) -> a -> b
$ (Process -> Maybe (Int, String)) -> Affix -> [(Int, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Process -> Maybe (Int, String)
getSuffix Affix
is
    in String
ps String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
w String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ss
  where
    getPrefix :: Process -> Maybe (Int, String)
getPrefix (Prefix Int
s String
i) = (Int, String) -> Maybe (Int, String)
forall a. a -> Maybe a
Just (Int
s,String
i)
    getPrefix Process
_ = Maybe (Int, String)
forall a. Maybe a
Nothing

    getSuffix :: Process -> Maybe (Int, String)
getSuffix (Suffix Int
s String
i) = (Int, String) -> Maybe (Int, String)
forall a. a -> Maybe a
Just (Int
s,String
i)
    getSuffix Process
_ = Maybe (Int, String)
forall a. Maybe a
Nothing