{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE CPP                  #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DerivingVia           #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

{-| __Warning:__ This module is __internal__, and does __not__ follow
  the Package Versioning Policy. It may be useful for extending
  Brassica, but be prepared to track development closely if you import
  this module.
-}
module Brassica.SoundChange.Apply.Internal
       (
       -- * Lexeme matching

         RuleTag(..)
       , RuleStatus(..)
       , MatchOutput(..)
       , match
       , matchMany
       , matchMany'
       , mkReplacement
       , exceptionAppliesAtPoint
       , matchRuleAtPoint
       -- * Sound change application

       , applyOnce
       , applyRule
       , checkGraphemes
       , applyStatement
       , applyRuleStr
       , applyStatementStr
       , applyChanges
       -- * Logging

       , LogItem(..)
       , PWordLog(..)
       , toPWordLog
       , reportAsHtmlRows
       , reportAsText
       , applyStatementWithLog
       , applyChangesWithLog
       , applyChangesWithLogs
       , applyChangesWithChanges
       ) where

import Control.Applicative ((<|>))
import Control.Category ((>>>))
import Control.Monad ((>=>), join)  -- needed for mtl>=2.3

import Data.Containers.ListUtils (nubOrd)
import Data.Functor ((<&>))
import Data.Maybe (maybeToList, fromMaybe, listToMaybe, mapMaybe)
import GHC.Generics (Generic)

import Control.DeepSeq (NFData)
import Control.Monad.State

import Brassica.SoundChange.Apply.Internal.MultiZipper
import Brassica.SoundChange.Types
import Data.Bifunctor (Bifunctor(first))

-- | Defines the tags used when applying a 'Rule'.

data RuleTag
    = AppStart     -- ^ The start of a rule application

    | TargetStart  -- ^ The start of the target

    | TargetEnd    -- ^ The end of the target

    deriving (RuleTag -> RuleTag -> Bool
(RuleTag -> RuleTag -> Bool)
-> (RuleTag -> RuleTag -> Bool) -> Eq RuleTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RuleTag -> RuleTag -> Bool
== :: RuleTag -> RuleTag -> Bool
$c/= :: RuleTag -> RuleTag -> Bool
/= :: RuleTag -> RuleTag -> Bool
Eq, Eq RuleTag
Eq RuleTag =>
(RuleTag -> RuleTag -> Ordering)
-> (RuleTag -> RuleTag -> Bool)
-> (RuleTag -> RuleTag -> Bool)
-> (RuleTag -> RuleTag -> Bool)
-> (RuleTag -> RuleTag -> Bool)
-> (RuleTag -> RuleTag -> RuleTag)
-> (RuleTag -> RuleTag -> RuleTag)
-> Ord RuleTag
RuleTag -> RuleTag -> Bool
RuleTag -> RuleTag -> Ordering
RuleTag -> RuleTag -> RuleTag
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
$ccompare :: RuleTag -> RuleTag -> Ordering
compare :: RuleTag -> RuleTag -> Ordering
$c< :: RuleTag -> RuleTag -> Bool
< :: RuleTag -> RuleTag -> Bool
$c<= :: RuleTag -> RuleTag -> Bool
<= :: RuleTag -> RuleTag -> Bool
$c> :: RuleTag -> RuleTag -> Bool
> :: RuleTag -> RuleTag -> Bool
$c>= :: RuleTag -> RuleTag -> Bool
>= :: RuleTag -> RuleTag -> Bool
$cmax :: RuleTag -> RuleTag -> RuleTag
max :: RuleTag -> RuleTag -> RuleTag
$cmin :: RuleTag -> RuleTag -> RuleTag
min :: RuleTag -> RuleTag -> RuleTag
Ord, Int -> RuleTag -> ShowS
[RuleTag] -> ShowS
RuleTag -> String
(Int -> RuleTag -> ShowS)
-> (RuleTag -> String) -> ([RuleTag] -> ShowS) -> Show RuleTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuleTag -> ShowS
showsPrec :: Int -> RuleTag -> ShowS
$cshow :: RuleTag -> String
show :: RuleTag -> String
$cshowList :: [RuleTag] -> ShowS
showList :: [RuleTag] -> ShowS
Show)

-- | A monad in which to process a 'MultiZipper' over

-- 'Char's. Essentially a @StateT (MultiZipper RuleTag Grapheme) []@:

-- it stores the 'MultiZipper' as state, and allows failure,

-- backtracking and multiple answers (backtracking over the state

-- too).

newtype RuleAp a = RuleAp { forall a.
RuleAp a
-> MultiZipper RuleTag Grapheme
-> [(a, MultiZipper RuleTag Grapheme)]
runRuleAp :: MultiZipper RuleTag Grapheme -> [(a, MultiZipper RuleTag Grapheme)] }
    deriving ((forall a b. (a -> b) -> RuleAp a -> RuleAp b)
-> (forall a b. a -> RuleAp b -> RuleAp a) -> Functor RuleAp
forall a b. a -> RuleAp b -> RuleAp a
forall a b. (a -> b) -> RuleAp a -> RuleAp 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) -> RuleAp a -> RuleAp b
fmap :: forall a b. (a -> b) -> RuleAp a -> RuleAp b
$c<$ :: forall a b. a -> RuleAp b -> RuleAp a
<$ :: forall a b. a -> RuleAp b -> RuleAp a
Functor, Functor RuleAp
Functor RuleAp =>
(forall a. a -> RuleAp a)
-> (forall a b. RuleAp (a -> b) -> RuleAp a -> RuleAp b)
-> (forall a b c.
    (a -> b -> c) -> RuleAp a -> RuleAp b -> RuleAp c)
-> (forall a b. RuleAp a -> RuleAp b -> RuleAp b)
-> (forall a b. RuleAp a -> RuleAp b -> RuleAp a)
-> Applicative RuleAp
forall a. a -> RuleAp a
forall a b. RuleAp a -> RuleAp b -> RuleAp a
forall a b. RuleAp a -> RuleAp b -> RuleAp b
forall a b. RuleAp (a -> b) -> RuleAp a -> RuleAp b
forall a b c. (a -> b -> c) -> RuleAp a -> RuleAp b -> RuleAp c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> RuleAp a
pure :: forall a. a -> RuleAp a
$c<*> :: forall a b. RuleAp (a -> b) -> RuleAp a -> RuleAp b
<*> :: forall a b. RuleAp (a -> b) -> RuleAp a -> RuleAp b
$cliftA2 :: forall a b c. (a -> b -> c) -> RuleAp a -> RuleAp b -> RuleAp c
liftA2 :: forall a b c. (a -> b -> c) -> RuleAp a -> RuleAp b -> RuleAp c
$c*> :: forall a b. RuleAp a -> RuleAp b -> RuleAp b
*> :: forall a b. RuleAp a -> RuleAp b -> RuleAp b
$c<* :: forall a b. RuleAp a -> RuleAp b -> RuleAp a
<* :: forall a b. RuleAp a -> RuleAp b -> RuleAp a
Applicative, Applicative RuleAp
Applicative RuleAp =>
(forall a b. RuleAp a -> (a -> RuleAp b) -> RuleAp b)
-> (forall a b. RuleAp a -> RuleAp b -> RuleAp b)
-> (forall a. a -> RuleAp a)
-> Monad RuleAp
forall a. a -> RuleAp a
forall a b. RuleAp a -> RuleAp b -> RuleAp b
forall a b. RuleAp a -> (a -> RuleAp b) -> RuleAp b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. RuleAp a -> (a -> RuleAp b) -> RuleAp b
>>= :: forall a b. RuleAp a -> (a -> RuleAp b) -> RuleAp b
$c>> :: forall a b. RuleAp a -> RuleAp b -> RuleAp b
>> :: forall a b. RuleAp a -> RuleAp b -> RuleAp b
$creturn :: forall a. a -> RuleAp a
return :: forall a. a -> RuleAp a
Monad, MonadState (MultiZipper RuleTag Grapheme)

    , Monad RuleAp
Monad RuleAp => (forall a. String -> RuleAp a) -> MonadFail RuleAp
forall a. String -> RuleAp a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall a. String -> RuleAp a
fail :: forall a. String -> RuleAp a
MonadFail

    )
      via (StateT (MultiZipper RuleTag Grapheme) [])

-- | Lift a partial modification function into a 'State'. Update state

-- if it succeeds, otherwise rollback.

modifyMay :: Monad m => (s -> Maybe s) -> StateT s m ()
modifyMay :: forall (m :: * -> *) s. Monad m => (s -> Maybe s) -> StateT s m ()
modifyMay s -> Maybe s
f = (s -> s) -> StateT s m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((s -> s) -> StateT s m ()) -> (s -> s) -> StateT s m ()
forall a b. (a -> b) -> a -> b
$ \s
s -> s -> Maybe s -> s
forall a. a -> Maybe a -> a
fromMaybe s
s (s -> Maybe s
f s
s)

-- | Monadic version of 'modify'.

modifyM :: Monad m => (s -> m s) -> StateT s m ()
modifyM :: forall (m :: * -> *) s. Monad m => (s -> m s) -> StateT s m ()
modifyM s -> m s
f = (s -> m ((), s)) -> StateT s m ()
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> ((), s)) -> m s -> m ((), s)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((),) (m s -> m ((), s)) -> (s -> m s) -> s -> m ((), s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m s
f)

-- | Given a nondeterministic stateful function, lift it into a

-- 'StateT' computation which returns 'Nothing' when the original

-- action would have failed with no results.

try :: (s -> [(a, s)]) -> StateT s [] (Maybe a)
try :: forall s a. (s -> [(a, s)]) -> StateT s [] (Maybe a)
try s -> [(a, s)]
p = (s -> [(Maybe a, s)]) -> StateT s [] (Maybe a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> [(Maybe a, s)]) -> StateT s [] (Maybe a))
-> (s -> [(Maybe a, s)]) -> StateT s [] (Maybe a)
forall a b. (a -> b) -> a -> b
$ \s
s ->
    case s -> [(a, s)]
p s
s of
        [] -> [(Maybe a
forall a. Maybe a
Nothing, s
s)]
        [(a, s)]
r -> (a -> Maybe a) -> (a, s) -> (Maybe a, s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> Maybe a
forall a. a -> Maybe a
Just ((a, s) -> (Maybe a, s)) -> [(a, s)] -> [(Maybe a, s)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, s)]
r

-- | Describes the output of a 'match' operation.

data MatchOutput = MatchOutput
    { -- | For each category matched, the index of the matched

      -- grapheme in that category.

      MatchOutput -> [Int]
matchedCatIxs    :: [Int]
      -- | For each optional group whether it matched or not

    , MatchOutput -> [Bool]
matchedOptionals :: [Bool]
      -- | For each wildcard, the graphemes which it matched

    , MatchOutput -> [PWord]
matchedWildcards :: [[Grapheme]]
      -- | For each Kleene star, how many repititions it matched

    , MatchOutput -> [Int]
matchedKleenes   :: [Int]
      -- | The graphemes which were matched

    , MatchOutput -> PWord
matchedGraphemes :: [Grapheme]
    } deriving (Int -> MatchOutput -> ShowS
[MatchOutput] -> ShowS
MatchOutput -> String
(Int -> MatchOutput -> ShowS)
-> (MatchOutput -> String)
-> ([MatchOutput] -> ShowS)
-> Show MatchOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchOutput -> ShowS
showsPrec :: Int -> MatchOutput -> ShowS
$cshow :: MatchOutput -> String
show :: MatchOutput -> String
$cshowList :: [MatchOutput] -> ShowS
showList :: [MatchOutput] -> ShowS
Show)

modifyMatchedGraphemes :: ([Grapheme] -> [Grapheme]) -> MatchOutput -> MatchOutput
modifyMatchedGraphemes :: (PWord -> PWord) -> MatchOutput -> MatchOutput
modifyMatchedGraphemes PWord -> PWord
f MatchOutput{[Bool]
[Int]
[PWord]
PWord
matchedCatIxs :: MatchOutput -> [Int]
matchedOptionals :: MatchOutput -> [Bool]
matchedWildcards :: MatchOutput -> [PWord]
matchedKleenes :: MatchOutput -> [Int]
matchedGraphemes :: MatchOutput -> PWord
matchedCatIxs :: [Int]
matchedOptionals :: [Bool]
matchedWildcards :: [PWord]
matchedKleenes :: [Int]
matchedGraphemes :: PWord
..} = MatchOutput{matchedGraphemes :: PWord
matchedGraphemes=PWord -> PWord
f PWord
matchedGraphemes, [Bool]
[Int]
[PWord]
matchedCatIxs :: [Int]
matchedOptionals :: [Bool]
matchedWildcards :: [PWord]
matchedKleenes :: [Int]
matchedCatIxs :: [Int]
matchedOptionals :: [Bool]
matchedWildcards :: [PWord]
matchedKleenes :: [Int]
..}

appendGrapheme :: MatchOutput -> Grapheme -> MatchOutput
appendGrapheme :: MatchOutput -> Grapheme -> MatchOutput
appendGrapheme MatchOutput
out Grapheme
g = (PWord -> PWord) -> MatchOutput -> MatchOutput
modifyMatchedGraphemes (PWord -> PWord -> PWord
forall a. [a] -> [a] -> [a]
++[Grapheme
g]) MatchOutput
out

instance Semigroup MatchOutput where
    (MatchOutput [Int]
a1 [Bool]
b1 [PWord]
c1 [Int]
d1 PWord
e1) <> :: MatchOutput -> MatchOutput -> MatchOutput
<> (MatchOutput [Int]
a2 [Bool]
b2 [PWord]
c2 [Int]
d2 PWord
e2) =
        [Int] -> [Bool] -> [PWord] -> [Int] -> PWord -> MatchOutput
