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

-- |

-- Module      : Brassica.SoundChange.Apply.Internal

-- Copyright   : See LICENSE file

-- License     : BSD3

-- Maintainer  : Brad Neimann

--

-- __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.

--

-- This module contains the lower-level functions used by Brassica to

-- match and apply sound changes. The overall algorithm is similar to

-- that described by [Howard (1973)](https://dspace.mit.edu/bitstream/handle/1721.1/12982/26083289-MIT.pdf?sequence=2).

--

-- Some essential points:

--

--     * Words are represented as 'MultiZipper's, with a cursor index

--       and zero or more tagged indices. A sound change can then be

--       applied ('applyRuleMZ') by advancing through the word from

--       left to right. (Right-to-left application is achieved by

--       reversing both word and rule.)

--

--     * For each potential application site, 'applyOnce' checks the

--       target, environments and exceptions. If they are all

--       satisfied, it then replaces the target graphemes with the

--       replacement graphemes. After running 'applyOnce',

--       'setupForNextApplication' can be used to advance to the next

--       application site.

--

--     * The lowest-level function for matching is 'match', which

--       matches an individual 'Lexeme' at some point in a word. The

--       lowest-level function for replacement is 'mkReplacement',

--       which constructs replacement graphemes.

module Brassica.SoundChange.Apply.Internal
       (
       -- * Lexeme matching

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

       , applyOnce
       , setupForNextApplication
       , applyRuleMZ
       , checkGraphemes
       , applyStatementMZ
       , applyRuleStr
       , applyStatementStr
       -- * Logging

       , LogItem(..)
       , Log(..)
       , reportAsHtmlRows
       , reportAsText
       , applyStatement
       , applyChanges
       , getOutput
       , getReports
       , getChangedOutputs
       , getChangedReports
       ) 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.List (elemIndex)
import Data.Maybe (maybeToList, fromMaybe, listToMaybe, mapMaybe)
import GHC.Generics (Generic)

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

import qualified Data.Map.Strict as Map

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

    | PrevEnd
    -- ^ The end of the replacement from the last rule application

    -- (used to avoid infinite loops from iterative rules)

    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 -> Grapheme
(Int -> RuleTag -> ShowS)
-> (RuleTag -> Grapheme) -> ([RuleTag] -> ShowS) -> Show RuleTag
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuleTag -> ShowS
showsPrec :: Int -> RuleTag -> ShowS
$cshow :: RuleTag -> Grapheme
show :: RuleTag -> Grapheme
$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. Grapheme -> RuleAp a) -> MonadFail RuleAp
forall a. Grapheme -> RuleAp a
forall (m :: * -> *).
Monad m -> (forall a. Grapheme -> m a) -> MonadFail m
$cfail :: forall a. Grapheme -> RuleAp a
fail :: forall a. Grapheme -> 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

-- | The result of matching a 'Feature' or 'Autosegment': either a

-- specific index in the 'Feature', or an indeterminate result (when

-- no indices matched)

data FeatureState = Index Int | Indeterminate
    deriving (Int -> FeatureState -> ShowS
[FeatureState] -> ShowS
FeatureState -> Grapheme
(Int -> FeatureState -> ShowS)
-> (FeatureState -> Grapheme)
-> ([FeatureState] -> ShowS)
-> Show FeatureState
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FeatureState -> ShowS
showsPrec :: Int -> FeatureState -> ShowS
$cshow :: FeatureState -> Grapheme
show :: FeatureState -> Grapheme
$cshowList :: [FeatureState] -> ShowS
showList :: [FeatureState] -> ShowS
Show, FeatureState -> FeatureState -> Bool
(FeatureState -> FeatureState -> Bool)
-> (FeatureState -> FeatureState -> Bool) -> Eq FeatureState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FeatureState -> FeatureState -> Bool
== :: FeatureState -> FeatureState -> Bool
$c/= :: FeatureState -> FeatureState -> Bool
/= :: FeatureState -> FeatureState -> Bool
Eq)

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

data MatchOutput = MatchOutput
    { -- | For each non-backreferenced 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 repetitions it matched

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

    , MatchOutput -> PWord
matchedGraphemes :: [Grapheme]
      -- | The features which were matched, by name

    , MatchOutput -> Map Grapheme [FeatureState]
matchedFeatures :: Map.Map String [FeatureState]
      -- | Backreferenced categories which were matched, by ID

    , MatchOutput -> Map Grapheme Int
matchedBackrefIds :: Map.Map String Int
      -- | Backreferenced features which were matched, by ID

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

-- | Create 'MatchOutput' for next section of rule given last output

-- (preserving backreferences but emptying all other fields)

newOutput :: MatchOutput -> MatchOutput
newOutput :: MatchOutput -> MatchOutput
newOutput MatchOutput
m = MatchOutput
    { matchedCatIxs :: [Int]
matchedCatIxs = []
    , matchedOptionals :: [Bool]
matchedOptionals = []
    , matchedWildcards :: [PWord]
matchedWildcards = []
    , matchedKleenes :: [Int]
matchedKleenes = []
    , matchedGraphemes :: PWord
matchedGraphemes = []
    , matchedFeatures :: Map Grapheme [FeatureState]
matchedFeatures = Map Grapheme [FeatureState]
forall k a. Map k a
Map.empty
    , matchedBackrefIds :: Map Grapheme Int
matchedBackrefIds = MatchOutput -> Map Grapheme Int
matchedBackrefIds MatchOutput
m
    , matchedFeatureIds :: Map Grapheme FeatureState
matchedFeatureIds = MatchOutput -> Map Grapheme FeatureState
matchedFeatureIds MatchOutput
m
    }

-- | The empty 'MatchOutput'

initialOutput :: MatchOutput
initialOutput :: MatchOutput
initialOutput = [Int]
-> [Bool]
-> [PWord]
-> [Int]
-> PWord
-> Map Grapheme [FeatureState]
-> Map Grapheme Int
-> Map Grapheme FeatureState
-> MatchOutput
MatchOutput [] [] [] [] [] Map Grapheme [FeatureState]
forall k a. Map k a
Map.empty Map Grapheme Int
forall k a. Map k a
Map.empty Map Grapheme FeatureState
forall k a. Map k a
Map.empty

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

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


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)

insertAtOptional :: Int -> Bool -> MatchOutput -> MatchOutput
insertAtOptional :: Int -> Bool -> MatchOutput -> MatchOutput
insertAtOptional Int
n Bool
o MatchOutput
mz = MatchOutput
mz { matchedOptionals :: [Bool]
matchedOptionals = Int -> Bool -> [Bool] -> [Bool]
forall a. Int -> a -> [a] -> [a]
insertAt Int
n Bool
o ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ MatchOutput -> [Bool]
matchedOptionals MatchOutput
mz }

insertAtCat :: Int -> Int -> MatchOutput -> MatchOutput
insertAtCat :: Int -> Int -> MatchOutput -> MatchOutput
insertAtCat Int
n Int
i MatchOutput
mz = MatchOutput
mz { matchedCatIxs :: [Int]
matchedCatIxs = Int -> Int -> [Int] -> [Int]
forall a. Int -> a -> [a] -> [a]
insertAt Int
n Int
i ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ MatchOutput -> [Int]
matchedCatIxs MatchOutput
mz }

insertAtKleene :: Int -> Int -> MatchOutput -> MatchOutput
insertAtKleene :: Int -> Int -> MatchOutput -> MatchOutput
insertAtKleene Int
n Int
i MatchOutput
mz = MatchOutput
mz { matchedKleenes :: [Int]
matchedKleenes = Int -> Int -> [Int] -> [Int]
forall a. Int -> a -> [a] -> [a]
insertAt Int
n Int
i ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ MatchOutput -> [Int]
matchedKleenes MatchOutput
mz }

appendFeatureAt :: Int -> String -> FeatureState -> MatchOutput -> MatchOutput
appendFeatureAt :: Int -> Grapheme -> FeatureState -> MatchOutput -> MatchOutput
appendFeatureAt Int
n Grapheme
name FeatureState
fs MatchOutput
out = MatchOutput
out { matchedFeatures :: Map Grapheme [FeatureState]
matchedFeatures = (Maybe [FeatureState] -> Maybe [FeatureState])
-> Grapheme
-> Map Grapheme [FeatureState]
-> Map Grapheme [FeatureState]
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe [FeatureState] -> Maybe [FeatureState]
go Grapheme
name (Map Grapheme [FeatureState] -> Map Grapheme [FeatureState])
-> Map Grapheme [FeatureState] -> Map Grapheme [FeatureState]
forall a b. (a -> b) -> a -> b
$ MatchOutput -> Map Grapheme [FeatureState]
matchedFeatures MatchOutput
out }
  where
    go :: Maybe [FeatureState] -> Maybe [FeatureState]