MatchOutput ([Int]
a1[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int]
a2) ([Bool]
b1[Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++[Bool]
b2) ([PWord]
c1[PWord] -> [PWord] -> [PWord]
forall a. [a] -> [a] -> [a]
++[PWord]
c2) ([Int]
d1[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int]
d2) (PWord
e1PWord -> PWord -> PWord
forall a. [a] -> [a] -> [a]
++PWord
e2)

zipWith' :: [a] -> [b] -> (a -> b -> c) -> [c]
zipWith' :: forall a b c. [a] -> [b] -> (a -> b -> c) -> [c]
zipWith' [a]
xs [b]
ys a -> b -> c
f = (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> c
f [a]
xs [b]
ys

-- Note: see c37afd7028afd4f610d8701799fb6857e2f9b3d9

-- for motivation for the below functions


insertAt :: Int -> a -> [a] -> [a]
insertAt :: forall a. Int -> a -> [a] -> [a]
insertAt Int
n a
a [a]
as = let ([a]
xs,[a]
ys) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
as in [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)

insertAtCat :: Int -> Int -> MatchOutput -> MatchOutput
insertAtCat :: Int -> Int -> MatchOutput -> MatchOutput
insertAtCat Int
n Int
i MatchOutput
mz = MatchOutput
mz { matchedCatIxs = insertAt n i $ matchedCatIxs mz }

insertAtKleene :: Int -> Int -> MatchOutput -> MatchOutput
insertAtKleene :: Int -> Int -> MatchOutput -> MatchOutput
insertAtKleene Int
n Int
i MatchOutput
mz = MatchOutput
mz { matchedKleenes = insertAt n i $ matchedKleenes mz }

-- | Match a single 'Lexeme' against a 'MultiZipper', and advance the

-- 'MultiZipper' past the match. For each match found, returns the

-- 'MatchOutput' tupled with the updated 'MultiZipper'.

match :: MatchOutput          -- ^ The previous 'MatchOutput'

      -> Maybe Grapheme       -- ^ The previously-matched grapheme, if any. (Used to match a 'Geminate'.)

      -> Lexeme Expanded 'Matched  -- ^ The lexeme to match.

      -> MultiZipper t Grapheme   -- ^ The 'MultiZipper' to match against.

      -> [(MatchOutput, MultiZipper t Grapheme)]
      -- ^ The output: a tuple @(g, mz)@ as described below.

match :: forall t.
MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
match MatchOutput
out Maybe Grapheme
prev (Optional [Lexeme Expanded 'Matched]
l) MultiZipper t Grapheme
mz =
    (MatchOutput
out MatchOutput -> MatchOutput -> MatchOutput
forall a. Semigroup a => a -> a -> a
<> [Int] -> [Bool] -> [PWord] -> [Int] -> PWord -> MatchOutput
MatchOutput [] [Bool
False] [] [] [], MultiZipper t Grapheme
mz) (MatchOutput, MultiZipper t Grapheme)
-> [(MatchOutput, MultiZipper t Grapheme)]
-> [(MatchOutput, MultiZipper t Grapheme)]
forall a. a -> [a] -> [a]
:
    MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany (MatchOutput
out MatchOutput -> MatchOutput -> MatchOutput
forall a. Semigroup a => a -> a -> a
<> [Int] -> [Bool] -> [PWord] -> [Int] -> PWord -> MatchOutput
MatchOutput [] [Bool
True] [] [] []) Maybe Grapheme
prev [Lexeme Expanded 'Matched]
l MultiZipper t Grapheme
mz
match MatchOutput
out Maybe Grapheme
prev (Wildcard Lexeme Expanded 'Matched
l) MultiZipper t Grapheme
mz = MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchWildcard MatchOutput
out Maybe Grapheme
prev Lexeme Expanded 'Matched
l MultiZipper t Grapheme
mz
match MatchOutput
out Maybe Grapheme
prev (Kleene Lexeme Expanded 'Matched
l) MultiZipper t Grapheme
mz = MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchKleene MatchOutput
out Maybe Grapheme
prev Lexeme Expanded 'Matched
l MultiZipper t Grapheme
mz
match MatchOutput
out Maybe Grapheme
_ (Grapheme Grapheme
g) MultiZipper t Grapheme
mz = (MatchOutput
out MatchOutput -> MatchOutput -> MatchOutput
forall a. Semigroup a => a -> a -> a
<> [Int] -> [Bool] -> [PWord] -> [Int] -> PWord -> MatchOutput
MatchOutput [] [] [] [] [Grapheme
g],) (MultiZipper t Grapheme -> (MatchOutput, MultiZipper t Grapheme))
-> [MultiZipper t Grapheme]
-> [(MatchOutput, MultiZipper t Grapheme)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (MultiZipper t Grapheme) -> [MultiZipper t Grapheme]
forall a. Maybe a -> [a]
maybeToList (Grapheme
-> MultiZipper t Grapheme -> Maybe (MultiZipper t Grapheme)
forall t.
Grapheme
-> MultiZipper t Grapheme -> Maybe (MultiZipper t Grapheme)
matchGrapheme Grapheme
g MultiZipper t Grapheme
mz)
match MatchOutput
out Maybe Grapheme
prev (Category (FromElements [Either Grapheme [Lexeme Expanded 'Matched]]
gs)) MultiZipper t Grapheme
mz =
    [[(MatchOutput, MultiZipper t Grapheme)]]
-> [(MatchOutput, MultiZipper t Grapheme)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(MatchOutput, MultiZipper t Grapheme)]]
 -> [(MatchOutput, MultiZipper t Grapheme)])
-> [[(MatchOutput, MultiZipper t Grapheme)]]
-> [(MatchOutput, MultiZipper t Grapheme)]
forall a b. (a -> b) -> a -> b
$ [Either Grapheme [Lexeme Expanded 'Matched]]
-> [Int]
-> (Either Grapheme [Lexeme Expanded 'Matched]
    -> Int -> [(MatchOutput, MultiZipper t Grapheme)])
-> [[(MatchOutput, MultiZipper t Grapheme)]]
forall a b c. [a] -> [b] -> (a -> b -> c) -> [c]
zipWith' [Either Grapheme [Lexeme Expanded 'Matched]]
gs [Int
0..] ((Either Grapheme [Lexeme Expanded 'Matched]
  -> Int -> [(MatchOutput, MultiZipper t Grapheme)])
 -> [[(MatchOutput, MultiZipper t Grapheme)]])
-> (Either Grapheme [Lexeme Expanded 'Matched]
    -> Int -> [(MatchOutput, MultiZipper t Grapheme)])
-> [[(MatchOutput, MultiZipper t Grapheme)]]
forall a b. (a -> b) -> a -> b
$ \Either Grapheme [Lexeme Expanded 'Matched]
e Int
i ->
        -- make sure to insert new index BEFORE any new ones which

        -- might be added by the recursive call

        (MatchOutput -> MatchOutput)
-> (MatchOutput, MultiZipper t Grapheme)
-> (MatchOutput, MultiZipper t Grapheme)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Int -> Int -> MatchOutput -> MatchOutput
insertAtCat ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ MatchOutput -> [Int]
matchedCatIxs MatchOutput
out) Int
i) ((MatchOutput, MultiZipper t Grapheme)
 -> (MatchOutput, MultiZipper t Grapheme))
-> [(MatchOutput, MultiZipper t Grapheme)]
-> [(MatchOutput, MultiZipper t Grapheme)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            case Either Grapheme [Lexeme Expanded 'Matched]
e of
                Left  Grapheme
g  -> MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
match MatchOutput
out Maybe Grapheme
prev (Grapheme -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> Lexeme category a
Grapheme Grapheme
g :: Lexeme Expanded a) MultiZipper t Grapheme
mz
                Right [Lexeme Expanded 'Matched]
ls -> MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany MatchOutput
out Maybe Grapheme
prev [Lexeme Expanded 'Matched]
ls MultiZipper t Grapheme
mz
match MatchOutput
out Maybe Grapheme
prev Lexeme Expanded 'Matched
Geminate MultiZipper t Grapheme
mz = case Maybe Grapheme
prev of
    Maybe Grapheme
Nothing -> []
    Just Grapheme
prev' -> (MatchOutput
out MatchOutput -> MatchOutput -> MatchOutput
forall a. Semigroup a => a -> a -> a
<> [Int] -> [Bool] -> [PWord] -> [Int] -> PWord -> MatchOutput
MatchOutput [] [] [] [] [Grapheme
prev'],) (MultiZipper t Grapheme -> (MatchOutput, MultiZipper t Grapheme))
-> [MultiZipper t Grapheme]
-> [(MatchOutput, MultiZipper t Grapheme)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (MultiZipper t Grapheme) -> [MultiZipper t Grapheme]
forall a. Maybe a -> [a]
maybeToList (Grapheme
-> MultiZipper t Grapheme -> Maybe (MultiZipper t Grapheme)
forall t.
Grapheme
-> MultiZipper t Grapheme -> Maybe (MultiZipper t Grapheme)
matchGrapheme Grapheme
prev' MultiZipper t Grapheme
mz)
match MatchOutput
out Maybe Grapheme
prev (Backreference Int
i (FromElements [Either Grapheme [Lexeme Expanded 'Matched]]
gs)) MultiZipper t Grapheme
mz = do
    Either Grapheme [Lexeme Expanded 'Matched]
e <- Maybe (Either Grapheme [Lexeme Expanded 'Matched])
-> [Either Grapheme [Lexeme Expanded 'Matched]]
forall a. Maybe a -> [a]
maybeToList (Maybe (Either Grapheme [Lexeme Expanded 'Matched])
 -> [Either Grapheme [Lexeme Expanded 'Matched]])
-> Maybe (Either Grapheme [Lexeme Expanded 'Matched])
-> [Either Grapheme [Lexeme Expanded 'Matched]]
forall a b. (a -> b) -> a -> b
$
        ([Either Grapheme [Lexeme Expanded 'Matched]]
gs [Either Grapheme [Lexeme Expanded 'Matched]]
-> Int -> Maybe (Either Grapheme [Lexeme Expanded 'Matched])
forall a. [a] -> Int -> Maybe a
!?) (Int -> Maybe (Either Grapheme [Lexeme Expanded 'Matched]))
-> Maybe Int -> Maybe (Either Grapheme [Lexeme Expanded 'Matched])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MatchOutput -> [Int]
matchedCatIxs MatchOutput
out [Int] -> Int -> Maybe Int
forall a. [a] -> Int -> Maybe a
!? (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    case Either Grapheme [Lexeme Expanded 'Matched]
e of
        Left  Grapheme
g  -> MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
match MatchOutput
out Maybe Grapheme
prev (Grapheme -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> Lexeme category a
Grapheme Grapheme
g :: Lexeme Expanded a) MultiZipper t Grapheme
mz
        Right [Lexeme Expanded 'Matched]
ls -> MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany MatchOutput
out Maybe Grapheme
prev [Lexeme Expanded 'Matched]
ls MultiZipper t Grapheme
mz

matchKleene
    :: MatchOutput
    -> Maybe Grapheme
    -> Lexeme Expanded 'Matched
    -> MultiZipper t Grapheme
    -> [(MatchOutput, MultiZipper t Grapheme)]
matchKleene :: forall t.
MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchKleene MatchOutput
origOut = Int
-> MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
go Int
0 MatchOutput
origOut
  where
    go :: Int
-> MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
go !Int
n MatchOutput
out Maybe Grapheme
prev Lexeme Expanded 'Matched
l MultiZipper t Grapheme
mz = case MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
match MatchOutput
out Maybe Grapheme
prev Lexeme Expanded 'Matched
l MultiZipper t Grapheme
mz of
        [] -> [
            ( Int -> Int -> MatchOutput -> MatchOutput
insertAtKleene ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ MatchOutput -> [Int]
matchedKleenes MatchOutput
origOut) Int
n MatchOutput
out
            , MultiZipper t Grapheme
mz
            ) ]
        [(MatchOutput, MultiZipper t Grapheme)]
r -> [(MatchOutput, MultiZipper t Grapheme)]
r [(MatchOutput, MultiZipper t Grapheme)]
-> ((MatchOutput, MultiZipper t Grapheme)
    -> [(MatchOutput, MultiZipper t Grapheme)])
-> [(MatchOutput, MultiZipper t Grapheme)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(MatchOutput
out', MultiZipper t Grapheme
mz') -> Int
-> MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MatchOutput
out' Maybe Grapheme
prev Lexeme Expanded 'Matched
l MultiZipper t Grapheme
mz'

matchWildcard
    :: MatchOutput
    -> Maybe Grapheme
    -> Lexeme Expanded 'Matched
    -> MultiZipper t Grapheme
    -> [(MatchOutput, MultiZipper t Grapheme)]
matchWildcard :: forall t.
MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchWildcard = PWord
-> MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall {t}.
PWord
-> MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
go []
  where
    go :: PWord
-> MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
go PWord
matched MatchOutput
out Maybe Grapheme
prev Lexeme Expanded 'Matched
l MultiZipper t Grapheme
mz = case MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
match MatchOutput
out Maybe Grapheme
prev Lexeme Expanded 'Matched
l MultiZipper t Grapheme
mz of
        [] -> Maybe (Grapheme, MultiZipper t Grapheme)
-> [(Grapheme, MultiZipper t Grapheme)]
forall a. Maybe a -> [a]
maybeToList (MultiZipper t Grapheme -> Maybe (Grapheme, MultiZipper t Grapheme)
forall t a. MultiZipper t a -> Maybe (a, MultiZipper t a)
consume MultiZipper t Grapheme
mz) [(Grapheme, MultiZipper t Grapheme)]
-> ((Grapheme, MultiZipper t Grapheme)
    -> [(MatchOutput, MultiZipper t Grapheme)])
-> [(MatchOutput, MultiZipper t Grapheme)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            (Grapheme
GBoundary, MultiZipper t Grapheme
_) -> []   -- don't continue past word boundary

            (Grapheme
g, MultiZipper t Grapheme
mz') -> PWord
-> MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
go (Grapheme
gGrapheme -> PWord -> PWord
forall a. a -> [a] -> [a]
:PWord
matched) (MatchOutput -> Grapheme -> MatchOutput
appendGrapheme MatchOutput
out Grapheme
g) Maybe Grapheme
prev Lexeme Expanded 'Matched
l MultiZipper t Grapheme
mz'
        [(MatchOutput, MultiZipper t Grapheme)]
r -> [(MatchOutput, MultiZipper t Grapheme)]
r [(MatchOutput, MultiZipper t Grapheme)]
-> ((MatchOutput, MultiZipper t Grapheme)
    -> (MatchOutput, MultiZipper t Grapheme))
-> [(MatchOutput, MultiZipper t Grapheme)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(MatchOutput
out', MultiZipper t Grapheme
mz') ->
            ( MatchOutput
out'
              { matchedWildcards = matchedWildcards out' ++ [reverse matched]
              }
            , MultiZipper t Grapheme
mz'
            )

matchGrapheme :: Grapheme -> MultiZipper t Grapheme -> Maybe (MultiZipper t Grapheme)
matchGrapheme :: forall t.
Grapheme
-> MultiZipper t Grapheme -> Maybe (MultiZipper t Grapheme)
matchGrapheme Grapheme
g = (Grapheme -> Bool)
-> MultiZipper t Grapheme -> Maybe (MultiZipper t Grapheme)
forall t.
(Grapheme -> Bool)
-> MultiZipper t Grapheme -> Maybe (MultiZipper t Grapheme)
matchGraphemeP (Grapheme -> Grapheme -> Bool
forall a. Eq a => a -> a -> Bool
==Grapheme
g)

matchGraphemeP :: (Grapheme -> Bool) -> MultiZipper t Grapheme -> Maybe (MultiZipper t Grapheme)
matchGraphemeP :: forall t.
(Grapheme -> Bool)
-> MultiZipper t Grapheme -> Maybe (MultiZipper t Grapheme)
matchGraphemeP Grapheme -> Bool
p MultiZipper t Grapheme
mz = MultiZipper t Grapheme -> Maybe Grapheme
forall t a. MultiZipper t a -> Maybe a
value MultiZipper t Grapheme
mz Maybe Grapheme
-> (Grapheme -> Maybe (MultiZipper t Grapheme))
-> Maybe (MultiZipper t Grapheme)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Grapheme
cs -> if Grapheme -> Bool
p Grapheme
cs then MultiZipper t Grapheme -> Maybe (MultiZipper t Grapheme)
forall t a. MultiZipper t a -> Maybe (MultiZipper t a)
fwd MultiZipper t Grapheme
mz else Maybe (MultiZipper t Grapheme)
forall a. Maybe a
Nothing

-- | Match a list of several 'Lexeme's against a

-- 'MultiZipper'. Arguments and output are the same as with 'match',

-- though the outputs are given as a list of indices and graphemes

-- rather than as a single index and grapheme.

matchMany :: MatchOutput
          -> Maybe Grapheme
          -> [Lexeme Expanded 'Matched]
          -> MultiZipper t Grapheme
          -> [(MatchOutput, MultiZipper t Grapheme)]
matchMany :: forall t.
MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany MatchOutput
out Maybe Grapheme
_ [] MultiZipper t Grapheme
mz = [(MatchOutput
out, MultiZipper t Grapheme
mz)]
matchMany MatchOutput
out Maybe Grapheme
prev (Lexeme Expanded 'Matched
l:[Lexeme Expanded 'Matched]
ls) MultiZipper t Grapheme
mz =
    MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> Lexeme Expanded 'Matched
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
match MatchOutput
out Maybe Grapheme
prev Lexeme Expanded 'Matched
l MultiZipper t Grapheme
mz [(MatchOutput, MultiZipper t Grapheme)]
-> ((MatchOutput, MultiZipper t Grapheme)
    -> [(MatchOutput, MultiZipper t Grapheme)])
-> [(MatchOutput, MultiZipper t Grapheme)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(MatchOutput
out', MultiZipper t Grapheme
mz') ->
    MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany  MatchOutput
out' (PWord -> Maybe Grapheme
forall a. [a] -> Maybe a
lastMay (MatchOutput -> PWord
matchedGraphemes MatchOutput
out') Maybe Grapheme -> Maybe Grapheme -> Maybe Grapheme
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Grapheme
prev) [Lexeme Expanded 'Matched]
ls MultiZipper t Grapheme
mz'

-- | 'matchMany' without any previous match output.

matchMany' :: Maybe Grapheme
          -> [Lexeme Expanded 'Matched]
          -> MultiZipper t Grapheme
          -> [(MatchOutput, MultiZipper t Grapheme)]
matchMany' :: forall t.
Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany' = MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany ([Int] -> [Bool] -> [PWord] -> [Int] -> PWord -> MatchOutput
MatchOutput [] [] [] [] [])

-- Small utility function, not exported

lastMay :: [a] -> Maybe a
lastMay :: forall a. [a] -> Maybe a
lastMay [a]
l = if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
l then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> a
forall a. HasCallStack => [a] -> a
last [a]
l)

data ReplacementIndices = ReplacementIndices
    { ReplacementIndices -> Int
ixInCategories :: Int
    , ReplacementIndices -> Int
ixInOptionals :: Int
    , ReplacementIndices -> Int
ixInWildcards :: Int
    , ReplacementIndices -> Int
ixInKleenes :: Int
    , ReplacementIndices -> Maybe CategoryNumber
forcedCategory :: Maybe CategoryNumber
    } deriving (Int -> ReplacementIndices -> ShowS
[ReplacementIndices] -> ShowS
ReplacementIndices -> String
(Int -> ReplacementIndices -> ShowS)
-> (ReplacementIndices -> String)
-> ([ReplacementIndices] -> ShowS)
-> Show ReplacementIndices
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReplacementIndices -> ShowS
showsPrec :: Int -> ReplacementIndices -> ShowS
$cshow :: ReplacementIndices -> String
show :: ReplacementIndices -> String
$cshowList :: [ReplacementIndices] -> ShowS
showList :: [ReplacementIndices] -> ShowS
Show)

data CategoryNumber = CategoryNumber Int | Nondeterministic
    deriving (Int -> CategoryNumber -> ShowS
[CategoryNumber] -> ShowS
CategoryNumber -> String
(Int -> CategoryNumber -> ShowS)
-> (CategoryNumber -> String)
-> ([CategoryNumber] -> ShowS)
-> Show CategoryNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CategoryNumber -> ShowS
showsPrec :: Int -> CategoryNumber -> ShowS
$cshow :: CategoryNumber -> String
show :: CategoryNumber -> String
$cshowList :: [CategoryNumber] -> ShowS
showList :: [CategoryNumber] -> ShowS
Show)

advanceCategory :: ReplacementIndices -> Int -> (CategoryNumber, ReplacementIndices)
advanceCategory :: ReplacementIndices -> Int -> (CategoryNumber, ReplacementIndices)
advanceCategory ReplacementIndices
ix Int
cslen =
    case ReplacementIndices -> Maybe CategoryNumber
forcedCategory ReplacementIndices
ix of
        Just CategoryNumber
i -> (CategoryNumber
i, ReplacementIndices
ix { forcedCategory = Nothing })
        Maybe CategoryNumber
Nothing ->
            let i :: Int
i = ReplacementIndices -> Int
ixInCategories ReplacementIndices
ix in
                ( if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cslen then Int -> CategoryNumber
CategoryNumber Int
i else CategoryNumber
Nondeterministic
                , ReplacementIndices
ix { ixInCategories = i+1 }
                )

advanceOptional :: ReplacementIndices -> (Int, ReplacementIndices)
advanceOptional :: ReplacementIndices -> (Int, ReplacementIndices)
advanceOptional ReplacementIndices
ix =
    let i :: Int
i = ReplacementIndices -> Int
ixInOptionals ReplacementIndices
ix
    in (Int
i, ReplacementIndices
ix { ixInOptionals = i+1 })

advanceWildcard :: ReplacementIndices -> (Int, ReplacementIndices)
advanceWildcard :: ReplacementIndices -> (Int, ReplacementIndices)
advanceWildcard ReplacementIndices
ix =
    let i :: Int
i = ReplacementIndices -> Int
ixInWildcards ReplacementIndices
ix
    in (Int
i, ReplacementIndices
ix { ixInWildcards = i+1 })

advanceKleene :: ReplacementIndices -> (Int, ReplacementIndices)
advanceKleene :: ReplacementIndices -> (Int, ReplacementIndices)
advanceKleene ReplacementIndices
ix =
    let i :: Int
i = ReplacementIndices -> Int
ixInKleenes ReplacementIndices
ix
    in (Int
i, ReplacementIndices
ix { ixInKleenes = i+1 })

forceCategory :: CategoryNumber -> ReplacementIndices -> ReplacementIndices
forceCategory :: CategoryNumber -> ReplacementIndices -> ReplacementIndices
forceCategory CategoryNumber
i ReplacementIndices
ixs = ReplacementIndices
ixs { forcedCategory = Just i }

-- | Partially safe list indexing

(!?) :: [a] -> Int -> Maybe a
(a
x:[a]
_ ) !? :: forall a. [a] -> Int -> Maybe a
!? Int
0 = a -> Maybe a
forall a. a -> Maybe a
Just a
x
(a
_:[a]
xs) !? Int
n = [a]
xs [a] -> Int -> Maybe a
forall a. [a] -> Int -> Maybe a
!? (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
[]     !? Int
_ = Maybe a
forall a. Maybe a
Nothing

-- | Given a list of 'Lexeme's specifying a replacement, generate all

-- possible replacements and apply them to the given input.

mkReplacement
    :: MatchOutput              -- ^ The result of matching against the target

    -> [Lexeme Expanded 'Replacement]    -- ^ The 'Lexeme's specifying the replacement.

    -> MultiZipper t Grapheme
    -> [MultiZipper t Grapheme]
mkReplacement :: forall t.
MatchOutput
-> [Lexeme Expanded 'Replacement]
-> MultiZipper t Grapheme
-> [MultiZipper t Grapheme]
mkReplacement MatchOutput
out = \[Lexeme Expanded 'Replacement]
ls -> ((ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))
 -> MultiZipper t Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
-> [MultiZipper t Grapheme]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((MultiZipper t Grapheme, Maybe Grapheme) -> MultiZipper t Grapheme
forall a b. (a, b) -> a
fst ((MultiZipper t Grapheme, Maybe Grapheme)
 -> MultiZipper t Grapheme)
-> ((ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))
    -> (MultiZipper t Grapheme, Maybe Grapheme))
-> (ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))
-> MultiZipper t Grapheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))
-> (MultiZipper t Grapheme, Maybe Grapheme)
forall a b. (a, b) -> b
snd) ([(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
 -> [MultiZipper t Grapheme])
-> (MultiZipper t Grapheme
    -> [(ReplacementIndices,
         (MultiZipper t Grapheme, Maybe Grapheme))])
-> MultiZipper t Grapheme
-> [MultiZipper t Grapheme]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall t.
ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
go ReplacementIndices
startIxs [Lexeme Expanded 'Replacement]
ls ((MultiZipper t Grapheme, Maybe Grapheme)
 -> [(ReplacementIndices,
      (MultiZipper t Grapheme, Maybe Grapheme))])
-> (MultiZipper t Grapheme
    -> (MultiZipper t Grapheme, Maybe Grapheme))
-> MultiZipper t Grapheme
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Maybe Grapheme
forall a. Maybe a
Nothing)
  where
    startIxs :: ReplacementIndices
startIxs = Int
-> Int -> Int -> Int -> Maybe CategoryNumber -> ReplacementIndices
ReplacementIndices Int
0 Int
0 Int
0 Int
0 Maybe CategoryNumber
forall a. Maybe a
Nothing

    go
        :: ReplacementIndices
        -> [Lexeme Expanded 'Replacement]
        -> (MultiZipper t Grapheme, Maybe Grapheme)
        -> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
    go :: forall t.
ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
go ReplacementIndices
ixs []     (MultiZipper t Grapheme
mz, Maybe Grapheme
prev) = [(ReplacementIndices
ixs, (MultiZipper t Grapheme
mz, Maybe Grapheme
prev))]
    go ReplacementIndices
ixs (Lexeme Expanded 'Replacement
l:[Lexeme Expanded 'Replacement]
ls) (MultiZipper t Grapheme
mz, Maybe Grapheme
prev) = do
        (ReplacementIndices
ixs', (MultiZipper t Grapheme
mz', Maybe Grapheme
prev')) <- ReplacementIndices
-> Lexeme Expanded 'Replacement
-> MultiZipper t Grapheme
-> Maybe Grapheme
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall t.
ReplacementIndices
-> Lexeme Expanded 'Replacement
-> MultiZipper t Grapheme
-> Maybe Grapheme
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
replaceLex ReplacementIndices
ixs Lexeme Expanded 'Replacement
l MultiZipper t Grapheme
mz Maybe Grapheme
prev
        ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall t.
ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
go ReplacementIndices
ixs' [Lexeme Expanded 'Replacement]
ls (MultiZipper t Grapheme
mz', Maybe Grapheme
prev')

    numCatsMatched :: Int
numCatsMatched = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ MatchOutput -> [Int]
matchedCatIxs MatchOutput
out

    replaceLex
        :: ReplacementIndices
        -> Lexeme Expanded 'Replacement
        -> MultiZipper t Grapheme
        -> Maybe Grapheme
        -> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
    replaceLex :: forall t.
ReplacementIndices
-> Lexeme Expanded 'Replacement
-> MultiZipper t Grapheme
-> Maybe Grapheme
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
replaceLex ReplacementIndices
ixs (Grapheme Grapheme
g) MultiZipper t Grapheme
mz Maybe Grapheme
_prev = [(ReplacementIndices
ixs, (Grapheme -> MultiZipper t Grapheme -> MultiZipper t Grapheme
forall a t. a -> MultiZipper t a -> MultiZipper t a
insert Grapheme
g MultiZipper t Grapheme
mz, Grapheme -> Maybe Grapheme
forall a. a -> Maybe a
Just Grapheme
g))]
    replaceLex ReplacementIndices
ixs (Category (FromElements [Either Grapheme [Lexeme Expanded 'Replacement]]
gs)) MultiZipper t Grapheme
mz Maybe Grapheme
prev =
        case ReplacementIndices -> Int -> (CategoryNumber, ReplacementIndices)
advanceCategory ReplacementIndices
ixs Int
numCatsMatched of
            (CategoryNumber Int
ci, ReplacementIndices
ixs') ->
                case MatchOutput -> [Int]
matchedCatIxs MatchOutput
out [Int] -> Int -> Maybe Int
forall a. [a] -> Int -> Maybe a
!? Int
ci of
                    Just Int
i | Just Either Grapheme [Lexeme Expanded 'Replacement]
g' <- [Either Grapheme [Lexeme Expanded 'Replacement]]
gs [Either Grapheme [Lexeme Expanded 'Replacement]]
-> Int -> Maybe (Either Grapheme [Lexeme Expanded 'Replacement])
forall a. [a] -> Int -> Maybe a
!? Int
i ->
                        case Either Grapheme [Lexeme Expanded 'Replacement]
g' of
                            Left Grapheme
g -> [(ReplacementIndices
ixs', (Grapheme -> MultiZipper t Grapheme -> MultiZipper t Grapheme
forall a t. a -> MultiZipper t a -> MultiZipper t a
insert Grapheme
g MultiZipper t Grapheme
mz, Grapheme -> Maybe Grapheme
forall a. a -> Maybe a
Just Grapheme
g))]
                            Right [Lexeme Expanded 'Replacement]
ls -> ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall t.
ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
go ReplacementIndices
ixs' [Lexeme Expanded 'Replacement]
ls (MultiZipper t Grapheme
mz, Maybe Grapheme
prev)
                    Maybe Int
_ -> [(ReplacementIndices
ixs', (Grapheme -> MultiZipper t Grapheme -> MultiZipper t Grapheme
forall a t. a -> MultiZipper t a -> MultiZipper t a
insert (String -> Grapheme
GMulti String
"\xfffd") MultiZipper t Grapheme
mz, Maybe Grapheme
forall a. Maybe a
Nothing))]  -- Unicode replacement character

            (CategoryNumber
Nondeterministic, ReplacementIndices
ixs') -> [Either Grapheme [Lexeme Expanded 'Replacement]]
gs [Either Grapheme [Lexeme Expanded 'Replacement]]
-> (Either Grapheme [Lexeme Expanded 'Replacement]
    -> [(ReplacementIndices,
         (MultiZipper t Grapheme, Maybe Grapheme))])
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Left Grapheme
g -> [(ReplacementIndices
ixs', (Grapheme -> MultiZipper t Grapheme -> MultiZipper t Grapheme
forall a t. a -> MultiZipper t a -> MultiZipper t a
insert Grapheme
g MultiZipper t Grapheme
mz, Grapheme -> Maybe Grapheme
forall a. a -> Maybe a
Just Grapheme
g))]
                Right [Lexeme Expanded 'Replacement]
ls -> ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall t.
ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
go ReplacementIndices
ixs' [Lexeme Expanded 'Replacement]
ls (MultiZipper t Grapheme
mz, Maybe Grapheme
prev)
    replaceLex ReplacementIndices
ixs (Optional [Lexeme Expanded 'Replacement]
ls) MultiZipper t Grapheme
mz Maybe Grapheme
prev =
        let (Int
co, ReplacementIndices
ixs') = ReplacementIndices -> (Int, ReplacementIndices)
advanceOptional ReplacementIndices
ixs in
            case MatchOutput -> [Bool]
matchedOptionals MatchOutput
out [Bool] -> Int -> Maybe Bool
forall a. [a] -> Int -> Maybe a
!? Int
co of
                Just Bool
True -> ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall t.
ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
go ReplacementIndices
ixs' [Lexeme Expanded 'Replacement]
ls (MultiZipper t Grapheme
mz, Maybe Grapheme
prev)
                Just Bool
False -> [(ReplacementIndices
ixs', (MultiZipper t Grapheme
mz, Maybe Grapheme
forall a. Maybe a
Nothing))]
                Maybe Bool
Nothing    ->  (ReplacementIndices
ixs', (MultiZipper t Grapheme
mz, Maybe Grapheme
forall a. Maybe a
Nothing)) (ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall a. a -> [a] -> [a]
: ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall t.
ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
go ReplacementIndices
ixs [Lexeme Expanded 'Replacement]
ls (MultiZipper t Grapheme
mz, Maybe Grapheme
prev)
    replaceLex ReplacementIndices
ixs Lexeme Expanded 'Replacement
Metathesis MultiZipper t Grapheme
mz Maybe Grapheme
_prev =
        [( ReplacementIndices
ixs
         , ( (PWord -> MultiZipper t Grapheme -> MultiZipper t Grapheme)
-> MultiZipper t Grapheme -> PWord -> MultiZipper t Grapheme
forall a b c. (a -> b -> c) -> b -> a -> c
flip PWord -> MultiZipper t Grapheme -> MultiZipper t Grapheme
forall a t. [a] -> MultiZipper t a -> MultiZipper t a
insertMany MultiZipper t Grapheme
mz (PWord -> MultiZipper t Grapheme)
-> PWord -> MultiZipper t Grapheme
forall a b. (a -> b) -> a -> b
$ PWord -> PWord
forall a. [a] -> [a]
reverse (PWord -> PWord) -> PWord -> PWord
forall a b. (a -> b) -> a -> b
$ MatchOutput -> PWord
matchedGraphemes MatchOutput
out
           , PWord -> Maybe Grapheme
forall a. [a] -> Maybe a
listToMaybe (PWord -> Maybe Grapheme) -> PWord -> Maybe Grapheme
forall a b. (a -> b) -> a -> b
$ MatchOutput -> PWord
matchedGraphemes MatchOutput
out)
         )]
    replaceLex ReplacementIndices
ixs Lexeme Expanded 'Replacement
Geminate MultiZipper t Grapheme
mz Maybe Grapheme
prev =
        [(ReplacementIndices
ixs, ((PWord -> MultiZipper t Grapheme -> MultiZipper t Grapheme)
-> MultiZipper t Grapheme -> PWord -> MultiZipper t Grapheme
forall a b c. (a -> b -> c) -> b -> a -> c
flip PWord -> MultiZipper t Grapheme -> MultiZipper t Grapheme
forall a t. [a] -> MultiZipper t a -> MultiZipper t a
insertMany MultiZipper t Grapheme
mz (PWord -> MultiZipper t Grapheme)
-> PWord -> MultiZipper t Grapheme
forall a b. (a -> b) -> a -> b
$ Maybe Grapheme -> PWord
forall a. Maybe a -> [a]
maybeToList Maybe Grapheme
prev, Maybe Grapheme
prev))]
    replaceLex ReplacementIndices
ixs Lexeme Expanded 'Replacement
Discard MultiZipper t Grapheme
mz Maybe Grapheme
prev =
        let (CategoryNumber
_, ReplacementIndices
ixs') = ReplacementIndices -> Int -> (CategoryNumber, ReplacementIndices)
advanceCategory ReplacementIndices
ixs Int
numCatsMatched
        in [(ReplacementIndices
ixs', (MultiZipper t Grapheme
mz, Maybe Grapheme
prev))]
    replaceLex ReplacementIndices
ixs (Backreference Int
i Expanded 'Replacement
c) MultiZipper t Grapheme
mz Maybe Grapheme
prev =
        let ixs' :: ReplacementIndices
ixs' = CategoryNumber -> ReplacementIndices -> ReplacementIndices
forceCategory (Int -> CategoryNumber
CategoryNumber (Int -> CategoryNumber) -> Int -> CategoryNumber
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ReplacementIndices
ixs -- 1-based indexing!

        in ReplacementIndices
-> Lexeme Expanded 'Replacement
-> MultiZipper t Grapheme
-> Maybe Grapheme
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall t.
ReplacementIndices
-> Lexeme Expanded 'Replacement
-> MultiZipper t Grapheme
-> Maybe Grapheme
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
replaceLex ReplacementIndices
ixs' (Expanded 'Replacement -> Lexeme Expanded 'Replacement
forall (category :: LexemeType -> *) (a :: LexemeType).
category a -> Lexeme category a
Category Expanded 'Replacement
c) MultiZipper t Grapheme
mz Maybe Grapheme
prev
    replaceLex ReplacementIndices
ixs (Multiple Expanded 'Replacement
c) MultiZipper t Grapheme
mz Maybe Grapheme
prev =
        let ixs' :: ReplacementIndices
ixs' = CategoryNumber -> ReplacementIndices -> ReplacementIndices
forceCategory CategoryNumber
Nondeterministic ReplacementIndices
ixs
        in ReplacementIndices
-> Lexeme Expanded 'Replacement
-> MultiZipper t Grapheme
-> Maybe Grapheme
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall t.
ReplacementIndices
-> Lexeme Expanded 'Replacement
-> MultiZipper t Grapheme
-> Maybe Grapheme
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
replaceLex ReplacementIndices
ixs' (Expanded 'Replacement -> Lexeme Expanded 'Replacement
forall (category :: LexemeType -> *) (a :: LexemeType).
category a -> Lexeme category a
Category Expanded 'Replacement
c) MultiZipper t Grapheme
mz Maybe Grapheme
prev
    replaceLex ReplacementIndices
ixs (Wildcard Lexeme Expanded 'Replacement
l) MultiZipper t Grapheme
mz Maybe Grapheme
prev =
        let (Int
i, ReplacementIndices
ixs') = ReplacementIndices -> (Int, ReplacementIndices)
advanceWildcard ReplacementIndices
ixs
        in case MatchOutput -> [PWord]
matchedWildcards MatchOutput
out [PWord] -> Int -> Maybe PWord
forall a. [a] -> Int -> Maybe a
!? Int
i of
            Just PWord
w -> ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall t.
ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
go ReplacementIndices
ixs' ((Grapheme -> Lexeme Expanded 'Replacement)
-> PWord -> [Lexeme Expanded 'Replacement]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Grapheme -> Lexeme Expanded 'Replacement
forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> Lexeme category a
Grapheme PWord
w [Lexeme Expanded 'Replacement]
-> [Lexeme Expanded 'Replacement] -> [Lexeme Expanded 'Replacement]
forall a. [a] -> [a] -> [a]
++ [Lexeme Expanded 'Replacement
l]) (MultiZipper t Grapheme
mz, Maybe Grapheme
prev)
            -- need to add 'l' here too

            Maybe PWord
Nothing -> ReplacementIndices
-> Lexeme Expanded 'Replacement
-> MultiZipper t Grapheme
-> Maybe Grapheme
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall t.
ReplacementIndices
-> Lexeme Expanded 'Replacement
-> MultiZipper t Grapheme
-> Maybe Grapheme
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
replaceLex ReplacementIndices
ixs' Lexeme Expanded 'Replacement
l MultiZipper t Grapheme
mz Maybe Grapheme
prev
    replaceLex ReplacementIndices
ixs (Kleene Lexeme Expanded 'Replacement
l) MultiZipper t Grapheme
mz Maybe Grapheme
prev =
        let (Int
i, ReplacementIndices
ixs') = ReplacementIndices -> (Int, ReplacementIndices)
advanceKleene ReplacementIndices
ixs
        in case MatchOutput -> [Int]
matchedKleenes MatchOutput
out [Int] -> Int -> Maybe Int
forall a. [a] -> Int -> Maybe a
!? Int
i of
            Just Int
n -> ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall t.
ReplacementIndices
-> [Lexeme Expanded 'Replacement]
-> (MultiZipper t Grapheme, Maybe Grapheme)
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
go ReplacementIndices
ixs' (Int
-> Lexeme Expanded 'Replacement -> [Lexeme Expanded 'Replacement]
forall a. Int -> a -> [a]
replicate Int
n Lexeme Expanded 'Replacement
l) (MultiZipper t Grapheme
mz, Maybe Grapheme
prev)
            Maybe Int
Nothing -> [(ReplacementIndices
ixs', (MultiZipper t Grapheme
mz, Maybe Grapheme
prev))]

-- | Given a 'Rule' and a 'MultiZipper', determines whether the

-- 'exception' of that rule (if any) applies starting at the current

-- position of the 'MultiZipper'; if it does, returns the index of the

-- first element of each matching 'target'.

exceptionAppliesAtPoint
    :: [Lexeme Expanded 'Matched]
    -> Environment Expanded
    -> MultiZipper RuleTag Grapheme -> [Int]
exceptionAppliesAtPoint :: [Lexeme Expanded 'Matched]
-> Environment Expanded -> MultiZipper RuleTag Grapheme -> [Int]
exceptionAppliesAtPoint [Lexeme Expanded 'Matched]
target ([Lexeme Expanded 'Matched]
ex1, [Lexeme Expanded 'Matched]
ex2) MultiZipper RuleTag Grapheme
mz = ((Int, MultiZipper RuleTag Grapheme) -> Int)
-> [(Int, MultiZipper RuleTag Grapheme)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, MultiZipper RuleTag Grapheme) -> Int
forall a b. (a, b) -> a
fst ([(Int, MultiZipper RuleTag Grapheme)] -> [Int])
-> [(Int, MultiZipper RuleTag Grapheme)] -> [Int]
forall a b. (a -> b) -> a -> b
$ (RuleAp Int
 -> MultiZipper RuleTag Grapheme
 -> [(Int, MultiZipper RuleTag Grapheme)])
-> MultiZipper RuleTag Grapheme
-> RuleAp Int
-> [(Int, MultiZipper RuleTag Grapheme)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip RuleAp Int
-> MultiZipper RuleTag Grapheme
-> [(Int, MultiZipper RuleTag Grapheme)]
forall a.
RuleAp a
-> MultiZipper RuleTag Grapheme
-> [(a, MultiZipper RuleTag Grapheme)]
runRuleAp MultiZipper RuleTag Grapheme
mz (RuleAp Int -> [(Int, MultiZipper RuleTag Grapheme)])
-> RuleAp Int -> [(Int, MultiZipper RuleTag Grapheme)]
forall a b. (a -> b) -> a -> b
$ do
    MatchOutput
ex1Out <- (MultiZipper RuleTag Grapheme
 -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a.
(MultiZipper RuleTag Grapheme
 -> [(a, MultiZipper RuleTag Grapheme)])
-> RuleAp a
RuleAp ((MultiZipper RuleTag Grapheme
  -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
 -> RuleAp MatchOutput)
-> (MultiZipper RuleTag Grapheme
    -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a b. (a -> b) -> a -> b
$ Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper RuleTag Grapheme
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
forall t.
Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany' Maybe Grapheme
forall a. Maybe a
Nothing [Lexeme Expanded 'Matched]
ex1
    Int
pos <- (MultiZipper RuleTag Grapheme -> Int) -> RuleAp Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MultiZipper RuleTag Grapheme -> Int
forall t a. MultiZipper t a -> Int
curPos
    MatchOutput{PWord
matchedGraphemes :: MatchOutput -> PWord
matchedGraphemes :: PWord
matchedGraphemes} <- (MultiZipper RuleTag Grapheme
 -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a.
(MultiZipper RuleTag Grapheme
 -> [(a, MultiZipper RuleTag Grapheme)])
-> RuleAp a
RuleAp ((MultiZipper RuleTag Grapheme
  -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
 -> RuleAp MatchOutput)
-> (MultiZipper RuleTag Grapheme
    -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a b. (a -> b) -> a -> b
$ Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper RuleTag Grapheme
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
forall t.
Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany' Maybe Grapheme
forall a. Maybe a
Nothing [Lexeme Expanded 'Matched]
target
    MatchOutput
_ <- (MultiZipper RuleTag Grapheme
 -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a.
(MultiZipper RuleTag Grapheme
 -> [(a, MultiZipper RuleTag Grapheme)])
-> RuleAp a
RuleAp ((MultiZipper RuleTag Grapheme
  -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
 -> RuleAp MatchOutput)
-> (MultiZipper RuleTag Grapheme
    -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a b. (a -> b) -> a -> b
$ MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper RuleTag Grapheme
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany MatchOutput
ex1Out (PWord -> Maybe Grapheme
forall a. [a] -> Maybe a
listToMaybe PWord
matchedGraphemes) [Lexeme Expanded 'Matched]
ex2
    Int -> RuleAp Int
forall a. a -> RuleAp a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
pos

-- | Given a target and environment, determine if they rule

-- matches. If so, for each match, set the appropriate 'RuleTag's and

-- return a tuple of @(is, gs)@, where @gs@ is a list of matched

-- t'Grapheme's, and @is@ is a list of indices, one for each

-- 'Category' lexeme matched.

matchRuleAtPoint
    :: [Lexeme Expanded 'Matched]
    -> Environment Expanded
    -> MultiZipper RuleTag Grapheme
    -> [(MatchOutput, MultiZipper RuleTag Grapheme)]
matchRuleAtPoint :: [Lexeme Expanded 'Matched]
-> Environment Expanded
-> MultiZipper RuleTag Grapheme
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
matchRuleAtPoint [Lexeme Expanded 'Matched]
target ([Lexeme Expanded 'Matched]
env1,[Lexeme Expanded 'Matched]
env2) MultiZipper RuleTag Grapheme
mz = (RuleAp MatchOutput
 -> MultiZipper RuleTag Grapheme
 -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> MultiZipper RuleTag Grapheme
-> RuleAp MatchOutput
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip RuleAp MatchOutput
-> MultiZipper RuleTag Grapheme
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
forall a.
RuleAp a
-> MultiZipper RuleTag Grapheme
-> [(a, MultiZipper RuleTag Grapheme)]
runRuleAp MultiZipper RuleTag Grapheme
mz (RuleAp MatchOutput
 -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
forall a b. (a -> b) -> a -> b
$ do
    MatchOutput
env1Out <- (MultiZipper RuleTag Grapheme
 -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a.
(MultiZipper RuleTag Grapheme
 -> [(a, MultiZipper RuleTag Grapheme)])
-> RuleAp a
RuleAp ((MultiZipper RuleTag Grapheme
  -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
 -> RuleAp MatchOutput)
-> (MultiZipper RuleTag Grapheme
    -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a b. (a -> b) -> a -> b
$ Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper RuleTag Grapheme
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
forall t.
Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany' Maybe Grapheme
forall a. Maybe a
Nothing [Lexeme Expanded 'Matched]
env1
    -- start of target needs to be INSIDE 'MultiZipper'!

    -- otherwise get weird things like /x/#_ resulting in

    -- #abc#→#xabd#x when it should be #abc#→#xabc#

    (MultiZipper RuleTag Grapheme -> Bool) -> RuleAp Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MultiZipper RuleTag Grapheme -> Bool
forall t a. MultiZipper t a -> Bool
atBoundary RuleAp Bool -> (Bool -> RuleAp MatchOutput) -> RuleAp MatchOutput
forall a b. RuleAp a -> (a -> RuleAp b) -> RuleAp b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> (MultiZipper RuleTag Grapheme
 -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a.
(MultiZipper RuleTag Grapheme
 -> [(a, MultiZipper RuleTag Grapheme)])
-> RuleAp a
RuleAp ((MultiZipper RuleTag Grapheme
  -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
 -> RuleAp MatchOutput)
-> (MultiZipper RuleTag Grapheme
    -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a b. (a -> b) -> a -> b
$ [(MatchOutput, MultiZipper RuleTag Grapheme)]
-> MultiZipper RuleTag Grapheme
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
forall a b. a -> b -> a
const []
        Bool
False -> do
            (MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
-> RuleAp ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
 -> RuleAp ())
-> (MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
-> RuleAp ()
forall a b. (a -> b) -> a -> b
$ RuleTag
-> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall t a. Ord t => t -> MultiZipper t a -> MultiZipper t a
tag RuleTag
TargetStart
            MatchOutput
matchResult <- (MultiZipper RuleTag Grapheme
 -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a.
(MultiZipper RuleTag Grapheme
 -> [(a, MultiZipper RuleTag Grapheme)])
-> RuleAp a
RuleAp ((MultiZipper RuleTag Grapheme
  -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
 -> RuleAp MatchOutput)
-> (MultiZipper RuleTag Grapheme
    -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a b. (a -> b) -> a -> b
$ Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper RuleTag Grapheme
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
forall t.
Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany' Maybe Grapheme
forall a. Maybe a
Nothing [Lexeme Expanded 'Matched]
target
            (MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
-> RuleAp ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
 -> RuleAp ())
-> (MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
-> RuleAp ()
forall a b. (a -> b) -> a -> b
$ RuleTag
-> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall t a. Ord t => t -> MultiZipper t a -> MultiZipper t a
tag RuleTag
TargetEnd
            MatchOutput
_ <- (MultiZipper RuleTag Grapheme
 -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a.
(MultiZipper RuleTag Grapheme
 -> [(a, MultiZipper RuleTag Grapheme)])
-> RuleAp a
RuleAp ((MultiZipper RuleTag Grapheme
  -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
 -> RuleAp MatchOutput)
-> (MultiZipper RuleTag Grapheme
    -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> RuleAp MatchOutput
forall a b. (a -> b) -> a -> b
$ MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper RuleTag Grapheme
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
forall t.
MatchOutput
-> Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany MatchOutput
env1Out (PWord -> Maybe Grapheme
forall a. [a] -> Maybe a
listToMaybe (PWord -> Maybe Grapheme) -> PWord -> Maybe Grapheme
forall a b. (a -> b) -> a -> b
$ MatchOutput -> PWord
matchedGraphemes MatchOutput
matchResult) [Lexeme Expanded 'Matched]
env2
            MatchOutput -> RuleAp MatchOutput
forall a. a -> RuleAp a
forall (m :: * -> *) a. Monad m => a -> m a
return MatchOutput
matchResult

data RuleStatus
    = SuccessNormal      -- ^ Rule was successful, no need for special handling

    | SuccessEpenthesis  -- ^ Rule was successful, but cursor was not advanced: need to avoid infinite loop

    | Failure            -- ^ Rule failed

    deriving (RuleStatus -> RuleStatus -> Bool
(RuleStatus -> RuleStatus -> Bool)
-> (RuleStatus -> RuleStatus -> Bool) -> Eq RuleStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RuleStatus -> RuleStatus -> Bool
== :: RuleStatus -> RuleStatus -> Bool
$c/= :: RuleStatus -> RuleStatus -> Bool
/= :: RuleStatus -> RuleStatus -> Bool
Eq, Int -> RuleStatus -> ShowS
[RuleStatus] -> ShowS
RuleStatus -> String
(Int -> RuleStatus -> ShowS)
-> (RuleStatus -> String)
-> ([RuleStatus] -> ShowS)
-> Show RuleStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuleStatus -> ShowS
showsPrec :: Int -> RuleStatus -> ShowS
$cshow :: RuleStatus -> String
show :: RuleStatus -> String
$cshowList :: [RuleStatus] -> ShowS
showList :: [RuleStatus] -> ShowS
Show)

-- | Given a 'Rule', determine if the rule matches at the current

-- point; if so, apply the rule, adding appropriate tags.

applyOnce :: Rule Expanded -> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
applyOnce :: Rule Expanded
-> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
applyOnce r :: Rule Expanded
r@Rule{[Lexeme Expanded 'Matched]
target :: forall (c :: LexemeType -> *). Rule c -> [Lexeme c 'Matched]
target :: [Lexeme Expanded 'Matched]
target, [Lexeme Expanded 'Replacement]
replacement :: [Lexeme Expanded 'Replacement]
replacement :: forall (c :: LexemeType -> *). Rule c -> [Lexeme c 'Replacement]
replacement, Maybe (Environment Expanded)
exception :: forall (c :: LexemeType -> *). Rule c -> Maybe (Environment c)
exception :: Maybe (Environment Expanded)
exception} =
    (MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
-> StateT (MultiZipper RuleTag Grapheme) [] ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (RuleTag
-> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall t a. Ord t => t -> MultiZipper t a -> MultiZipper t a
tag RuleTag
AppStart) StateT (MultiZipper RuleTag Grapheme) [] ()
-> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
-> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
forall a b.
StateT (MultiZipper RuleTag Grapheme) [] a
-> StateT (MultiZipper RuleTag Grapheme) [] b
-> StateT (MultiZipper RuleTag Grapheme) [] b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Environment Expanded]
-> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
go (Rule Expanded -> [Environment Expanded]
forall (c :: LexemeType -> *). Rule c -> [Environment c]
environment Rule Expanded
r)
  where
    go :: [Environment Expanded]
-> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
go [] = RuleStatus -> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
forall a. a -> StateT (MultiZipper RuleTag Grapheme) [] a
forall (m :: * -> *) a. Monad m => a -> m a
return RuleStatus
Failure
    go (Environment Expanded
env:[Environment Expanded]
envs) = do
        Maybe MatchOutput
result <- (MultiZipper RuleTag Grapheme
 -> [(MatchOutput, MultiZipper RuleTag Grapheme)])
-> StateT (MultiZipper RuleTag Grapheme) [] (Maybe MatchOutput)
forall s a. (s -> [(a, s)]) -> StateT s [] (Maybe a)
try ([Lexeme Expanded 'Matched]
-> Environment Expanded
-> MultiZipper RuleTag Grapheme
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
matchRuleAtPoint [Lexeme Expanded 'Matched]
target Environment Expanded
env)
        case Maybe MatchOutput
result of
            Just MatchOutput
out -> do
                [Int]
exs <- case Maybe (Environment Expanded)
exception of
                    Maybe (Environment Expanded)
Nothing -> [Int] -> StateT (MultiZipper RuleTag Grapheme) [] [Int]
forall a. a -> StateT (MultiZipper RuleTag Grapheme) [] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                    Just Environment Expanded
ex -> (MultiZipper RuleTag Grapheme -> [Int])
-> StateT (MultiZipper RuleTag Grapheme) [] [Int]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((MultiZipper RuleTag Grapheme -> [Int])
 -> StateT (MultiZipper RuleTag Grapheme) [] [Int])
-> (MultiZipper RuleTag Grapheme -> [Int])
-> StateT (MultiZipper RuleTag Grapheme) [] [Int]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [Int]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Int]] -> [Int])
-> (MultiZipper RuleTag Grapheme -> [[Int]])
-> MultiZipper RuleTag Grapheme
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiZipper RuleTag [Int] -> [[Int]]
forall t a. MultiZipper t a -> [a]
toList (MultiZipper RuleTag [Int] -> [[Int]])
-> (MultiZipper RuleTag Grapheme -> MultiZipper RuleTag [Int])
-> MultiZipper RuleTag Grapheme
-> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        (MultiZipper RuleTag Grapheme -> [Int])
-> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag [Int]
forall t a b.
(MultiZipper t a -> b) -> MultiZipper t a -> MultiZipper t b
extend' ([Lexeme Expanded 'Matched]
-> Environment Expanded -> MultiZipper RuleTag Grapheme -> [Int]
exceptionAppliesAtPoint [Lexeme Expanded 'Matched]
target Environment Expanded
ex)
                (MultiZipper RuleTag Grapheme -> Maybe Int)
-> StateT (MultiZipper RuleTag Grapheme) [] (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (RuleTag -> MultiZipper RuleTag Grapheme -> Maybe Int
forall t a. Ord t => t -> MultiZipper t a -> Maybe Int
locationOf RuleTag
TargetStart) StateT (MultiZipper RuleTag Grapheme) [] (Maybe Int)
-> (Maybe Int
    -> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus)
-> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
forall a b.
StateT (MultiZipper RuleTag Grapheme) [] a
-> (a -> StateT (MultiZipper RuleTag Grapheme) [] b)
-> StateT (MultiZipper RuleTag Grapheme) [] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe Int
p ->
                    if Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
exs) Maybe Int
p
                    then RuleStatus -> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
forall a. a -> StateT (MultiZipper RuleTag Grapheme) [] a
forall (m :: * -> *) a. Monad m => a -> m a
return RuleStatus
Failure
                    else do
                        MultiZipper RuleTag Grapheme
originalWord <- StateT
  (MultiZipper RuleTag Grapheme) [] (MultiZipper RuleTag Grapheme)
forall s (m :: * -> *). MonadState s m => m s
get
                        (MultiZipper RuleTag Grapheme
 -> Maybe (MultiZipper RuleTag Grapheme))
-> StateT (MultiZipper RuleTag Grapheme) [] ()
forall (m :: * -> *) s. Monad m => (s -> Maybe s) -> StateT s m ()
modifyMay ((MultiZipper RuleTag Grapheme
  -> Maybe (MultiZipper RuleTag Grapheme))
 -> StateT (MultiZipper RuleTag Grapheme) [] ())
-> (MultiZipper RuleTag Grapheme
    -> Maybe (MultiZipper RuleTag Grapheme))
-> StateT (MultiZipper RuleTag Grapheme) [] ()
forall a b. (a -> b) -> a -> b
$ (RuleTag, RuleTag)
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a.
Ord t =>
(t, t) -> MultiZipper t a -> Maybe (MultiZipper t a)
delete (RuleTag
TargetStart, RuleTag
TargetEnd)
                        (MultiZipper RuleTag Grapheme
 -> Maybe (MultiZipper RuleTag Grapheme))
-> StateT (MultiZipper RuleTag Grapheme) [] ()
forall (m :: * -> *) s. Monad m => (s -> Maybe s) -> StateT s m ()
modifyMay ((MultiZipper RuleTag Grapheme
  -> Maybe (MultiZipper RuleTag Grapheme))
 -> StateT (MultiZipper RuleTag Grapheme) [] ())
-> (MultiZipper RuleTag Grapheme
    -> Maybe (MultiZipper RuleTag Grapheme))
-> StateT (MultiZipper RuleTag Grapheme) [] ()
forall a b. (a -> b) -> a -> b
$ RuleTag
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a.
Ord t =>
t -> MultiZipper t a -> Maybe (MultiZipper t a)
seek RuleTag
TargetStart
                        (MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme])
-> StateT (MultiZipper RuleTag Grapheme) [] ()
forall (m :: * -> *) s. Monad m => (s -> m s) -> StateT s m ()
modifyM ((MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme])
 -> StateT (MultiZipper RuleTag Grapheme) [] ())
-> (MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme])
-> StateT (MultiZipper RuleTag Grapheme) [] ()
forall a b. (a -> b) -> a -> b
$ \MultiZipper RuleTag Grapheme
w ->
                            let replacedWords :: [MultiZipper RuleTag Grapheme]
replacedWords = MatchOutput
-> [Lexeme Expanded 'Replacement]
-> MultiZipper RuleTag Grapheme
-> [MultiZipper RuleTag Grapheme]
forall t.
MatchOutput
-> [Lexeme Expanded 'Replacement]
-> MultiZipper t Grapheme
-> [MultiZipper t Grapheme]
mkReplacement MatchOutput
out [Lexeme Expanded 'Replacement]
replacement MultiZipper RuleTag Grapheme
w
                            in case Flags -> Sporadicity
sporadic (Rule Expanded -> Flags
forall (c :: LexemeType -> *). Rule c -> Flags
flags Rule Expanded
r) of
                                -- make sure to re-insert original word

                                Sporadicity
PerApplication -> MultiZipper RuleTag Grapheme
originalWord MultiZipper RuleTag Grapheme
-> [MultiZipper RuleTag Grapheme] -> [MultiZipper RuleTag Grapheme]
forall a. a -> [a] -> [a]
: [MultiZipper RuleTag Grapheme]
replacedWords
                                Sporadicity
_ -> [MultiZipper RuleTag Grapheme]
replacedWords
                        RuleStatus -> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
forall a. a -> StateT (MultiZipper RuleTag Grapheme) [] a
forall (m :: * -> *) a. Monad m => a -> m a
return (RuleStatus -> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus)
-> RuleStatus
-> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
forall a b. (a -> b) -> a -> b
$
                            -- An epenthesis rule will cause an infinite loop

                            -- if it matched no graphemes before the replacement

                            if PWord -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (MatchOutput -> PWord
matchedGraphemes MatchOutput
out) Bool -> Bool -> Bool
&& [Lexeme Expanded 'Matched] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Environment Expanded -> [Lexeme Expanded 'Matched]
forall a b. (a, b) -> a
fst Environment Expanded
env)
                                then RuleStatus
SuccessEpenthesis
                                else RuleStatus
SuccessNormal
            Maybe MatchOutput
Nothing -> (MultiZipper RuleTag Grapheme
 -> Maybe (MultiZipper RuleTag Grapheme))
-> StateT (MultiZipper RuleTag Grapheme) [] ()
forall (m :: * -> *) s. Monad m => (s -> Maybe s) -> StateT s m ()
modifyMay (RuleTag
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a.
Ord t =>
t -> MultiZipper t a -> Maybe (MultiZipper t a)
seek RuleTag
AppStart) StateT (MultiZipper RuleTag Grapheme) [] ()
-> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
-> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
forall a b.
StateT (MultiZipper RuleTag Grapheme) [] a
-> StateT (MultiZipper RuleTag Grapheme) [] b
-> StateT (MultiZipper RuleTag Grapheme) [] b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Environment Expanded]
-> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
go [Environment Expanded]
envs

-- | Remove tags and advance the current index to the next t'Grapheme'

-- after the rule application.

setupForNextApplication
    :: RuleStatus
    -> Rule Expanded
    -> MultiZipper RuleTag Grapheme
    -> Maybe (MultiZipper RuleTag Grapheme)
setupForNextApplication :: RuleStatus
-> Rule Expanded
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
setupForNextApplication RuleStatus
status Rule{flags :: forall (c :: LexemeType -> *). Rule c -> Flags
flags=Flags{Direction
applyDirection :: Direction
applyDirection :: Flags -> Direction
applyDirection}} =
    (MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
-> Maybe (MultiZipper RuleTag Grapheme)
-> Maybe (MultiZipper RuleTag Grapheme)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall t a. MultiZipper t a -> MultiZipper t a
untag (Maybe (MultiZipper RuleTag Grapheme)
 -> Maybe (MultiZipper RuleTag Grapheme))
-> (MultiZipper RuleTag Grapheme
    -> Maybe (MultiZipper RuleTag Grapheme))
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case Direction
applyDirection of
        Direction
RTL -> RuleTag
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a.
Ord t =>
t -> MultiZipper t a -> Maybe (MultiZipper t a)
seek RuleTag
AppStart (MultiZipper RuleTag Grapheme
 -> Maybe (MultiZipper RuleTag Grapheme))
-> (MultiZipper RuleTag Grapheme
    -> Maybe (MultiZipper RuleTag Grapheme))
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a. MultiZipper t a -> Maybe (MultiZipper t a)
bwd
        Direction
LTR -> case RuleStatus
status of
            RuleStatus
SuccessNormal -> RuleTag
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a.
Ord t =>
t -> MultiZipper t a -> Maybe (MultiZipper t a)
seek RuleTag
TargetEnd
            RuleStatus
SuccessEpenthesis ->
                -- need to move forward if applying an epenthesis rule to avoid an infinite loop

                RuleTag
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a.
Ord t =>
t -> MultiZipper t a -> Maybe (MultiZipper t a)
seek RuleTag
TargetEnd (MultiZipper RuleTag Grapheme
 -> Maybe (MultiZipper RuleTag Grapheme))
-> (MultiZipper RuleTag Grapheme
    -> Maybe (MultiZipper RuleTag Grapheme))
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a. MultiZipper t a -> Maybe (MultiZipper t a)
fwd
            RuleStatus
Failure -> RuleTag
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a.
Ord t =>
t -> MultiZipper t a -> Maybe (MultiZipper t a)
seek RuleTag
AppStart (MultiZipper RuleTag Grapheme
 -> Maybe (MultiZipper RuleTag Grapheme))
-> (MultiZipper RuleTag Grapheme
    -> Maybe (MultiZipper RuleTag Grapheme))
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a. MultiZipper t a -> Maybe (MultiZipper t a)
fwd

-- | Apply a 'Rule' to a 'MultiZipper'. The application will start at

-- the beginning of the 'MultiZipper', and will be repeated as many

-- times as possible. Returns all valid results.

applyRule :: Rule Expanded -> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
applyRule :: Rule Expanded
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
applyRule Rule Expanded
r = \MultiZipper RuleTag Grapheme
mz ->    -- use a lambda so mz isn't shadowed in the where block

    let startingPos :: MultiZipper RuleTag Grapheme
startingPos = case Flags -> Direction
applyDirection (Flags -> Direction) -> Flags -> Direction
forall a b. (a -> b) -> a -> b
$ Rule Expanded -> Flags
forall (c :: LexemeType -> *). Rule c -> Flags
flags Rule Expanded
r of
            Direction
LTR -> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall t a. MultiZipper t a -> MultiZipper t a
toBeginning MultiZipper RuleTag Grapheme
mz
            Direction
RTL -> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall t a. MultiZipper t a -> MultiZipper t a
toEnd MultiZipper RuleTag Grapheme
mz
        result :: [MultiZipper RuleTag Grapheme]
result = StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
repeatRule (Rule Expanded
-> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
applyOnce Rule Expanded
r) MultiZipper RuleTag Grapheme
startingPos
    in case Flags -> Sporadicity
sporadic (Rule Expanded -> Flags
forall (c :: LexemeType -> *). Rule c -> Flags
flags Rule Expanded
r) of
        Sporadicity
PerWord -> MultiZipper RuleTag Grapheme
mz MultiZipper RuleTag Grapheme
-> [MultiZipper RuleTag Grapheme] -> [MultiZipper RuleTag Grapheme]
forall a. a -> [a] -> [a]
: [MultiZipper RuleTag Grapheme]
result
        Sporadicity
_ -> [MultiZipper RuleTag Grapheme]
result  -- PerApplication handled in 'applyOnce'

  where
    repeatRule
        :: StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
        -> MultiZipper RuleTag Grapheme
        -> [MultiZipper RuleTag Grapheme]
    repeatRule :: StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
repeatRule StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
m MultiZipper RuleTag Grapheme
mz = StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
-> MultiZipper RuleTag Grapheme
-> [(RuleStatus, MultiZipper RuleTag Grapheme)]
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
m MultiZipper RuleTag Grapheme
mz [(RuleStatus, MultiZipper RuleTag Grapheme)]
-> ((RuleStatus, MultiZipper RuleTag Grapheme)
    -> [MultiZipper RuleTag Grapheme])
-> [MultiZipper RuleTag Grapheme]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(RuleStatus
status, MultiZipper RuleTag Grapheme
mz') ->
        if (RuleStatus
status RuleStatus -> RuleStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= RuleStatus
Failure) Bool -> Bool -> Bool
&& Flags -> Bool
applyOnceOnly (Rule Expanded -> Flags
forall (c :: LexemeType -> *). Rule c -> Flags
flags Rule Expanded
r)
        then [MultiZipper RuleTag Grapheme
mz']
        else case RuleStatus
-> Rule Expanded
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
setupForNextApplication RuleStatus
status Rule Expanded
r MultiZipper RuleTag Grapheme
mz' of
            Just MultiZipper RuleTag Grapheme
mz'' -> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
repeatRule StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
m MultiZipper RuleTag Grapheme
mz''
            Maybe (MultiZipper RuleTag Grapheme)
Nothing -> [MultiZipper RuleTag Grapheme
mz']

-- | Check if a 'MultiZipper' matches a 'Filter'.

filterMatches :: Filter Expanded -> MultiZipper RuleTag Grapheme -> Bool
filterMatches :: Filter Expanded -> MultiZipper RuleTag Grapheme -> Bool
filterMatches (Filter String
_ [Lexeme Expanded 'Matched]
ls) = MultiZipper RuleTag Grapheme -> Bool
go (MultiZipper RuleTag Grapheme -> Bool)
-> (MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
-> MultiZipper RuleTag Grapheme
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall t a. MultiZipper t a -> MultiZipper t a
toBeginning
  where
    go :: MultiZipper RuleTag Grapheme -> Bool
go MultiZipper RuleTag Grapheme
mz =
        let mzs :: [(MatchOutput, MultiZipper RuleTag Grapheme)]
mzs = Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper RuleTag Grapheme
-> [(MatchOutput, MultiZipper RuleTag Grapheme)]
forall t.
Maybe Grapheme
-> [Lexeme Expanded 'Matched]
-> MultiZipper t Grapheme
-> [(MatchOutput, MultiZipper t Grapheme)]
matchMany' Maybe Grapheme
forall a. Maybe a
Nothing [Lexeme Expanded 'Matched]
ls MultiZipper RuleTag Grapheme
mz
        in case [(MatchOutput, MultiZipper RuleTag Grapheme)]
mzs of
            [] -> Bool
-> (MultiZipper RuleTag Grapheme -> Bool)
-> Maybe (MultiZipper RuleTag Grapheme)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False MultiZipper RuleTag Grapheme -> Bool
go (Maybe (MultiZipper RuleTag Grapheme) -> Bool)
-> Maybe (MultiZipper RuleTag Grapheme) -> Bool
forall a b. (a -> b) -> a -> b
$ MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a. MultiZipper t a -> Maybe (MultiZipper t a)
fwd MultiZipper RuleTag Grapheme
mz  -- try next position if there is one

            [(MatchOutput, MultiZipper RuleTag Grapheme)]
_ -> Bool
True  -- filter has matched


-- | Check that the 'MultiZipper' contains only graphemes listed in

-- the given 'CategoriesDecl', replacing all unlisted graphemes with

-- U+FFFD.

checkGraphemes :: [Grapheme] -> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
checkGraphemes :: PWord
-> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
checkGraphemes PWord
gs = (Grapheme -> Grapheme)
-> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall a b.
(a -> b) -> MultiZipper RuleTag a -> MultiZipper RuleTag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Grapheme -> Grapheme)
 -> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
-> (Grapheme -> Grapheme)
-> MultiZipper RuleTag Grapheme
-> MultiZipper RuleTag Grapheme
forall a b. (a -> b) -> a -> b
$ \case
    Grapheme
GBoundary -> Grapheme
GBoundary
    Grapheme
g -> if Grapheme
g Grapheme -> PWord -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` PWord
gs then Grapheme
g else String -> Grapheme
GMulti String
"\xfffd"

-- | Apply a 'Statement' to a 'MultiZipper', returning zero, one or

-- more results.

applyStatement
    :: Statement Expanded [Grapheme]
    -> MultiZipper RuleTag Grapheme
    -> [MultiZipper RuleTag Grapheme]
applyStatement :: Statement Expanded PWord
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
applyStatement (RuleS Rule Expanded
r) MultiZipper RuleTag Grapheme
mz = Rule Expanded
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
applyRule Rule Expanded
r MultiZipper RuleTag Grapheme
mz
applyStatement (FilterS Filter Expanded
f) MultiZipper RuleTag Grapheme
mz
    | Filter Expanded -> MultiZipper RuleTag Grapheme -> Bool
filterMatches Filter Expanded
f MultiZipper RuleTag Grapheme
mz = []
    | Bool
otherwise = [MultiZipper RuleTag Grapheme
mz]
applyStatement (DirectiveS PWord
gs) MultiZipper RuleTag Grapheme
mz = [PWord
-> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
checkGraphemes PWord
gs MultiZipper RuleTag Grapheme
mz]

-- | Apply a single 'Rule' to a word.

--

-- Note: duplicate outputs from this function are removed. To keep

-- duplicates, use the lower-level internal function 'applyRule'

-- directly.

applyRuleStr :: Rule Expanded -> PWord -> [PWord]
-- Note: 'fromJust' is safe here as 'apply' should always succeed

applyRuleStr :: Rule Expanded -> PWord -> [PWord]
applyRuleStr Rule Expanded
r =
    PWord -> PWord
addBoundaries
    (PWord -> PWord) -> (PWord -> [PWord]) -> PWord -> [PWord]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> PWord -> MultiZipper RuleTag Grapheme
forall a t. [a] -> MultiZipper t a
fromListStart
    (PWord -> MultiZipper RuleTag Grapheme)
-> (MultiZipper RuleTag Grapheme -> [PWord]) -> PWord -> [PWord]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Rule Expanded
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
applyRule Rule Expanded
r
    (MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme])
-> ([MultiZipper RuleTag Grapheme] -> [PWord])
-> MultiZipper RuleTag Grapheme
-> [PWord]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (MultiZipper RuleTag Grapheme -> PWord)
-> [MultiZipper RuleTag Grapheme] -> [PWord]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MultiZipper RuleTag Grapheme -> PWord
forall t a. MultiZipper t a -> [a]
toList (MultiZipper RuleTag Grapheme -> PWord)
-> (PWord -> PWord) -> MultiZipper RuleTag Grapheme -> PWord
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> PWord -> PWord
removeBoundaries)
    ([MultiZipper RuleTag Grapheme] -> [PWord])
-> ([PWord] -> [PWord])
-> [MultiZipper RuleTag Grapheme]
-> [PWord]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [PWord] -> [PWord]
forall a. Ord a => [a] -> [a]
nubOrd

-- | Apply a single 'Statement' to a word.

--

-- Note: as with 'applyRuleStr', duplicate outputs from this function

-- are removed. To keep duplicates, use the lower-level internal

-- function 'applyStatement' directly.

applyStatementStr :: Statement Expanded [Grapheme] -> PWord -> [PWord]
applyStatementStr :: Statement Expanded PWord -> PWord -> [PWord]
applyStatementStr Statement Expanded PWord
st =
    PWord -> PWord
addBoundaries
    (PWord -> PWord) -> (PWord -> [PWord]) -> PWord -> [PWord]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> PWord -> MultiZipper RuleTag Grapheme
forall a t. [a] -> MultiZipper t a
fromListStart
    (PWord -> MultiZipper RuleTag Grapheme)
-> (MultiZipper RuleTag Grapheme -> [PWord]) -> PWord -> [PWord]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Statement Expanded PWord
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
applyStatement Statement Expanded PWord
st
    (MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme])
-> ([MultiZipper RuleTag Grapheme] -> [PWord])
-> MultiZipper RuleTag Grapheme
-> [PWord]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (MultiZipper RuleTag Grapheme -> PWord)
-> [MultiZipper RuleTag Grapheme] -> [PWord]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MultiZipper RuleTag Grapheme -> PWord
forall t a. MultiZipper t a -> [a]
toList (MultiZipper RuleTag Grapheme -> PWord)
-> (PWord -> PWord) -> MultiZipper RuleTag Grapheme -> PWord
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> PWord -> PWord
removeBoundaries)
    ([MultiZipper RuleTag Grapheme] -> [PWord])
-> ([PWord] -> [PWord])
-> [MultiZipper RuleTag Grapheme]
-> [PWord]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [PWord] -> [PWord]
forall a. Ord a => [a] -> [a]
nubOrd

-- | A log item representing a single application of an action. (In

-- practise this will usually be a 'Statement'.) Specifies the action

-- which was applied, as well as the ‘before’ and ‘after’ states.

data LogItem r = ActionApplied
    { forall r. LogItem r -> r
action :: r
    , forall r. LogItem r -> PWord
input :: PWord
    , forall r. LogItem r -> Maybe PWord
output :: Maybe PWord
    } deriving (Int -> LogItem r -> ShowS
[LogItem r] -> ShowS
LogItem r -> String
(Int -> LogItem r -> ShowS)
-> (LogItem r -> String)
-> ([LogItem r] -> ShowS)
-> Show (LogItem r)
forall r. Show r => Int -> LogItem r -> ShowS
forall r. Show r => [LogItem r] -> ShowS
forall r. Show r => LogItem r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall r. Show r => Int -> LogItem r -> ShowS
showsPrec :: Int -> LogItem r -> ShowS
$cshow :: forall r. Show r => LogItem r -> String
show :: LogItem r -> String
$cshowList :: forall r. Show r => [LogItem r] -> ShowS
showList :: [LogItem r] -> ShowS
Show, (forall a b. (a -> b) -> LogItem a -> LogItem b)
-> (forall a b. a -> LogItem b -> LogItem a) -> Functor LogItem
forall a b. a -> LogItem b -> LogItem a
forall a b. (a -> b) -> LogItem a -> LogItem 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) -> LogItem a -> LogItem b
fmap :: forall a b. (a -> b) -> LogItem a -> LogItem b
$c<$ :: forall a b. a -> LogItem b -> LogItem a
<$ :: forall a b. a -> LogItem b -> LogItem a
Functor, (forall x. LogItem r -> Rep (LogItem r) x)
-> (forall x. Rep (LogItem r) x -> LogItem r)
-> Generic (LogItem r)
forall x. Rep (LogItem r) x -> LogItem r
forall x. LogItem r -> Rep (LogItem r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall r x. Rep (LogItem r) x -> LogItem r
forall r x. LogItem r -> Rep (LogItem r) x
$cfrom :: forall r x. LogItem r -> Rep (LogItem r) x
from :: forall x. LogItem r -> Rep (LogItem r) x
$cto :: forall r x. Rep (LogItem r) x -> LogItem r
to :: forall x. Rep (LogItem r) x -> LogItem r
Generic, LogItem r -> ()
(LogItem r -> ()) -> NFData (LogItem r)
forall r. NFData r => LogItem r -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall r. NFData r => LogItem r -> ()
rnf :: LogItem r -> ()
NFData)

-- | Logs the evolution of a 'PWord' as various actions are applied to

-- it. The actions (usually 'Statement's) are of type @r@.

data PWordLog r = PWordLog
    { forall r. PWordLog r -> PWord
initialWord :: PWord
    -- ^ The initial word, before any actions have been applied

    , forall r. PWordLog r -> [(Maybe PWord, r)]
derivations :: [(Maybe PWord, r)]
    -- ^ The state of the word after each action @r@, stored alongside

    -- the action which was applied at each point

    } deriving (Int -> PWordLog r -> ShowS
[PWordLog r] -> ShowS
PWordLog r -> String
(Int -> PWordLog r -> ShowS)
-> (PWordLog r -> String)
-> ([PWordLog r] -> ShowS)
-> Show (PWordLog r)
forall r. Show r => Int -> PWordLog r -> ShowS
forall r. Show r => [PWordLog r] -> ShowS
forall r. Show r => PWordLog r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall r. Show r => Int -> PWordLog r -> ShowS
showsPrec :: Int -> PWordLog r -> ShowS
$cshow :: forall r. Show r => PWordLog r -> String
show :: PWordLog r -> String
$cshowList :: forall r. Show r => [PWordLog r] -> ShowS
showList :: [PWordLog r] -> ShowS
Show, (forall a b. (a -> b) -> PWordLog a -> PWordLog b)
-> (forall a b. a -> PWordLog b -> PWordLog a) -> Functor PWordLog
forall a b. a -> PWordLog b -> PWordLog a
forall a b. (a -> b) -> PWordLog a -> PWordLog 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) -> PWordLog a -> PWordLog b
fmap :: forall a b. (a -> b) -> PWordLog a -> PWordLog b
$c<$ :: forall a b. a -> PWordLog b -> PWordLog a
<$ :: forall a b. a -> PWordLog b -> PWordLog a
Functor, (forall x. PWordLog r -> Rep (PWordLog r) x)
-> (forall x. Rep (PWordLog r) x -> PWordLog r)
-> Generic (PWordLog r)
forall x. Rep (PWordLog r) x -> PWordLog r
forall x. PWordLog r -> Rep (PWordLog r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall r x. Rep (PWordLog r) x -> PWordLog r
forall r x. PWordLog r -> Rep (PWordLog r) x
$cfrom :: forall r x. PWordLog r -> Rep (PWordLog r) x
from :: forall x. PWordLog r -> Rep (PWordLog r) x
$cto :: forall r x. Rep (PWordLog r) x -> PWordLog r
to :: forall x. Rep (PWordLog r) x -> PWordLog r
Generic, PWordLog r -> ()
(PWordLog r -> ()) -> NFData (PWordLog r)
forall r. NFData r => PWordLog r -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall r. NFData r => PWordLog r -> ()
rnf :: PWordLog r -> ()
NFData)

toPWordLog :: [LogItem r] -> Maybe (PWordLog r)
toPWordLog :: forall r. [LogItem r] -> Maybe (PWordLog r)
toPWordLog [] = Maybe (PWordLog r)
forall a. Maybe a
Nothing
toPWordLog ls :: [LogItem r]
ls@(LogItem r
l : [LogItem r]
_) = PWordLog r -> Maybe (PWordLog r)
forall a. a -> Maybe a
Just (PWordLog r -> Maybe (PWordLog r))
-> PWordLog r -> Maybe (PWordLog r)
forall a b. (a -> b) -> a -> b
$ PWordLog
    { initialWord :: PWord
initialWord = LogItem r -> PWord
forall r. LogItem r -> PWord
input LogItem r
l
    , derivations :: [(Maybe PWord, r)]
derivations = (\ActionApplied{r
PWord
Maybe PWord
action :: forall r. LogItem r -> r
input :: forall r. LogItem r -> PWord
output :: forall r. LogItem r -> Maybe PWord
action :: r
input :: PWord
output :: Maybe PWord
..} -> (Maybe PWord
output, r
action)) (LogItem r -> (Maybe PWord, r))
-> [LogItem r] -> [(Maybe PWord, r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LogItem r]
ls
    }

-- | Render a single 'PWordLog' to rows of an HTML table. For

-- instance, the example log given in the documentation for

-- 'reportAsText' would be converted to the following HTML:

--

-- > "<tr><td>tara</td><td>&rarr;</td><td>tazha</td><td>(r / zh)</td></tr><tr><td></td><td>&rarr;</td><td>tazh</td><td>(V / / _ #)</td></tr>"

--

-- Which might be displayed in an HTML table as something like the

-- following:

--

-- +------+---+-------+-------------+ 

-- | tara | → | tazha | (r / zh)    |

-- +------+---+-------+-------------+ 

-- |      | → | tazh  | (V / / _ #) |

-- +------+---+-------+-------------+ 


reportAsHtmlRows :: (r -> String) -> PWordLog r -> String
reportAsHtmlRows :: forall r. (r -> String) -> PWordLog r -> String
reportAsHtmlRows r -> String
render PWordLog r
item = String -> [(Maybe PWord, r)] -> String
go (PWord -> String
concatWithBoundary (PWord -> String) -> PWord -> String
forall a b. (a -> b) -> a -> b
$ PWordLog r -> PWord
forall r. PWordLog r -> PWord
initialWord PWordLog r
item) (PWordLog r -> [(Maybe PWord, r)]
forall r. PWordLog r -> [(Maybe PWord, r)]
derivations PWordLog r
item)
  where
    go :: String -> [(Maybe PWord, r)] -> String
go String
_ [] = String
""
    go String
cell1 ((Maybe PWord
output, r
action) : [(Maybe PWord, r)]
ds) =
        (String
"<tr><td>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cell1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</td><td>&rarr;</td><td>"
         String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (PWord -> String) -> Maybe PWord -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"<i>deleted</i>" PWord -> String
concatWithBoundary Maybe PWord
output
         String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</td><td>(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ r -> String
render r
action String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")</td></tr>")
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [(Maybe PWord, r)] -> String
go String
"" [(Maybe PWord, r)]
ds

-- | Render a single 'PWordLog' to plain text. For instance, this log:

--

-- > PWordLog

-- >   { initialWord = ["t", "a", "r", "a"]

-- >   , derivations =

-- >     [ (["t", "a", "zh", "a"], "r / zh")

-- >     , (["t", "a", "zh"], "V / / _ #")

-- >     ]

-- >   }

--

-- Would render as:

--

-- > tara

-- >   -> tazha  (r / zh)

-- >   -> tazh   (V / / _ #)

reportAsText :: (r -> String) -> PWordLog r -> String
reportAsText :: forall r. (r -> String) -> PWordLog r -> String
reportAsText r -> String
render PWordLog r
item = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    PWord -> String
concatWithBoundary (PWordLog r -> PWord
forall r. PWordLog r -> PWord
initialWord PWordLog r
item) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String, r) -> String) -> [(String, r)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, r) -> String
toLine ([(Maybe PWord, r)] -> [(String, r)]
forall b. [(Maybe PWord, b)] -> [(String, b)]
alignWithPadding ([(Maybe PWord, r)] -> [(String, r)])
-> [(Maybe PWord, r)] -> [(String, r)]
forall a b. (a -> b) -> a -> b
$ PWordLog r -> [(Maybe PWord, r)]
forall r. PWordLog r -> [(Maybe PWord, r)]
derivations PWordLog r
item)
  where
    alignWithPadding :: [(Maybe PWord, b)] -> [([Char], b)]
    alignWithPadding :: forall b. [(Maybe PWord, b)] -> [(String, b)]
alignWithPadding [(Maybe PWord, b)]
ds =
        let ([Maybe PWord]
rawOutputs, [b]
actions) = [(Maybe PWord, b)] -> ([Maybe PWord], [b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Maybe PWord, b)]
ds
            outputs :: [String]
outputs = String -> (PWord -> String) -> Maybe PWord -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"(deleted)" PWord -> String
concatWithBoundary (Maybe PWord -> String) -> [Maybe PWord] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe PWord]
rawOutputs
            maxlen :: Int
maxlen = [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
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> [String] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
outputs
            padded :: [String]
padded = [String]
outputs [String] -> ShowS -> [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
o -> String
o String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
maxlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
o) Char
' '
        in [String] -> [b] -> [(String, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
padded [b]
actions

    toLine :: (String, r) -> String
toLine (String
output, r
action) = String
"  -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
output String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"  (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ r -> String
render r
action String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- | Apply a single 'Statement' to a word. Returns a 'LogItem' for

-- each possible result, or @[]@ if the rule does not apply and the

-- input is returned unmodified.

applyStatementWithLog
    :: Statement Expanded [Grapheme]
    -> PWord
    -> [LogItem (Statement Expanded [Grapheme])]
applyStatementWithLog :: Statement Expanded PWord
-> PWord -> [LogItem (Statement Expanded PWord)]
applyStatementWithLog Statement Expanded PWord
st PWord
w = case Statement Expanded PWord -> PWord -> [PWord]
applyStatementStr Statement Expanded PWord
st PWord
w of
    [] -> [Statement Expanded PWord
-> PWord -> Maybe PWord -> LogItem (Statement Expanded PWord)
forall r. r -> PWord -> Maybe PWord -> LogItem r
ActionApplied Statement Expanded PWord
st PWord
w Maybe PWord
forall a. Maybe a
Nothing]
    [PWord
w'] | PWord
w' PWord -> PWord -> Bool
forall a. Eq a => a -> a -> Bool
== PWord
w -> []
    [PWord]
r -> Statement Expanded PWord
-> PWord -> Maybe PWord -> LogItem (Statement Expanded PWord)
forall r. r -> PWord -> Maybe PWord -> LogItem r
ActionApplied Statement Expanded PWord
st PWord
w (Maybe PWord -> LogItem (Statement Expanded PWord))
-> (PWord -> Maybe PWord)
-> PWord
-> LogItem (Statement Expanded PWord)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PWord -> Maybe PWord
forall a. a -> Maybe a
Just (PWord -> LogItem (Statement Expanded PWord))
-> [PWord] -> [LogItem (Statement Expanded PWord)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PWord]
r

-- | Apply 'SoundChanges' to a word. For each possible result, returns

-- a 'LogItem' for each 'Statement' which altered the input.

applyChangesWithLog
    :: SoundChanges Expanded [Grapheme]
    -> PWord
    -> [[LogItem (Statement Expanded [Grapheme])]]
applyChangesWithLog :: SoundChanges Expanded PWord
-> PWord -> [[LogItem (Statement Expanded PWord)]]
applyChangesWithLog [] PWord
_ = [[]]
applyChangesWithLog (Statement Expanded PWord
st:SoundChanges Expanded PWord
sts) PWord
w =
    case Statement Expanded PWord
-> PWord -> [LogItem (Statement Expanded PWord)]
applyStatementWithLog Statement Expanded PWord
st PWord
w of
        [] -> SoundChanges Expanded PWord
-> PWord -> [[LogItem (Statement Expanded PWord)]]
applyChangesWithLog SoundChanges Expanded PWord
sts PWord
w
        [LogItem (Statement Expanded PWord)]
outputActions -> [LogItem (Statement Expanded PWord)]
outputActions [LogItem (Statement Expanded PWord)]
-> (LogItem (Statement Expanded PWord)
    -> [[LogItem (Statement Expanded PWord)]])
-> [[LogItem (Statement Expanded PWord)]]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \l :: LogItem (Statement Expanded PWord)
l@ActionApplied{Maybe PWord
output :: forall r. LogItem r -> Maybe PWord
output :: Maybe PWord
output} ->
            case Maybe PWord
output of
                Just PWord
w' -> (LogItem (Statement Expanded PWord)
l LogItem (Statement Expanded PWord)
-> [LogItem (Statement Expanded PWord)]
-> [LogItem (Statement Expanded PWord)]
forall a. a -> [a] -> [a]
:) ([LogItem (Statement Expanded PWord)]
 -> [LogItem (Statement Expanded PWord)])
-> [[LogItem (Statement Expanded PWord)]]
-> [[LogItem (Statement Expanded PWord)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SoundChanges Expanded PWord
-> PWord -> [[LogItem (Statement Expanded PWord)]]
applyChangesWithLog SoundChanges Expanded PWord
sts PWord
w'
                -- apply no further changes to a deleted word

                Maybe PWord
Nothing -> [[LogItem (Statement Expanded PWord)
l]]

-- | Apply 'SoundChanges' to a word, returning an 'PWordLog'

-- for each possible result.

applyChangesWithLogs
    :: SoundChanges Expanded [Grapheme]
    -> PWord
    -> [PWordLog (Statement Expanded [Grapheme])]
applyChangesWithLogs :: SoundChanges Expanded PWord
-> PWord -> [PWordLog (Statement Expanded PWord)]
applyChangesWithLogs SoundChanges Expanded PWord
scs PWord
w = ([LogItem (Statement Expanded PWord)]
 -> Maybe (PWordLog (Statement Expanded PWord)))
-> [[LogItem (Statement Expanded PWord)]]
-> [PWordLog (Statement Expanded PWord)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [LogItem (Statement Expanded PWord)]
-> Maybe (PWordLog (Statement Expanded PWord))
forall r. [LogItem r] -> Maybe (PWordLog r)
toPWordLog ([[LogItem (Statement Expanded PWord)]]
 -> [PWordLog (Statement Expanded PWord)])
-> [[LogItem (Statement Expanded PWord)]]
-> [PWordLog (Statement Expanded PWord)]
forall a b. (a -> b) -> a -> b
$ SoundChanges Expanded PWord
-> PWord -> [[LogItem (Statement Expanded PWord)]]
applyChangesWithLog  SoundChanges Expanded PWord
scs PWord
w

-- | Apply a set of 'SoundChanges' to a word.

applyChanges :: SoundChanges Expanded [Grapheme] -> PWord -> [PWord]
applyChanges :: SoundChanges Expanded PWord -> PWord -> [PWord]
applyChanges SoundChanges Expanded PWord
sts PWord
w =
    ([LogItem (Statement Expanded PWord)] -> Maybe PWord)
-> [[LogItem (Statement Expanded PWord)]] -> [PWord]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [LogItem (Statement Expanded PWord)] -> Maybe PWord
lastOutput ([[LogItem (Statement Expanded PWord)]] -> [PWord])
-> [[LogItem (Statement Expanded PWord)]] -> [PWord]
forall a b. (a -> b) -> a -> b
$ SoundChanges Expanded PWord
-> PWord -> [[LogItem (Statement Expanded PWord)]]
applyChangesWithLog SoundChanges Expanded PWord
sts PWord
w
  where
    -- If no changes were applied, output is same as input

    lastOutput :: [LogItem (Statement Expanded PWord)] -> Maybe PWord
lastOutput [] = PWord -> Maybe PWord
forall a. a -> Maybe a
Just PWord
w
    lastOutput [LogItem (Statement Expanded PWord)]
ls = LogItem (Statement Expanded PWord) -> Maybe PWord
forall r. LogItem r -> Maybe PWord
output (LogItem (Statement Expanded PWord) -> Maybe PWord)
-> LogItem (Statement Expanded PWord) -> Maybe PWord
forall a b. (a -> b) -> a -> b
$ [LogItem (Statement Expanded PWord)]
-> LogItem (Statement Expanded PWord)
forall a. HasCallStack => [a] -> a
last [LogItem (Statement Expanded PWord)]
ls

-- | Apply 'SoundChanges' to a word returning the final results, as

-- well as a boolean value indicating whether the word should be

-- highlighted in a UI due to changes from its initial value. (Note

-- that this accounts for 'highlightChanges' values.)

applyChangesWithChanges :: SoundChanges Expanded [Grapheme] -> PWord -> [(Maybe PWord, Bool)]
applyChangesWithChanges :: SoundChanges Expanded PWord -> PWord -> [(Maybe PWord, Bool)]
applyChangesWithChanges SoundChanges Expanded PWord
sts PWord
w = SoundChanges Expanded PWord
-> PWord -> [[LogItem (Statement Expanded PWord)]]
applyChangesWithLog SoundChanges Expanded PWord
sts PWord
w [[LogItem (Statement Expanded PWord)]]
-> ([LogItem (Statement Expanded PWord)] -> (Maybe PWord, Bool))
-> [(Maybe PWord, Bool)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    [] -> (PWord -> Maybe PWord
forall a. a -> Maybe a
Just PWord
w, Bool
False)
    [LogItem (Statement Expanded PWord)]
logs -> (LogItem (Statement Expanded PWord) -> Maybe PWord
forall r. LogItem r -> Maybe PWord
output (LogItem (Statement Expanded PWord) -> Maybe PWord)
-> LogItem (Statement Expanded PWord) -> Maybe PWord
forall a b. (a -> b) -> a -> b
$ [LogItem (Statement Expanded PWord)]
-> LogItem (Statement Expanded PWord)
forall a. HasCallStack => [a] -> a
last [LogItem (Statement Expanded PWord)]
logs, [LogItem (Statement Expanded PWord)] -> Bool
forall {c :: LexemeType -> *} {decl}.
[LogItem (Statement c decl)] -> Bool
hasChanged [LogItem (Statement Expanded PWord)]
logs)
  where
    hasChanged :: [LogItem (Statement c decl)] -> Bool
hasChanged = (LogItem (Statement c decl) -> Bool)
-> [LogItem (Statement c decl)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((LogItem (Statement c decl) -> Bool)
 -> [LogItem (Statement c decl)] -> Bool)
-> (LogItem (Statement c decl) -> Bool)
-> [LogItem (Statement c decl)]
-> Bool
forall a b. (a -> b) -> a -> b
$ \case
        ActionApplied (RuleS Rule c
rule) PWord
_ Maybe PWord
_ -> Flags -> Bool
highlightChanges (Flags -> Bool) -> Flags -> Bool
forall a b. (a -> b) -> a -> b
$ Rule c -> Flags
forall (c :: LexemeType -> *). Rule c -> Flags
flags Rule c
rule
        ActionApplied (FilterS Filter c
_) PWord
_ Maybe PWord
_ -> Bool
False  -- cannot highlight nonexistent word

        ActionApplied (DirectiveS decl
_) PWord
_ Maybe PWord
_ -> Bool
True