go Maybe [FeatureState]
Nothing = [FeatureState] -> Maybe [FeatureState]
forall a. a -> Maybe a
Just [FeatureState
fs]
    go (Just [FeatureState]
fss) = [FeatureState] -> Maybe [FeatureState]
forall a. a -> Maybe a
Just ([FeatureState] -> Maybe [FeatureState])
-> [FeatureState] -> Maybe [FeatureState]
forall a b. (a -> b) -> a -> b
$ Int -> FeatureState -> [FeatureState] -> [FeatureState]
forall a. Int -> a -> [a] -> [a]
insertAt Int
n FeatureState
fs [FeatureState]
fss

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

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

-- updated '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 =
    let i :: Int
i = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (MatchOutput -> [Bool]
matchedOptionals MatchOutput
out)
    in
        (Int -> Bool -> MatchOutput -> MatchOutput
insertAtOptional Int
i Bool
False MatchOutput
out, 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 (Int -> Bool -> MatchOutput -> MatchOutput
insertAtOptional Int
i Bool
True MatchOutput
out) Maybe Grapheme
prev [Lexeme Expanded 'Matched]
l MultiZipper t Grapheme
mz
match MatchOutput
out Maybe Grapheme
prev (GreedyOptional [Lexeme Expanded 'Matched]
l) MultiZipper t Grapheme
mz =
    let i :: Int
i = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (MatchOutput -> [Bool]
matchedOptionals MatchOutput
out)
        m :: [(MatchOutput, MultiZipper t Grapheme)]
m = 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 -> MatchOutput -> MatchOutput
insertAtOptional Int
i Bool
True MatchOutput
out) Maybe Grapheme
prev [Lexeme Expanded 'Matched]
l MultiZipper t Grapheme
mz
    in case [(MatchOutput, MultiZipper t Grapheme)]
m of
        -- skip, but only if no matches

        [] -> [(Int -> Bool -> MatchOutput -> MatchOutput
insertAtOptional Int
i Bool
False MatchOutput
out, MultiZipper t Grapheme
mz)]
        [(MatchOutput, MultiZipper t Grapheme)]
_ -> [(MatchOutput, MultiZipper t Grapheme)]
m
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 -> Grapheme -> MatchOutput
appendGrapheme MatchOutput
out 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 [[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
$ [[Lexeme Expanded 'Matched]]
-> [Int]
-> ([Lexeme Expanded 'Matched]
    -> Int -> [(MatchOutput, MultiZipper t Grapheme)])
-> [[(MatchOutput, MultiZipper t Grapheme)]]
forall a b c. [a] -> [b] -> (a -> b -> c) -> [c]
zipWith' [[Lexeme Expanded 'Matched]]
gs [Int
0..] (([Lexeme Expanded 'Matched]
  -> Int -> [(MatchOutput, MultiZipper t Grapheme)])
 -> [[(MatchOutput, MultiZipper t Grapheme)]])
-> ([Lexeme Expanded 'Matched]
    -> Int -> [(MatchOutput, MultiZipper t Grapheme)])
-> [[(MatchOutput, MultiZipper t Grapheme)]]
forall a b. (a -> b) -> a -> b
$ \[Lexeme Expanded 'Matched]
ls 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
<$>
            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 (GreedyCategory Expanded 'Matched
c) MultiZipper t Grapheme
mz =
    -- Take first match only

    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 (Expanded 'Matched -> Lexeme Expanded 'Matched
forall (category :: LexemeType -> *) (a :: LexemeType).
category a -> Lexeme category a
Category Expanded 'Matched
c) MultiZipper t Grapheme
mz of
        [] -> []
        ((MatchOutput, MultiZipper t Grapheme)
m:[(MatchOutput, MultiZipper t Grapheme)]
_) -> [(MatchOutput, MultiZipper t Grapheme)
m]
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 -> Grapheme -> MatchOutput
appendGrapheme MatchOutput
out 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 (Left Grapheme
ident) (FromElements [[Lexeme Expanded 'Matched]]
gs)) MultiZipper t Grapheme
mz
    | Maybe Int
Nothing <- Grapheme -> Map Grapheme Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Grapheme
ident (MatchOutput -> Map Grapheme Int
matchedBackrefIds MatchOutput
out) =
        -- first occurrence, set backref

        -- similar to Category case above

        [[(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
$ [[Lexeme Expanded 'Matched]]
-> [Int]
-> ([Lexeme Expanded 'Matched]
    -> Int -> [(MatchOutput, MultiZipper t Grapheme)])
-> [[(MatchOutput, MultiZipper t Grapheme)]]
forall a b c. [a] -> [b] -> (a -> b -> c) -> [c]
zipWith' [[Lexeme Expanded 'Matched]]
gs [Int
0..] (([Lexeme Expanded 'Matched]
  -> Int -> [(MatchOutput, MultiZipper t Grapheme)])
 -> [[(MatchOutput, MultiZipper t Grapheme)]])
-> ([Lexeme Expanded 'Matched]
    -> Int -> [(MatchOutput, MultiZipper t Grapheme)])
-> [[(MatchOutput, MultiZipper t Grapheme)]]
forall a b. (a -> b) -> a -> b
$ \[Lexeme Expanded 'Matched]
ls Int
i ->
            (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 (\MatchOutput
o -> MatchOutput
o { matchedBackrefIds :: Map Grapheme Int
matchedBackrefIds = Grapheme -> Int -> Map Grapheme Int -> Map Grapheme Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Grapheme
ident Int
i (Map Grapheme Int -> Map Grapheme Int)
-> Map Grapheme Int -> Map Grapheme Int
forall a b. (a -> b) -> a -> b
$ MatchOutput -> Map Grapheme Int
matchedBackrefIds MatchOutput
o })
                ((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
<$> 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 (Backreference Either Grapheme Int
i (FromElements [[Lexeme Expanded 'Matched]]
gs)) MultiZipper t Grapheme
mz = do
    [Lexeme Expanded 'Matched]
ls <- Maybe [Lexeme Expanded 'Matched] -> [[Lexeme Expanded 'Matched]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Lexeme Expanded 'Matched] -> [[Lexeme Expanded 'Matched]])
-> Maybe [Lexeme Expanded 'Matched] -> [[Lexeme Expanded 'Matched]]
forall a b. (a -> b) -> a -> b
$ case Either Grapheme Int
i of
        Left Grapheme
i' -> ([[Lexeme Expanded 'Matched]]
gs [[Lexeme Expanded 'Matched]]
-> Int -> Maybe [Lexeme Expanded 'Matched]
forall a. [a] -> Int -> Maybe a
!?) (Int -> Maybe [Lexeme Expanded 'Matched])
-> Maybe Int -> Maybe [Lexeme Expanded 'Matched]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Grapheme -> Map Grapheme Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Grapheme
i' (MatchOutput -> Map Grapheme Int
matchedBackrefIds MatchOutput
out)
        Right Int
i' -> ([[Lexeme Expanded 'Matched]]
gs [[Lexeme Expanded 'Matched]]
-> Int -> Maybe [Lexeme Expanded 'Matched]
forall a. [a] -> Int -> Maybe a
!?) (Int -> Maybe [Lexeme Expanded 'Matched])
-> Maybe Int -> Maybe [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
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    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 (Feature Bool
r Grapheme
_n (Just Grapheme
ident) [PWord]
kvs Lexeme Expanded 'Matched
l) MultiZipper t Grapheme
mz
    | Just FeatureState
fs <- Grapheme -> Map Grapheme FeatureState -> Maybe FeatureState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Grapheme
ident (MatchOutput -> Map Grapheme FeatureState
matchedFeatureIds MatchOutput
out) = do
        -- similar to next case, but just check that features are the same

        -- (NB. feature name is irrelevant for this)

        (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)]
match MatchOutput
out Maybe Grapheme
prev Lexeme Expanded 'Matched
l MultiZipper t Grapheme
mz
        let fs' :: FeatureState
fs' = case MatchOutput -> PWord
matchedGraphemes MatchOutput
out' of
                PWord
gs | Just Grapheme
g <- PWord -> Maybe Grapheme
forall a. [a] -> Maybe a
lastMay PWord
gs -> [PWord] -> Grapheme -> FeatureState
forall a. Eq a => [[a]] -> a -> FeatureState
checkFeature [PWord]
kvs Grapheme
g
                PWord
_ -> FeatureState
Indeterminate
            satisfied :: Bool
satisfied = case (FeatureState
fs, FeatureState
fs') of
                (FeatureState
Indeterminate, FeatureState
_) -> Bool
True
                (FeatureState
_, FeatureState
Indeterminate) -> Bool
True
                (FeatureState, FeatureState)
_  ->
                    if Bool
r
                    then FeatureState
fs FeatureState -> FeatureState -> Bool
forall a. Eq a => a -> a -> Bool
/= FeatureState
fs'  -- reverse comparison

                    else FeatureState
fs FeatureState -> FeatureState -> Bool
forall a. Eq a => a -> a -> Bool
== FeatureState
fs'
        if Bool
satisfied
            then (MatchOutput, MultiZipper t Grapheme)
-> [(MatchOutput, MultiZipper t Grapheme)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MatchOutput
out', MultiZipper t Grapheme
mz')
            else []
match MatchOutput
out Maybe Grapheme
prev (Feature Bool
_r Grapheme
n Maybe Grapheme
ident [PWord]
kvs Lexeme Expanded 'Matched
l) MultiZipper t Grapheme
mz = do
    let i :: Int
i = Int -> ([FeatureState] -> Int) -> Maybe [FeatureState] -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 [FeatureState] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Maybe [FeatureState] -> Int) -> Maybe [FeatureState] -> Int
forall a b. (a -> b) -> a -> b
$ Grapheme -> Map Grapheme [FeatureState] -> Maybe [FeatureState]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Grapheme
n (MatchOutput -> Map Grapheme [FeatureState]
matchedFeatures MatchOutput
out)
    (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)]
match MatchOutput
out Maybe Grapheme
prev Lexeme Expanded 'Matched
l MultiZipper t Grapheme
mz
    let fs :: FeatureState
fs = case MatchOutput -> PWord
matchedGraphemes MatchOutput
out' of
            PWord
gs | Just Grapheme
g <- PWord -> Maybe Grapheme
forall a. [a] -> Maybe a
lastMay PWord
gs -> [PWord] -> Grapheme -> FeatureState
forall a. Eq a => [[a]] -> a -> FeatureState
checkFeature [PWord]
kvs Grapheme
g
            PWord
_ -> FeatureState
Indeterminate
    (MatchOutput, MultiZipper t Grapheme)
-> [(MatchOutput, MultiZipper t Grapheme)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((MatchOutput, MultiZipper t Grapheme)
 -> [(MatchOutput, MultiZipper t Grapheme)])
-> (MatchOutput, MultiZipper t Grapheme)
-> [(MatchOutput, MultiZipper t Grapheme)]
forall a b. (a -> b) -> a -> b
$ case Maybe Grapheme
ident of
        Maybe Grapheme
Nothing -> (Int -> Grapheme -> FeatureState -> MatchOutput -> MatchOutput
appendFeatureAt Int
i Grapheme
n FeatureState
fs MatchOutput
out', MultiZipper t Grapheme
mz')
        Just Grapheme
ident' ->
            ( MatchOutput
out' { matchedFeatureIds :: Map Grapheme FeatureState
matchedFeatureIds = Grapheme
-> FeatureState
-> Map Grapheme FeatureState
-> Map Grapheme FeatureState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Grapheme
ident' FeatureState
fs (Map Grapheme FeatureState -> Map Grapheme FeatureState)
-> Map Grapheme FeatureState -> Map Grapheme FeatureState
forall a b. (a -> b) -> a -> b
$ MatchOutput -> Map Grapheme FeatureState
matchedFeatureIds MatchOutput
out' }
            , MultiZipper t Grapheme
mz'
            )
match MatchOutput
out Maybe Grapheme
prev (Autosegment Grapheme
n [[(Grapheme, Bool)]]
kvs PWord
gs) MultiZipper t Grapheme
mz =
    -- act as 'Category' + 'Feature', without capture

    -- and accounting for unmatchable values

    PWord
gs PWord
-> (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
>>= \Grapheme
g -> do
        let i :: Int
i = Int -> ([FeatureState] -> Int) -> Maybe [FeatureState] -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 [FeatureState] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Maybe [FeatureState] -> Int) -> Maybe [FeatureState] -> Int
forall a b. (a -> b) -> a -> b
$ Grapheme -> Map Grapheme [FeatureState] -> Maybe [FeatureState]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Grapheme
n (MatchOutput -> Map Grapheme [FeatureState]
matchedFeatures MatchOutput
out)
        (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)]
match MatchOutput
out Maybe Grapheme
prev (Grapheme -> Lexeme Expanded 'Matched
forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> Lexeme category a
Grapheme Grapheme
g) MultiZipper t Grapheme
mz
        let fs :: FeatureState
fs = [[(Grapheme, Bool)]] -> (Grapheme, Bool) -> FeatureState
forall a. Eq a => [[a]] -> a -> FeatureState
checkFeature [[(Grapheme, Bool)]]
kvs (Grapheme
g, Bool
True)
        (MatchOutput, MultiZipper t Grapheme)
-> [(MatchOutput, MultiZipper t Grapheme)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Grapheme -> FeatureState -> MatchOutput -> MatchOutput
appendFeatureAt Int
i Grapheme
n FeatureState
fs MatchOutput
out', MultiZipper t Grapheme
mz')

checkFeature :: Eq a => [[a]] -> a -> FeatureState
checkFeature :: forall a. Eq a => [[a]] -> a -> FeatureState
checkFeature [] a
_ = FeatureState
Indeterminate
checkFeature ([a]
gs:[[a]]
gss) a
x
    | Just Int
i <- a
x a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [a]
gs = Int -> FeatureState
Index Int
i
    | Bool
otherwise = [[a]] -> a -> FeatureState
forall a. Eq a => [[a]] -> a -> FeatureState
checkFeature [[a]]
gss a
x

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
"#", 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 :: [PWord]
matchedWildcards = MatchOutput -> [PWord]
matchedWildcards MatchOutput
out' [PWord] -> [PWord] -> [PWord]
forall a. [a] -> [a] -> [a]
++ [PWord -> PWord
forall a. [a] -> [a]
reverse PWord
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 as with 'match'.

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'

-- 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 -> Map Grapheme Int
ixInFeatures :: Map.Map String Int
    , ReplacementIndices -> Maybe CategoryNumber
forcedCategory :: Maybe CategoryNumber
    } deriving (Int -> ReplacementIndices -> ShowS
[ReplacementIndices] -> ShowS
ReplacementIndices -> Grapheme
(Int -> ReplacementIndices -> ShowS)
-> (ReplacementIndices -> Grapheme)
-> ([ReplacementIndices] -> ShowS)
-> Show ReplacementIndices
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReplacementIndices -> ShowS
showsPrec :: Int -> ReplacementIndices -> ShowS
$cshow :: ReplacementIndices -> Grapheme
show :: ReplacementIndices -> Grapheme
$cshowList :: [ReplacementIndices] -> ShowS
showList :: [ReplacementIndices] -> ShowS
Show)

data CategoryNumber = CategoryNumber Int | CategoryId String | Nondeterministic
    deriving (Int -> CategoryNumber -> ShowS
[CategoryNumber] -> ShowS
CategoryNumber -> Grapheme
(Int -> CategoryNumber -> ShowS)
-> (CategoryNumber -> Grapheme)
-> ([CategoryNumber] -> ShowS)
-> Show CategoryNumber
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CategoryNumber -> ShowS
showsPrec :: Int -> CategoryNumber -> ShowS
$cshow :: CategoryNumber -> Grapheme
show :: CategoryNumber -> Grapheme
$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 :: Maybe CategoryNumber
forcedCategory = Maybe CategoryNumber
forall a. Maybe a
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 :: Int
ixInCategories = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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 :: Int
ixInOptionals = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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 :: Int
ixInWildcards = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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 :: Int
ixInKleenes = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 })

advanceFeature :: String -> ReplacementIndices -> Maybe (Int, ReplacementIndices)
advanceFeature :: Grapheme -> ReplacementIndices -> Maybe (Int, ReplacementIndices)
advanceFeature Grapheme
n ReplacementIndices
ix =
    case Grapheme -> Map Grapheme Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Grapheme
n (ReplacementIndices -> Map Grapheme Int
ixInFeatures ReplacementIndices
ix) of
        Maybe Int
Nothing -> (Int, ReplacementIndices) -> Maybe (Int, ReplacementIndices)
forall a. a -> Maybe a
Just (Int
0, ReplacementIndices
ix { ixInFeatures :: Map Grapheme Int
ixInFeatures = Grapheme -> Int -> Map Grapheme Int -> Map Grapheme Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Grapheme
n Int
1    (Map Grapheme Int -> Map Grapheme Int)
-> Map Grapheme Int -> Map Grapheme Int
forall a b. (a -> b) -> a -> b
$ ReplacementIndices -> Map Grapheme Int
ixInFeatures ReplacementIndices
ix })
        Just Int
i  -> (Int, ReplacementIndices) -> Maybe (Int, ReplacementIndices)
forall a. a -> Maybe a
Just (Int
i, ReplacementIndices
ix { ixInFeatures :: Map Grapheme Int
ixInFeatures = (Int -> Int) -> Grapheme -> Map Grapheme Int -> Map Grapheme Int
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Grapheme
n (Map Grapheme Int -> Map Grapheme Int)
-> Map Grapheme Int -> Map Grapheme Int
forall a b. (a -> b) -> a -> b
$ ReplacementIndices -> Map Grapheme Int
ixInFeatures ReplacementIndices
ix })

forceCategory :: CategoryNumber -> ReplacementIndices -> ReplacementIndices
forceCategory :: CategoryNumber -> ReplacementIndices -> ReplacementIndices
forceCategory CategoryNumber
i ReplacementIndices
ixs = ReplacementIndices
ixs { forcedCategory :: Maybe CategoryNumber
forcedCategory = CategoryNumber -> Maybe CategoryNumber
forall a. a -> Maybe a
Just CategoryNumber
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
-> Map Grapheme Int
-> Maybe CategoryNumber
-> ReplacementIndices
ReplacementIndices Int
0 Int
0 Int
0 Int
0 Map Grapheme Int
forall k a. Map k a
Map.empty 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 [[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 [Lexeme Expanded 'Replacement]
g' <- [[Lexeme Expanded 'Replacement]]
gs [[Lexeme Expanded 'Replacement]]
-> Int -> Maybe [Lexeme Expanded 'Replacement]
forall a. [a] -> Int -> Maybe a
!? Int
i ->
                        case [Lexeme Expanded 'Replacement]
g' of
                            [Grapheme 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))]
                            [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 Grapheme
"\xfffd" MultiZipper t Grapheme
mz, Maybe Grapheme
forall a. Maybe a
Nothing))]  -- Unicode replacement character

            (CategoryId Grapheme
ci, ReplacementIndices
ixs') ->  -- as above

                case Grapheme -> Map Grapheme Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Grapheme
ci (MatchOutput -> Map Grapheme Int
matchedBackrefIds MatchOutput
out) of
                    Just Int
i | Just [Lexeme Expanded 'Replacement]
g' <- [[Lexeme Expanded 'Replacement]]
gs [[Lexeme Expanded 'Replacement]]
-> Int -> Maybe [Lexeme Expanded 'Replacement]
forall a. [a] -> Int -> Maybe a
!? Int
i ->
                        case [Lexeme Expanded 'Replacement]
g' of
                            [Grapheme 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))]
                            [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 Grapheme
"\xfffd" MultiZipper t Grapheme
mz, Maybe Grapheme
forall a. Maybe a
Nothing))]  -- Unicode replacement character

            (CategoryNumber
Nondeterministic, ReplacementIndices
ixs') -> [[Lexeme Expanded 'Replacement]]
gs [[Lexeme Expanded 'Replacement]]
-> ([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
                [Grapheme 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))]
                [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 (Left Grapheme
i) Expanded 'Replacement
c) MultiZipper t Grapheme
mz Maybe Grapheme
prev =
        let ixs' :: ReplacementIndices
ixs' = CategoryNumber -> ReplacementIndices -> ReplacementIndices
forceCategory (Grapheme -> CategoryNumber
CategoryId Grapheme
i) 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 (Backreference (Right 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))]
    replaceLex ReplacementIndices
ixs (Feature Bool
r Grapheme
n Maybe Grapheme
ident [PWord]
kvs Lexeme Expanded 'Replacement
l) MultiZipper t Grapheme
mz Maybe Grapheme
prev =
        let (FeatureState
fs, ReplacementIndices
ixs') = case Maybe Grapheme
ident of
                Maybe Grapheme
Nothing -> case Grapheme -> ReplacementIndices -> Maybe (Int, ReplacementIndices)
advanceFeature Grapheme
n ReplacementIndices
ixs of
                    Just (Int
i, ReplacementIndices
ixs_)
                        | Just [FeatureState]
fss <- Grapheme -> Map Grapheme [FeatureState] -> Maybe [FeatureState]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Grapheme
n (MatchOutput -> Map Grapheme [FeatureState]
matchedFeatures MatchOutput
out)
                        , Just FeatureState
fs_ <- [FeatureState]
fss [FeatureState] -> Int -> Maybe FeatureState
forall a. [a] -> Int -> Maybe a
!? Int
i
                        -> (FeatureState
fs_, ReplacementIndices
ixs_)
                    Maybe (Int, ReplacementIndices)
_ -> (FeatureState
Indeterminate, ReplacementIndices
ixs)
                Just Grapheme
ident' -> case Grapheme -> Map Grapheme FeatureState -> Maybe FeatureState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Grapheme
ident' (MatchOutput -> Map Grapheme FeatureState
matchedFeatureIds MatchOutput
out) of
                    Just FeatureState
fs_ -> (FeatureState
fs_, ReplacementIndices
ixs)
                    Maybe FeatureState
Nothing -> (FeatureState
Indeterminate, ReplacementIndices
ixs)
        in 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
            case ([PWord]
kvs, Maybe Grapheme
prev') of
                (PWord
gs:[PWord]
_, Just Grapheme
g) | Grapheme
g Grapheme -> Grapheme -> Bool
forall a. Eq a => a -> a -> Bool
/= Grapheme
"#" -> do
                    Grapheme
g' <- case FeatureState
fs of
                        Index Int
i -> [PWord] -> Grapheme -> Int -> Grapheme
applyFeature [PWord]
kvs Grapheme
g (Int -> Grapheme) -> [Int] -> PWord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                            if Bool
r
                            then (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
i) [Int
0 .. PWord -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length PWord
gs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                            else Int -> [Int]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
                        FeatureState
Indeterminate -> [PWord] -> Grapheme -> Int -> Grapheme
applyFeature [PWord]
kvs Grapheme
g (Int -> Grapheme) -> [Int] -> PWord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. PWord -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length PWord
gs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                    -- now overwrite previous grapheme

                    let mz'' :: MultiZipper t Grapheme
mz'' = (Grapheme -> Maybe Grapheme)
-> MultiZipper t Grapheme -> MultiZipper t Grapheme
forall a t. (a -> Maybe a) -> MultiZipper t a -> MultiZipper t a
zap (Grapheme -> Maybe Grapheme
forall a. a -> Maybe a
Just (Grapheme -> Maybe Grapheme) -> ShowS -> Grapheme -> Maybe Grapheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grapheme -> ShowS
forall a b. a -> b -> a
const Grapheme
g') MultiZipper t Grapheme
mz'
                    (ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplacementIndices
ixs'', (MultiZipper t Grapheme
mz'', Grapheme -> Maybe Grapheme
forall a. a -> Maybe a
Just Grapheme
g'))
                -- cannot modify nonexistent or boundary grapheme,

                -- or if there are zero key-value pairs

                ([PWord], Maybe Grapheme)
_ -> (ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplacementIndices
ixs'', (MultiZipper t Grapheme
mz', Maybe Grapheme
prev'))
    replaceLex ReplacementIndices
ixs (Autosegment Grapheme
_ [[(Grapheme, Bool)]]
_ []) MultiZipper t Grapheme
mz Maybe Grapheme
prev = (ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplacementIndices
ixs, (MultiZipper t Grapheme
mz, Maybe Grapheme
prev))
    replaceLex ReplacementIndices
ixs (Autosegment Grapheme
n [[(Grapheme, Bool)]]
kvs (Grapheme
gBase:PWord
_)) MultiZipper t Grapheme
mz Maybe Grapheme
prev =
        -- ignore other segments, just produce a single one

        -- as if modulated by a 'Feature', but accounting for Nothing values

        let (FeatureState
fs, ReplacementIndices
ixs') = case Grapheme -> ReplacementIndices -> Maybe (Int, ReplacementIndices)
advanceFeature Grapheme
n ReplacementIndices
ixs of
                Just (Int
i, ReplacementIndices
ixs_)
                    | Just [FeatureState]
fss <- Grapheme -> Map Grapheme [FeatureState] -> Maybe [FeatureState]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Grapheme
n (MatchOutput -> Map Grapheme [FeatureState]
matchedFeatures MatchOutput
out)
                    , Just FeatureState
fs_ <- [FeatureState]
fss [FeatureState] -> Int -> Maybe FeatureState
forall a. [a] -> Int -> Maybe a
!? Int
i
                    -> (FeatureState
fs_, ReplacementIndices
ixs_)
                Maybe (Int, ReplacementIndices)
_ -> (FeatureState
Indeterminate, ReplacementIndices
ixs)
        in 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' (Grapheme -> Lexeme Expanded 'Replacement
forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> Lexeme category a
Grapheme Grapheme
gBase) MultiZipper t Grapheme
mz Maybe Grapheme
prev
            case Maybe Grapheme
prev' of
                Just Grapheme
g | Grapheme
g Grapheme -> Grapheme -> Bool
forall a. Eq a => a -> a -> Bool
/= Grapheme
"#" -> do
                    Grapheme
g' <- case FeatureState
fs of
                        Index Int
i
                            | Just Grapheme
g'' <- [[(Grapheme, Bool)]] -> Grapheme -> Int -> Maybe Grapheme
applyFeature' [[(Grapheme, Bool)]]
kvs Grapheme
g Int
i
                            -> Grapheme -> PWord
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Grapheme
g''
                        FeatureState
_ -> [[(Grapheme, Bool)]] -> Grapheme -> PWord
applyFeatureInd' [[(Grapheme, Bool)]]
kvs Grapheme
g
                    -- now overwrite previous grapheme

                    let mz'' :: MultiZipper t Grapheme
mz'' = (Grapheme -> Maybe Grapheme)
-> MultiZipper t Grapheme -> MultiZipper t Grapheme
forall a t. (a -> Maybe a) -> MultiZipper t a -> MultiZipper t a
zap (Grapheme -> Maybe Grapheme
forall a. a -> Maybe a
Just (Grapheme -> Maybe Grapheme) -> ShowS -> Grapheme -> Maybe Grapheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grapheme -> ShowS
forall a b. a -> b -> a
const Grapheme
g') MultiZipper t Grapheme
mz'
                    (ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplacementIndices
ixs'', (MultiZipper t Grapheme
mz'', Grapheme -> Maybe Grapheme
forall a. a -> Maybe a
Just Grapheme
g'))
                -- cannot modify nonexistent or boundary grapheme,

                -- or if there are zero key-value pairs

                Maybe Grapheme
_ -> (ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))
-> [(ReplacementIndices, (MultiZipper t Grapheme, Maybe Grapheme))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplacementIndices
ixs'', (MultiZipper t Grapheme
mz', Maybe Grapheme
prev'))

applyFeature :: [[String]] -> String -> Int -> String
applyFeature :: [PWord] -> Grapheme -> Int -> Grapheme
applyFeature [] Grapheme
g Int
_ = Grapheme
g
applyFeature (PWord
gs:[PWord]
gss) Grapheme
g Int
i
    | 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 = Grapheme -> Maybe Grapheme -> Grapheme
forall a. a -> Maybe a -> a
fromMaybe Grapheme
"\xfffd" (Maybe Grapheme -> Grapheme) -> Maybe Grapheme -> Grapheme
forall a b. (a -> b) -> a -> b
$ PWord
gs PWord -> Int -> Maybe Grapheme
forall a. [a] -> Int -> Maybe a
!? Int
i
    | Bool
otherwise = [PWord] -> Grapheme -> Int -> Grapheme
applyFeature [PWord]
gss Grapheme
g Int
i

applyFeature' :: [[(String, Bool)]] -> String -> Int -> Maybe String
applyFeature' :: [[(Grapheme, Bool)]] -> Grapheme -> Int -> Maybe Grapheme
applyFeature' [] Grapheme
g Int
_ = Grapheme -> Maybe Grapheme
forall a. a -> Maybe a
Just Grapheme
g
applyFeature' ([(Grapheme, Bool)]
gs:[[(Grapheme, Bool)]]
gss) Grapheme
g Int
i = case Grapheme -> [(Grapheme, Bool)] -> Maybe Bool
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Grapheme
g [(Grapheme, Bool)]
gs of
    Just Bool
_ -> case [(Grapheme, Bool)]
gs [(Grapheme, Bool)] -> Int -> Maybe (Grapheme, Bool)
forall a. [a] -> Int -> Maybe a
!? Int
i of
        Just (Grapheme
g', Bool
True) -> Grapheme -> Maybe Grapheme
forall a. a -> Maybe a
Just Grapheme
g'
        Just (Grapheme
_, Bool
False) -> Maybe Grapheme
forall a. Maybe a
Nothing  -- this grapheme was excluded, need to act as if Indeterminate

        Maybe (Grapheme, Bool)
Nothing -> Grapheme -> Maybe Grapheme
forall a. a -> Maybe a
Just Grapheme
"\xfffd"
    Maybe Bool
Nothing -> [[(Grapheme, Bool)]] -> Grapheme -> Int -> Maybe Grapheme
applyFeature' [[(Grapheme, Bool)]]
gss Grapheme
g Int
i

applyFeatureInd' :: [[(String, Bool)]] -> String -> [String]
applyFeatureInd' :: [[(Grapheme, Bool)]] -> Grapheme -> PWord
applyFeatureInd' [] Grapheme
g = [Grapheme
g]
applyFeatureInd' ([(Grapheme, Bool)]
gs:[[(Grapheme, Bool)]]
gss) Grapheme
g = case Grapheme -> [(Grapheme, Bool)] -> Maybe Bool
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Grapheme
g [(Grapheme, Bool)]
gs of
    Just Bool
_ -> ((Grapheme, Bool) -> Maybe Grapheme) -> [(Grapheme, Bool)] -> PWord
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Grapheme, Bool) -> Maybe Grapheme
forall {a}. (a, Bool) -> Maybe a
note [(Grapheme, Bool)]
gs
    Maybe Bool
Nothing -> [[(Grapheme, Bool)]] -> Grapheme -> PWord
applyFeatureInd' [[(Grapheme, Bool)]]
gss Grapheme
g
  where
    note :: (a, Bool) -> Maybe a
note (a
a, Bool
True) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
    note (a, Bool)
_ = Maybe a
forall a. Maybe a
Nothing

-- | 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 at

-- which each matching target begins.

exceptionAppliesAtPoint
    :: [Lexeme Expanded 'Matched]  -- ^ Target

    -> Environment Expanded        -- ^ Exceptional environment

    -> 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
$ 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
initialOutput 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
    targetOut :: MatchOutput
targetOut@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
$ 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 -> MatchOutput
newOutput MatchOutput
ex1Out) 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 -> MatchOutput
newOutput MatchOutput
targetOut) (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 the rule matches at

-- the current position of the 'MultiZipper'. If so, for each match,

-- return the 'MatchOutput' and the output 'MultiZipper'. The output

-- 'MultiZipper' is advanced past the matched environment, and has its

-- 'RuleTag's set as appropriate.

matchRuleAtPoint
    :: [Lexeme Expanded 'Matched]  -- ^ Target

    -> Environment Expanded        -- ^ Environment

    -> 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
    let initMO :: MatchOutput
initMO = [Int]
-> [Bool]
-> [PWord]
-> [Int]
-> PWord
-> Map Grapheme [FeatureState]
-> Map Grapheme Int
-> Map Grapheme FeatureState
-> MatchOutput
MatchOutput [] [] [] [] [] Map Grapheme [FeatureState]
forall k a. Map k a
Map.empty Map Grapheme Int
forall k a. Map k a
Map.empty Map Grapheme FeatureState
forall k a. Map k a
Map.empty
    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
$ 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
initMO 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
$ 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 -> MatchOutput
newOutput MatchOutput
env1Out) 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
env2Out <- (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 -> MatchOutput
newOutput MatchOutput
matchResult)
                (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
            -- environment can affect replacement via IDs

            -- only, so collect those

            MatchOutput -> RuleAp MatchOutput
forall a. a -> RuleAp a
forall (m :: * -> *) a. Monad m => a -> m a
return MatchOutput
matchResult
                { matchedFeatureIds :: Map Grapheme FeatureState
matchedFeatureIds = MatchOutput -> Map Grapheme FeatureState
matchedFeatureIds MatchOutput
env2Out
                , matchedBackrefIds :: Map Grapheme Int
matchedBackrefIds = MatchOutput -> Map Grapheme Int
matchedBackrefIds MatchOutput
env2Out
                }

-- | Status of a rule application at a single location.

data RuleStatus
    = SuccessNormal      -- ^ Rule was successful, with 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 -> Grapheme
(Int -> RuleStatus -> ShowS)
-> (RuleStatus -> Grapheme)
-> ([RuleStatus] -> ShowS)
-> Show RuleStatus
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuleStatus -> ShowS
showsPrec :: Int -> RuleStatus -> ShowS
$cshow :: RuleStatus -> Grapheme
show :: RuleStatus -> Grapheme
$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 Rule{Grapheme
[Environment Expanded]
[Lexeme Expanded 'Matched]
[Lexeme Expanded 'Replacement]
Maybe (Environment Expanded)
Flags
exception :: forall (c :: LexemeType -> *). Rule c -> Maybe (Environment c)
target :: [Lexeme Expanded 'Matched]
replacement :: [Lexeme Expanded 'Replacement]
environment :: [Environment Expanded]
exception :: Maybe (Environment Expanded)
flags :: Flags
plaintext :: Grapheme
target :: forall (c :: LexemeType -> *). Rule c -> [Lexeme c 'Matched]
replacement :: forall (c :: LexemeType -> *). Rule c -> [Lexeme c 'Replacement]
environment :: forall (c :: LexemeType -> *). Rule c -> [Environment c]
flags :: forall (c :: LexemeType -> *). Rule c -> Flags
plaintext :: forall (c :: LexemeType -> *). Rule c -> Grapheme
..} =
    (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 [Environment Expanded]
environment
  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
originalWord <- StateT
  (MultiZipper RuleTag Grapheme) [] (MultiZipper RuleTag Grapheme)
forall s (m :: * -> *). MonadState s m => m s
get
                let pMay :: Maybe Int
pMay = RuleTag -> MultiZipper RuleTag Grapheme -> Maybe Int
forall t a. Ord t => t -> MultiZipper t a -> Maybe Int
locationOf RuleTag
TargetStart MultiZipper RuleTag Grapheme
originalWord
                    pMay' :: Maybe Int
pMay' = RuleTag -> MultiZipper RuleTag Grapheme -> Maybe Int
forall t a. Ord t => t -> MultiZipper t a -> Maybe Int
locationOf RuleTag
PrevEnd MultiZipper RuleTag Grapheme
originalWord
                case Maybe Int
pMay of
                    Maybe Int
Nothing -> Grapheme -> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
forall a. HasCallStack => Grapheme -> a
error Grapheme
"applyOnce: start of target was not tagged"
                    Just Int
p
                        | Int
p Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
exs -> 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
                        -- do not apply rule if it would be

                        -- applied twice to the same substring

                        | Just Int
p' <- Maybe Int
pMay', Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
p' -> 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
                        | Bool
otherwise -> do
                        (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 Flags
flags 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
                        -- we want TargetEnd to move forward as the replacement is added,

                        -- but not TargetStart, so restore its old position

                        (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
-> Int
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a.
Ord t =>
t -> Int -> MultiZipper t a -> Maybe (MultiZipper t a)
tagAt RuleTag
TargetStart Int
p
                        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{Bool
nonOverlappingTarget :: Bool
nonOverlappingTarget :: Flags -> Bool
nonOverlappingTarget}} =
    MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
resetTags (MultiZipper RuleTag Grapheme
 -> Maybe (MultiZipper RuleTag Grapheme))
-> (MultiZipper RuleTag Grapheme
    -> Maybe (MultiZipper RuleTag Grapheme))
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< 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 (if Bool
nonOverlappingTarget then RuleTag
TargetEnd else RuleTag
TargetStart)
        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
  where
    resetTags :: MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
resetTags MultiZipper RuleTag Grapheme
mz =
        -- update PrevEnd to farthest replaced position on success,

        -- or keep it the same on failure

        let p :: Maybe Int
p = RuleTag -> MultiZipper RuleTag Grapheme -> Maybe Int
forall t a. Ord t => t -> MultiZipper t a -> Maybe Int
locationOf RuleTag
TargetEnd MultiZipper RuleTag Grapheme
mz
            p' :: Maybe Int
p' = RuleTag -> MultiZipper RuleTag Grapheme -> Maybe Int
forall t a. Ord t => t -> MultiZipper t a -> Maybe Int
locationOf RuleTag
PrevEnd MultiZipper RuleTag Grapheme
mz
            newPrevEnd :: Maybe Int
newPrevEnd = case RuleStatus
status of
                RuleStatus
Failure -> Maybe Int
p'
                RuleStatus
_ -> Maybe Int -> Maybe Int -> Maybe Int
forall a. Ord a => a -> a -> a
max Maybe Int
p Maybe Int
p'
        in (MultiZipper RuleTag Grapheme
 -> Maybe (MultiZipper RuleTag Grapheme))
-> (Int
    -> MultiZipper RuleTag Grapheme
    -> Maybe (MultiZipper RuleTag Grapheme))
-> Maybe Int
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall a. a -> Maybe a
Just (RuleTag
-> Int
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall t a.
Ord t =>
t -> Int -> MultiZipper t a -> Maybe (MultiZipper t a)
tagAt RuleTag
PrevEnd) Maybe Int
newPrevEnd (MultiZipper RuleTag Grapheme
 -> Maybe (MultiZipper RuleTag Grapheme))
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
forall a b. (a -> b) -> a -> b
$ MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall t a. MultiZipper t a -> MultiZipper t a
untag MultiZipper RuleTag Grapheme
mz

-- | 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.

--

-- Note: unlike 'applyRuleStr', this can produce duplicate outputs.

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

    let result :: [MultiZipper RuleTag Grapheme]
result = case Flags -> Direction
applyDirection (Rule Expanded -> Flags
forall (c :: LexemeType -> *). Rule c -> Flags
flags Rule Expanded
r) of
            Direction
LTR -> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
repeatRule (MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme])
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
forall a b. (a -> b) -> a -> b
$ MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall t a. MultiZipper t a -> MultiZipper t a
toBeginning MultiZipper RuleTag Grapheme
mz
            -- Apply RTL by reversing both rule and word

            Direction
RTL -> (MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
-> [MultiZipper RuleTag Grapheme] -> [MultiZipper RuleTag Grapheme]
forall a b. (a -> b) -> [a] -> [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
reverseMZ ([MultiZipper RuleTag Grapheme] -> [MultiZipper RuleTag Grapheme])
-> [MultiZipper RuleTag Grapheme] -> [MultiZipper RuleTag Grapheme]
forall a b. (a -> b) -> a -> b
$ MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
repeatRule (MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme])
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
forall a b. (a -> b) -> a -> b
$ MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall t a. MultiZipper t a -> MultiZipper t a
toBeginning (MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
-> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall a b. (a -> b) -> a -> b
$ MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
forall t a. MultiZipper t a -> MultiZipper t a
reverseMZ MultiZipper RuleTag Grapheme
mz
    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
    r' :: Rule Expanded
r' = case Flags -> Direction
applyDirection (Rule Expanded -> Flags
forall (c :: LexemeType -> *). Rule c -> Flags
flags Rule Expanded
r) of
        Direction
LTR -> Rule Expanded
r
        Direction
RTL -> Rule
            { target :: [Lexeme Expanded 'Matched]
target = [Lexeme Expanded 'Matched] -> [Lexeme Expanded 'Matched]
forall a. [a] -> [a]
reverse ([Lexeme Expanded 'Matched] -> [Lexeme Expanded 'Matched])
-> [Lexeme Expanded 'Matched] -> [Lexeme Expanded 'Matched]
forall a b. (a -> b) -> a -> b
$ Rule Expanded -> [Lexeme Expanded 'Matched]
forall (c :: LexemeType -> *). Rule c -> [Lexeme c 'Matched]
target Rule Expanded
r
            , replacement :: [Lexeme Expanded 'Replacement]
replacement = [Lexeme Expanded 'Replacement] -> [Lexeme Expanded 'Replacement]
forall a. [a] -> [a]
reverse ([Lexeme Expanded 'Replacement] -> [Lexeme Expanded 'Replacement])
-> [Lexeme Expanded 'Replacement] -> [Lexeme Expanded 'Replacement]
forall a b. (a -> b) -> a -> b
$ Rule Expanded -> [Lexeme Expanded 'Replacement]
forall (c :: LexemeType -> *). Rule c -> [Lexeme c 'Replacement]
replacement Rule Expanded
r
            , environment :: [Environment Expanded]
environment = Environment Expanded -> Environment Expanded
forall {a} {a}. ([a], [a]) -> ([a], [a])
reverseEnv (Environment Expanded -> Environment Expanded)
-> [Environment Expanded] -> [Environment Expanded]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rule Expanded -> [Environment Expanded]
forall (c :: LexemeType -> *). Rule c -> [Environment c]
environment Rule Expanded
r
            , exception :: Maybe (Environment Expanded)
exception = Environment Expanded -> Environment Expanded
forall {a} {a}. ([a], [a]) -> ([a], [a])
reverseEnv (Environment Expanded -> Environment Expanded)
-> Maybe (Environment Expanded) -> Maybe (Environment Expanded)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rule Expanded -> Maybe (Environment Expanded)
forall (c :: LexemeType -> *). Rule c -> Maybe (Environment c)
exception Rule Expanded
r
            , flags :: Flags
flags = Rule Expanded -> Flags
forall (c :: LexemeType -> *). Rule c -> Flags
flags Rule Expanded
r
            , plaintext :: Grapheme
plaintext = Rule Expanded -> Grapheme
forall (c :: LexemeType -> *). Rule c -> Grapheme
plaintext Rule Expanded
r
            }

    reverseEnv :: ([a], [a]) -> ([a], [a])
reverseEnv ([a]
e1, [a]
e2) = ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
e2, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
e1)

    repeatRule
        :: MultiZipper RuleTag Grapheme
        -> [MultiZipper RuleTag Grapheme]
    repeatRule :: MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
repeatRule 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 (Rule Expanded
-> StateT (MultiZipper RuleTag Grapheme) [] RuleStatus
applyOnce Rule Expanded
r') 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 [MultiZipper RuleTag Grapheme]
-> (MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme])
-> Maybe (MultiZipper RuleTag Grapheme)
-> [MultiZipper RuleTag Grapheme]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [MultiZipper RuleTag Grapheme
mz'] MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
repeatRule (RuleStatus
-> Rule Expanded
-> MultiZipper RuleTag Grapheme
-> Maybe (MultiZipper RuleTag Grapheme)
setupForNextApplication RuleStatus
status Rule Expanded
r' 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 Grapheme
_ [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 = 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
initialOutput 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 list, replacing all unlisted graphemes other than @"#"@

-- with U+FFFD.

checkGraphemes :: [Grapheme] -> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
checkGraphemes :: PWord
-> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
checkGraphemes PWord
gs = ShowS
-> 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 (ShowS
 -> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme)
-> ShowS
-> MultiZipper RuleTag Grapheme
-> MultiZipper RuleTag Grapheme
forall a b. (a -> b) -> a -> b
$ \case
    Grapheme
"#" -> Grapheme
"#"
    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 Grapheme
"\xfffd"

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

-- more results.

applyStatementMZ
    :: Statement Expanded GraphemeList
    -> MultiZipper RuleTag Grapheme
    -> [MultiZipper RuleTag Grapheme]
applyStatementMZ :: Statement Expanded GraphemeList
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
applyStatementMZ (RuleS Rule Expanded
r) MultiZipper RuleTag Grapheme
mz = Rule Expanded
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
applyRuleMZ Rule Expanded
r MultiZipper RuleTag Grapheme
mz
applyStatementMZ (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]
applyStatementMZ Statement Expanded GraphemeList
ReportS MultiZipper RuleTag Grapheme
mz = [MultiZipper RuleTag Grapheme
mz]
applyStatementMZ (DeclS (GraphemeList Bool
noreplace PWord
gs)) MultiZipper RuleTag Grapheme
mz
    | Bool
noreplace = [MultiZipper RuleTag Grapheme
mz]
    | Bool
otherwise = [PWord
-> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
checkGraphemes PWord
gs MultiZipper RuleTag Grapheme
mz]

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

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]
applyRuleMZ 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. The statement can be a

-- sound change, a filter, or any other element which remains in a

-- sound change file after expansion.

applyStatementStr :: Statement Expanded GraphemeList -> PWord -> [PWord]
applyStatementStr :: Statement Expanded GraphemeList -> PWord -> [PWord]
applyStatementStr Statement Expanded GraphemeList
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 GraphemeList
-> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
applyStatementMZ Statement Expanded GraphemeList
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 action @r@ (usually a

-- 'Statement'), and the result from that action.

data LogItem r
    = ActionApplied r (Maybe PWord)
    -- ^ The word was modified: gives the output word, or 'Nothing' if

    -- the wordwas deleted

    | ReportWord PWord
    -- ^ Corresponds to 'ReportS', giving the intermediate form to report

    deriving (Int -> LogItem r -> ShowS
[LogItem r] -> ShowS
LogItem r -> Grapheme
(Int -> LogItem r -> ShowS)
-> (LogItem r -> Grapheme)
-> ([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 -> Grapheme
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([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 -> Grapheme
show :: LogItem r -> Grapheme
$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)

-- action :: LogItem r -> Maybe r

-- action (ActionApplied r _ _) = Just r

-- action (ReportWord _) = Nothing


logOutput :: LogItem r -> Maybe PWord
logOutput :: forall r. LogItem r -> Maybe PWord
logOutput (ActionApplied r
_ Maybe PWord
o) = Maybe PWord
o
logOutput (ReportWord PWord
o) = PWord -> Maybe PWord
forall a. a -> Maybe a
Just PWord
o

-- | Logs the evolution of a word as it undergoes sound changes and

-- other actions.

data Log r = Log
    { forall r. Log r -> PWord
inputWord :: PWord
    -- ^ The input word, before any actions have been applied

    , forall r. Log r -> [LogItem r]
derivations :: [LogItem r]
    -- ^ All actions which were applied, with the state of the word at

    -- each point

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

-- | Pretty-print a single 'Log' as 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 a browser as follows:

--

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

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

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

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

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


reportAsHtmlRows
    :: (r -> String)  -- ^ Specifies how to pretty-print actions as text

    -> Log r -> String
reportAsHtmlRows :: forall r. (r -> Grapheme) -> Log r -> Grapheme
reportAsHtmlRows r -> Grapheme
render Log r
item = Grapheme -> [LogItem r] -> Grapheme
go (PWord -> Grapheme
concatWithBoundary (PWord -> Grapheme) -> PWord -> Grapheme
forall a b. (a -> b) -> a -> b
$ Log r -> PWord
forall r. Log r -> PWord
inputWord Log r
item) (Log r -> [LogItem r]
forall r. Log r -> [LogItem r]
derivations Log r
item)
  where
    go :: Grapheme -> [LogItem r] -> Grapheme
go Grapheme
_ [] = Grapheme
""
    go Grapheme
cell1 (ActionApplied r
action Maybe PWord
output : [LogItem r]
ds) =
        (Grapheme
"<tr><td>" Grapheme -> ShowS
forall a. [a] -> [a] -> [a]
++ Grapheme
cell1 Grapheme -> ShowS
forall a. [a] -> [a] -> [a]
++ Grapheme
"</td><td>&rarr;</td><td>"
         Grapheme -> ShowS
forall a. [a] -> [a] -> [a]
++ Grapheme -> (PWord -> Grapheme) -> Maybe PWord -> Grapheme
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Grapheme
"<i>deleted</i>" PWord -> Grapheme
concatWithBoundary Maybe PWord
output
         Grapheme -> ShowS
forall a. [a] -> [a] -> [a]
++ Grapheme
"</td><td>(" Grapheme -> ShowS
forall a. [a] -> [a] -> [a]
++ r -> Grapheme
render r
action Grapheme -> ShowS
forall a. [a] -> [a] -> [a]
++ Grapheme
")</td></tr>")
        Grapheme -> ShowS
forall a. [a] -> [a] -> [a]
++ Grapheme -> [LogItem r] -> Grapheme
go Grapheme
"" [LogItem r]
ds
    go Grapheme
cell1 (ReportWord PWord
w : [LogItem r]
ds) =
        (Grapheme
"<tr><td>" Grapheme -> ShowS
forall a. [a] -> [a] -> [a]
++ Grapheme
cell1 Grapheme -> ShowS
forall a. [a] -> [a] -> [a]
++ Grapheme
"</td><td>&rarr;</td><td>"
         Grapheme -> ShowS
forall a. [a] -> [a] -> [a]
++ PWord -> Grapheme
concatWithBoundary PWord
w
         Grapheme -> ShowS
forall a. [a] -> [a] -> [a]
++ Grapheme
"</td><td>(report)</td></tr>")
        Grapheme -> ShowS
forall a. [a] -> [a] -> [a]
++ Grapheme -> [LogItem r] -> Grapheme
go Grapheme
"" [LogItem r]
ds

-- | Pretty-print a 'Log' as plain text. For instance, this log:

--

-- @

-- 'Log'

--   { 'inputWord' = ["t", "a", "r", "a"]

--   , 'derivations' =

--     [ ('Just' ["t", "a", "zh", "a"], "r \/ zh")

--     , ('Just' ["t", "a", "zh"], "V \/ \/ _ #")

--     ]

--   }

-- @

--

-- Would be pretty-printed by @'reportAsText' 'id'@ as:

--

-- > tara

-- >   -> tazha  (r / zh)

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

reportAsText
    :: (r -> String)  -- ^ Specifies how to pretty-print actions as text

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

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

    toPrintable :: LogItem r -> (Maybe PWord, Grapheme)
toPrintable (ActionApplied r
a Maybe PWord
o) = (Maybe PWord
o, r -> Grapheme
render r
a)
    toPrintable (ReportWord PWord
w) = (PWord -> Maybe PWord
forall a. a -> Maybe a
Just PWord
w, Grapheme
"report")

-- | 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.

applyStatement
    :: Statement Expanded GraphemeList
    -> PWord
    -> [LogItem (Statement Expanded GraphemeList)]
applyStatement :: Statement Expanded GraphemeList
-> PWord -> [LogItem (Statement Expanded GraphemeList)]
applyStatement Statement Expanded GraphemeList
ReportS PWord
w = [PWord -> LogItem (Statement Expanded GraphemeList)
forall r. PWord -> LogItem r
ReportWord PWord
w]
applyStatement Statement Expanded GraphemeList
st PWord
w = case Statement Expanded GraphemeList -> PWord -> [PWord]
applyStatementStr Statement Expanded GraphemeList
st PWord
w of
    [] -> [Statement Expanded GraphemeList
-> Maybe PWord -> LogItem (Statement Expanded GraphemeList)
forall r. r -> Maybe PWord -> LogItem r
ActionApplied Statement Expanded GraphemeList
st 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 GraphemeList
-> Maybe PWord -> LogItem (Statement Expanded GraphemeList)
forall r. r -> Maybe PWord -> LogItem r
ActionApplied Statement Expanded GraphemeList
st (Maybe PWord -> LogItem (Statement Expanded GraphemeList))
-> (PWord -> Maybe PWord)
-> PWord
-> LogItem (Statement Expanded GraphemeList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PWord -> Maybe PWord
forall a. a -> Maybe a
Just (PWord -> LogItem (Statement Expanded GraphemeList))
-> [PWord] -> [LogItem (Statement Expanded GraphemeList)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PWord]
r

-- | Apply a set of 'SoundChanges' to a word, returning a log of which

-- sound changes applied to produce each output word.

applyChanges
    :: SoundChanges Expanded GraphemeList
    -> PWord
    -> [Log (Statement Expanded GraphemeList)]
applyChanges :: SoundChanges Expanded GraphemeList
-> PWord -> [Log (Statement Expanded GraphemeList)]
applyChanges SoundChanges Expanded GraphemeList
scs PWord
w = SoundChanges Expanded GraphemeList
-> PWord -> [[LogItem (Statement Expanded GraphemeList)]]
go SoundChanges Expanded GraphemeList
scs PWord
w [[LogItem (Statement Expanded GraphemeList)]]
-> ([LogItem (Statement Expanded GraphemeList)]
    -> Log (Statement Expanded GraphemeList))
-> [Log (Statement Expanded GraphemeList)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[LogItem (Statement Expanded GraphemeList)]
ls -> Log
    { inputWord :: PWord
inputWord = PWord
w
    , derivations :: [LogItem (Statement Expanded GraphemeList)]
derivations = [LogItem (Statement Expanded GraphemeList)]
ls
    }
  where
    go :: SoundChanges Expanded GraphemeList
-> PWord -> [[LogItem (Statement Expanded GraphemeList)]]
go [] PWord
_ = [[]]   -- one result, no changes applied

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

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

-- | Returns the final output from a sound change log.

getOutput :: Log r -> Maybe PWord
getOutput :: forall r. Log r -> Maybe PWord
getOutput Log r
l = case Log r -> [LogItem r]
forall r. Log r -> [LogItem r]
derivations Log r
l of
    d :: [LogItem r]
d@(LogItem r
_:[LogItem r]
_) -> LogItem r -> Maybe PWord
forall r. LogItem r -> Maybe PWord
logOutput (LogItem r -> Maybe PWord) -> LogItem r -> Maybe PWord
forall a b. (a -> b) -> a -> b
$ [LogItem r] -> LogItem r
forall a. HasCallStack => [a] -> a
last [LogItem r]
d
    [] -> PWord -> Maybe PWord
forall a. a -> Maybe a
Just (PWord -> Maybe PWord) -> PWord -> Maybe PWord
forall a b. (a -> b) -> a -> b
$ Log r -> PWord
forall r. Log r -> PWord
inputWord Log r
l

-- | Returns, in order: the input word, any intermediate results from

-- 'ReportS', and then the final output.

getReports :: Log r -> [PWord]
getReports :: forall r. Log r -> [PWord]
getReports Log r
l = Log r -> PWord
forall r. Log r -> PWord
inputWord Log r
l PWord -> [PWord] -> [PWord]
forall a. a -> [a] -> [a]
: [LogItem r] -> [PWord]
forall {r}. [LogItem r] -> [PWord]
go (Log r -> [LogItem r]
forall r. Log r -> [LogItem r]
derivations Log r
l)
  where
    go :: [LogItem r] -> [PWord]
go [] = []
    go [ActionApplied r
_ (Just PWord
w')] = [PWord
w']
    go (ReportWord PWord
w':[LogItem r]
ls) = PWord
w' PWord -> [PWord] -> [PWord]
forall a. a -> [a] -> [a]
: [LogItem r] -> [PWord]
go [LogItem r]
ls
    go (LogItem r
_:[LogItem r]
ls) = [LogItem r] -> [PWord]
go [LogItem r]
ls

-- | Returns the final output from a sound change log, as well as an

-- indication of whether any sound changes have applied to it

-- (accounting for 'highlightChanges' flags).

getChangedOutputs :: Log (Statement c d) -> Maybe (PWord, Bool)
getChangedOutputs :: forall (c :: LexemeType -> *) d.
Log (Statement c d) -> Maybe (PWord, Bool)
getChangedOutputs Log (Statement c d)
l = case Log (Statement c d) -> [LogItem (Statement c d)]
forall r. Log r -> [LogItem r]
derivations Log (Statement c d)
l of
    [] -> (PWord, Bool) -> Maybe (PWord, Bool)
forall a. a -> Maybe a
Just (Log (Statement c d) -> PWord
forall r. Log r -> PWord
inputWord Log (Statement c d)
l, Bool
False)
    [LogItem (Statement c d)]
logs -> case LogItem (Statement c d) -> Maybe PWord
forall r. LogItem r -> Maybe PWord
logOutput ([LogItem (Statement c d)] -> LogItem (Statement c d)
forall a. HasCallStack => [a] -> a
last [LogItem (Statement c d)]
logs) of
        Just PWord
out -> (PWord, Bool) -> Maybe (PWord, Bool)
forall a. a -> Maybe a
Just (PWord
out, [LogItem (Statement c d)] -> Bool
forall {c :: LexemeType -> *} {decl}.
[LogItem (Statement c decl)] -> Bool
hasChanged [LogItem (Statement c d)]
logs)
        Maybe PWord
Nothing -> Maybe (PWord, Bool)
forall a. Maybe a
Nothing
  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) 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
_) Maybe PWord
_ -> Bool
False  -- cannot highlight nonexistent word

        ActionApplied (DeclS decl
_) Maybe PWord
_ -> Bool
True
        ActionApplied Statement c decl
ReportS Maybe PWord
_ -> Bool
False  -- reporting a word yields no change

        ReportWord PWord
_ -> Bool
False

-- | A combination of 'getOutput' and 'getChangedOutputs': returns all

-- intermediate results, as well as whether each has undergone any

-- sound changes.

getChangedReports :: Log (Statement c d) -> [(PWord, Bool)]
getChangedReports :: forall (c :: LexemeType -> *) d.
Log (Statement c d) -> [(PWord, Bool)]
getChangedReports Log (Statement c d)
l = (Log (Statement c d) -> PWord
forall r. Log r -> PWord
inputWord Log (Statement c d)
l, Bool
False) (PWord, Bool) -> [(PWord, Bool)] -> [(PWord, Bool)]
forall a. a -> [a] -> [a]
: case Log (Statement c d) -> [LogItem (Statement c d)]
forall r. Log r -> [LogItem r]
derivations Log (Statement c d)
l of
    [] -> []
    [LogItem (Statement c d)]
ls -> Bool -> [LogItem (Statement c d)] -> [(PWord, Bool)]
forall {c :: LexemeType -> *} {decl}.
Bool -> [LogItem (Statement c decl)] -> [(PWord, Bool)]
go Bool
False [LogItem (Statement c d)]
ls
  where
    go :: Bool -> [LogItem (Statement c decl)] -> [(PWord, Bool)]
go Bool
_ [] = []
    go Bool
hasChanged (ActionApplied Statement c decl
action Maybe PWord
_:[LogItem (Statement c decl)]
ls) =
        let hasChanged' :: Bool
hasChanged' = case Statement c decl
action of
                RuleS Rule c
rule -> Bool
hasChanged Bool -> Bool -> Bool
|| Flags -> Bool
highlightChanges (Rule c -> Flags
forall (c :: LexemeType -> *). Rule c -> Flags
flags Rule c
rule)
                Statement c decl
_ -> Bool
hasChanged
        in Bool -> [LogItem (Statement c decl)] -> [(PWord, Bool)]
go Bool
hasChanged' [LogItem (Statement c decl)]
ls
    go Bool
hasChanged (ReportWord PWord
w':[LogItem (Statement c decl)]
ls) = (PWord
w', Bool
hasChanged) (PWord, Bool) -> [(PWord, Bool)] -> [(PWord, Bool)]
forall a. a -> [a] -> [a]
: Bool -> [LogItem (Statement c decl)] -> [(PWord, Bool)]
go Bool
hasChanged [LogItem (Statement c decl)]
ls

-- | Apply a set of 'SoundChanges' to a word, returning the final

-- output word(s) as well as any intermediate results from 'ReportS',

-- each with a boolean marking changed results (as with 'applyChangesWithChanges').