{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}

-- |

-- Module      : Brassica.SoundChange.Expand

-- Copyright   : See LICENSE file

-- License     : BSD3

-- Maintainer  : Brad Neimann

--

-- This module implements the process of /expansion/, from Brassica’s

-- surface syntax to a simpler representation in which all categories,

-- features and autosegments have been inlined. For further

--

-- In the surface syntax, each category is represented as a

-- 'CategorySpec', a description in terms of predefined categories

-- combined with category operations. Expansion converts each one to

-- an 'Expanded' list of graphemes.

--

-- Similarly, category definitions are parsed as 'Directive's. Once

-- inlined, these can be replaced with simple 'GraphemeList's to be

-- used for filtering graphemes.

module Brassica.SoundChange.Expand
       (
       -- * Main function

         expandSoundChanges
       , ExpandError(..)
       -- * Expanding individual elements

       , expand
       , expandRule
       , extendCategories
       -- * Categories

       , Categories
       , AutosegmentDef(..)
       , Brassica.SoundChange.Expand.lookup
       , values
       ) where

import Prelude hiding (lookup)
import Control.DeepSeq (NFData)
import Control.Monad (foldM, unless)
import Control.Monad.State.Strict (StateT, evalStateT, lift, get, put, gets)
import Data.Bifunctor (first, second)
import Data.Containers.ListUtils (nubOrd)
import Data.List (transpose, foldl', stripPrefix)
import Data.Maybe (mapMaybe, catMaybes)
import Data.Traversable (for)
import GHC.Generics (Generic)

import qualified Data.Map.Strict as M
import qualified Data.Map.Merge.Strict as M

import Brassica.SoundChange.Types

-- | Expanding an autosegment from a grapheme requires knowing its

-- feature name, and a set of graphemes cross-cutting that feature.

-- (Note that 'autoGraphemes' includes the originally-written

-- grapheme.)

data AutosegmentDef = AutosegmentDef
    { AutosegmentDef -> [Char]
autoFeature :: String
    , AutosegmentDef -> [[Char]]
autoGraphemes :: [String]
    }
    deriving (AutosegmentDef -> AutosegmentDef -> Bool
(AutosegmentDef -> AutosegmentDef -> Bool)
-> (AutosegmentDef -> AutosegmentDef -> Bool) -> Eq AutosegmentDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AutosegmentDef -> AutosegmentDef -> Bool
== :: AutosegmentDef -> AutosegmentDef -> Bool
$c/= :: AutosegmentDef -> AutosegmentDef -> Bool
/= :: AutosegmentDef -> AutosegmentDef -> Bool
Eq, Int -> AutosegmentDef -> ShowS
[AutosegmentDef] -> ShowS
AutosegmentDef -> [Char]
(Int -> AutosegmentDef -> ShowS)
-> (AutosegmentDef -> [Char])
-> ([AutosegmentDef] -> ShowS)
-> Show AutosegmentDef
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AutosegmentDef -> ShowS
showsPrec :: Int -> AutosegmentDef -> ShowS
$cshow :: AutosegmentDef -> [Char]
show :: AutosegmentDef -> [Char]
$cshowList :: [AutosegmentDef] -> ShowS
showList :: [AutosegmentDef] -> ShowS
Show)

-- | A map from names to the (expanded) categories or autosegments

-- they reference. Used to resolve cross-references between

-- categories.

type Categories = M.Map String (Either (Expanded 'AnyPart) AutosegmentDef)

-- | Lookup a category name in t'Categories'.

lookup :: String -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
lookup :: forall (a :: LexemeType).
[Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
lookup = ((Either (Expanded 'AnyPart) AutosegmentDef
 -> Either (Expanded a) AutosegmentDef)
-> Maybe (Either (Expanded 'AnyPart) AutosegmentDef)
-> Maybe (Either (Expanded a) AutosegmentDef)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expanded 'AnyPart -> Expanded a)
-> Either (Expanded 'AnyPart) AutosegmentDef
-> Either (Expanded a) AutosegmentDef
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Expanded 'AnyPart -> Expanded a
forall (a :: LexemeType). Expanded 'AnyPart -> Expanded a
generaliseExpanded) (Maybe (Either (Expanded 'AnyPart) AutosegmentDef)
 -> Maybe (Either (Expanded a) AutosegmentDef))
-> (Categories
    -> Maybe (Either (Expanded 'AnyPart) AutosegmentDef))
-> Categories
-> Maybe (Either (Expanded a) AutosegmentDef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Categories -> Maybe (Either (Expanded 'AnyPart) AutosegmentDef))
 -> Categories -> Maybe (Either (Expanded a) AutosegmentDef))
-> ([Char]
    -> Categories -> Maybe (Either (Expanded 'AnyPart) AutosegmentDef))
-> [Char]
-> Categories
-> Maybe (Either (Expanded a) AutosegmentDef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char]
-> Categories -> Maybe (Either (Expanded 'AnyPart) AutosegmentDef)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup

-- | Returns a list of every value mentioned in a set of

-- t'Categories'

values :: Categories -> [[Lexeme Expanded 'AnyPart]]
values :: Categories -> [[Lexeme Expanded 'AnyPart]]
values = [[Lexeme Expanded 'AnyPart]] -> [[Lexeme Expanded 'AnyPart]]
forall a. Ord a => [a] -> [a]
nubOrd ([[Lexeme Expanded 'AnyPart]] -> [[Lexeme Expanded 'AnyPart]])
-> (Categories -> [[Lexeme Expanded 'AnyPart]])
-> Categories
-> [[Lexeme Expanded 'AnyPart]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (Expanded 'AnyPart) AutosegmentDef
 -> [[Lexeme Expanded 'AnyPart]])
-> [Either (Expanded 'AnyPart) AutosegmentDef]
-> [[Lexeme Expanded 'AnyPart]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Expanded 'AnyPart -> [[Lexeme Expanded 'AnyPart]])
-> (AutosegmentDef -> [[Lexeme Expanded 'AnyPart]])
-> Either (Expanded 'AnyPart) AutosegmentDef
-> [[Lexeme Expanded 'AnyPart]]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Expanded 'AnyPart -> [[Lexeme Expanded 'AnyPart]]
forall (a :: LexemeType).
Expanded a -> [CategoryElement Expanded a]
elements AutosegmentDef -> [[Lexeme Expanded 'AnyPart]]
forall {category :: LexemeType -> *} {a :: LexemeType}.
AutosegmentDef -> [[Lexeme category a]]
autoElements) ([Either (Expanded 'AnyPart) AutosegmentDef]
 -> [[Lexeme Expanded 'AnyPart]])
-> (Categories -> [Either (Expanded 'AnyPart) AutosegmentDef])
-> Categories
-> [[Lexeme Expanded 'AnyPart]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Categories -> [Either (Expanded 'AnyPart) AutosegmentDef]
forall k a. Map k a -> [a]
M.elems
  where
    autoElements :: AutosegmentDef -> [[Lexeme category a]]
autoElements = ([Char] -> [Lexeme category a])
-> [[Char]] -> [[Lexeme category a]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lexeme category a -> [Lexeme category a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lexeme category a -> [Lexeme category a])
-> ([Char] -> Lexeme category a) -> [Char] -> [Lexeme category a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Lexeme category a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> Lexeme category a
Grapheme) ([[Char]] -> [[Lexeme category a]])
-> (AutosegmentDef -> [[Char]])
-> AutosegmentDef
-> [[Lexeme category a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AutosegmentDef -> [[Char]]
autoGraphemes

-- | Errors which can be emitted while inlining or expanding category

-- definitions.

data ExpandError
    = NotFound String
      -- ^ A category with the given name was not found

    | InvalidBaseValue
      -- ^ A 'Lexeme' was used as a base value in a feature

    | InvalidDerivedValue
      -- ^ A 'Lexeme' was used as a derived value in an autosegment

    | MismatchedLengths
      -- ^ A phonetic feature or 'FeatureSpec' contained a mismatched number of values

    deriving (Int -> ExpandError -> ShowS
[ExpandError] -> ShowS
ExpandError -> [Char]
(Int -> ExpandError -> ShowS)
-> (ExpandError -> [Char])
-> ([ExpandError] -> ShowS)
-> Show ExpandError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpandError -> ShowS
showsPrec :: Int -> ExpandError -> ShowS
$cshow :: ExpandError -> [Char]
show :: ExpandError -> [Char]
$cshowList :: [ExpandError] -> ShowS
showList :: [ExpandError] -> ShowS
Show, (forall x. ExpandError -> Rep ExpandError x)
-> (forall x. Rep ExpandError x -> ExpandError)
-> Generic ExpandError
forall x. Rep ExpandError x -> ExpandError
forall x. ExpandError -> Rep ExpandError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExpandError -> Rep ExpandError x
from :: forall x. ExpandError -> Rep ExpandError x
$cto :: forall x. Rep ExpandError x -> ExpandError
to :: forall x. Rep ExpandError x -> ExpandError
Generic, ExpandError -> ()
(ExpandError -> ()) -> NFData ExpandError
forall a. (a -> ()) -> NFData a
$crnf :: ExpandError -> ()
rnf :: ExpandError -> ()
NFData)

-- | Given an unexpanded category, return the list of values which it

-- matches.

expand :: Categories -> CategorySpec a -> Either ExpandError (Expanded a)
expand :: forall (a :: LexemeType).
Categories -> CategorySpec a -> Either ExpandError (Expanded a)
expand Categories
cs (MustInline [Char]
g) = case [Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
forall (a :: LexemeType).
[Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
lookup [Char]
g Categories
cs of
    Just (Left Expanded a
expanded) -> Expanded a -> Either ExpandError (Expanded a)
forall a b. b -> Either a b
Right Expanded a
expanded
    Maybe (Either (Expanded a) AutosegmentDef)
_ -> ExpandError -> Either ExpandError (Expanded a)
forall a b. a -> Either a b
Left (ExpandError -> Either ExpandError (Expanded a))
-> ExpandError -> Either ExpandError (Expanded a)
forall a b. (a -> b) -> a -> b
$ [Char] -> ExpandError
NotFound [Char]
g
expand Categories
cs (CategorySpec [(CategoryModification, CategoryElement CategorySpec a)]
spec) = [CategoryElement Expanded a] -> Expanded a
forall (a :: LexemeType).
[CategoryElement Expanded a] -> Expanded a
FromElements ([CategoryElement Expanded a] -> Expanded a)
-> Either ExpandError [CategoryElement Expanded a]
-> Either ExpandError (Expanded a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([CategoryElement Expanded a]
 -> (CategoryModification, CategoryElement CategorySpec a)
 -> Either ExpandError [CategoryElement Expanded a])
-> [CategoryElement Expanded a]
-> [(CategoryModification, CategoryElement CategorySpec a)]
-> Either ExpandError [CategoryElement Expanded a]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [CategoryElement Expanded a]
-> (CategoryModification, CategoryElement CategorySpec a)
-> Either ExpandError [CategoryElement Expanded a]
forall (a :: LexemeType).
[CategoryElement Expanded a]
-> (CategoryModification, CategoryElement CategorySpec a)
-> Either ExpandError [CategoryElement Expanded a]
go [] [(CategoryModification, CategoryElement CategorySpec a)]
spec
  where
    go :: [CategoryElement Expanded a]
                  -> (CategoryModification, CategoryElement CategorySpec a)
                  -> Either ExpandError [CategoryElement Expanded a]
    go :: forall (a :: LexemeType).
[CategoryElement Expanded a]
-> (CategoryModification, CategoryElement CategorySpec a)
-> Either ExpandError [CategoryElement Expanded a]
go [CategoryElement Expanded a]
es (CategoryModification
modifier, CategoryElement CategorySpec a
e) = do
        ([CategoryElement Expanded a]
new, CategoryModification
modifier') <- case CategoryElement CategorySpec a
e of
            [Grapheme [Char]
g]
                | Just ([Char]
g', Char
'~') <- [Char] -> Maybe ([Char], Char)
forall a. [a] -> Maybe ([a], a)
unsnoc [Char]
g
                    -> ([CategoryElement Expanded a], CategoryModification)
-> Either
     ExpandError ([CategoryElement Expanded a], CategoryModification)
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[[Char] -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> Lexeme category a
Grapheme [Char]
g']], CategoryModification
modifier)
                | CategoryModification
modifier CategoryModification -> CategoryModification -> Bool
forall a. Eq a => a -> a -> Bool
== CategoryModification
Intersect
                , Just (Left (FromElements [CategoryElement Expanded a]
c)) <- [Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
forall (a :: LexemeType).
[Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
lookup (Char
'+'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
g) Categories
cs
                    -> ([CategoryElement Expanded a], CategoryModification)
-> Either
     ExpandError ([CategoryElement Expanded a], CategoryModification)
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CategoryElement Expanded a]
c, CategoryModification
Intersect)
                | CategoryModification
modifier CategoryModification -> CategoryModification -> Bool
forall a. Eq a => a -> a -> Bool
== CategoryModification
Subtract
                , Just (Left (FromElements [CategoryElement Expanded a]
c)) <- [Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
forall (a :: LexemeType).
[Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
lookup (Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
g) Categories
cs
                    -> ([CategoryElement Expanded a], CategoryModification)
-> Either
     ExpandError ([CategoryElement Expanded a], CategoryModification)
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CategoryElement Expanded a]
c, CategoryModification
Intersect)  -- do intersection with negative instead!

                | Char
'&':[Char]
g' <- [Char]
g
                , Just (Left (FromElements [CategoryElement Expanded a]
p)) <- [Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
forall (a :: LexemeType).
[Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
lookup (Char
'+'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
g') Categories
cs
                , Just (Left (FromElements [CategoryElement Expanded a]
n)) <- [Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
forall (a :: LexemeType).
[Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
lookup (Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
g') Categories
cs
                    -> ([CategoryElement Expanded a], CategoryModification)
-> Either
     ExpandError ([CategoryElement Expanded a], CategoryModification)
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CategoryElement Expanded a]
n[CategoryElement Expanded a]
-> [CategoryElement Expanded a] -> [CategoryElement Expanded a]
forall a. [a] -> [a] -> [a]
++[CategoryElement Expanded a]
p, CategoryModification
modifier)
                | Just (Left (FromElements [CategoryElement Expanded a]
c)) <- [Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
forall (a :: LexemeType).
[Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
lookup [Char]
g Categories
cs
                    -> ([CategoryElement Expanded a], CategoryModification)
-> Either
     ExpandError ([CategoryElement Expanded a], CategoryModification)
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CategoryElement Expanded a]
c, CategoryModification
modifier)
                | Just (Right AutosegmentDef
_) <- [Char]
-> Categories -> Maybe (Either (Expanded Any) AutosegmentDef)
forall (a :: LexemeType).
[Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
lookup [Char]
g Categories
cs
                    -- re-expand to produce appropriate 'Auto'

                    -> (,CategoryModification
modifier) ([CategoryElement Expanded a]
 -> ([CategoryElement Expanded a], CategoryModification))
-> (Lexeme Expanded a -> [CategoryElement Expanded a])
-> Lexeme Expanded a
-> ([CategoryElement Expanded a], CategoryModification)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CategoryElement Expanded a -> [CategoryElement Expanded a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CategoryElement Expanded a -> [CategoryElement Expanded a])
-> (Lexeme Expanded a -> CategoryElement Expanded a)
-> Lexeme Expanded a
-> [CategoryElement Expanded a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Expanded a -> CategoryElement Expanded a
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lexeme Expanded a
 -> ([CategoryElement Expanded a], CategoryModification))
-> Either ExpandError (Lexeme Expanded a)
-> Either
     ExpandError ([CategoryElement Expanded a], CategoryModification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs ([Char] -> Lexeme CategorySpec a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> Lexeme category a
Grapheme [Char]
g)

                    -- Note: there are other options for design here

                    -- see https://verduria.org/viewtopic.php?p=85766#p85766

                    -- | Just (Right (AutosegmentDef _ gs)) <- lookup g cs

                    -- 1. -> pure ([Left (GMulti g)], modifier)

                    -- 2. -> pure (Left . GMulti <$> g:gs, modifier)

                | Bool
otherwise -> ([CategoryElement Expanded a], CategoryModification)
-> Either
     ExpandError ([CategoryElement Expanded a], CategoryModification)
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[[Char] -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> Lexeme category a
Grapheme [Char]
g]], CategoryModification
modifier)
            CategoryElement CategorySpec a
ls -> (,CategoryModification
modifier) ([CategoryElement Expanded a]
 -> ([CategoryElement Expanded a], CategoryModification))
-> (CategoryElement Expanded a -> [CategoryElement Expanded a])
-> CategoryElement Expanded a
-> ([CategoryElement Expanded a], CategoryModification)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CategoryElement Expanded a -> [CategoryElement Expanded a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CategoryElement Expanded a
 -> ([CategoryElement Expanded a], CategoryModification))
-> Either ExpandError (CategoryElement Expanded a)
-> Either
     ExpandError ([CategoryElement Expanded a], CategoryModification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a))
-> CategoryElement CategorySpec a
-> Either ExpandError (CategoryElement Expanded a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs) CategoryElement CategorySpec a
ls
        [CategoryElement Expanded a]
-> Either ExpandError [CategoryElement Expanded a]
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CategoryElement Expanded a]
 -> Either ExpandError [CategoryElement Expanded a])
-> [CategoryElement Expanded a]
-> Either ExpandError [CategoryElement Expanded a]
forall a b. (a -> b) -> a -> b
$ case CategoryModification
modifier' of
            CategoryModification
Union -> [CategoryElement Expanded a]
es [CategoryElement Expanded a]
-> [CategoryElement Expanded a] -> [CategoryElement Expanded a]
forall a. [a] -> [a] -> [a]
++ [CategoryElement Expanded a]
new
            -- important: intersection preserves order of the /last/ category mentioned!

            CategoryModification
Intersect -> [CategoryElement Expanded a]
es [CategoryElement Expanded a]
-> [CategoryElement Expanded a] -> [CategoryElement Expanded a]
forall (a :: LexemeType).
[[Lexeme Expanded a]]
-> [[Lexeme Expanded a]] -> [[Lexeme Expanded a]]
`intersectC` [CategoryElement Expanded a]
new
            CategoryModification
Subtract -> [CategoryElement Expanded a]
es [CategoryElement Expanded a]
-> [CategoryElement Expanded a] -> [CategoryElement Expanded a]
forall (a :: LexemeType).
[[Lexeme Expanded a]]
-> [[Lexeme Expanded a]] -> [[Lexeme Expanded a]]
`subtractC` [CategoryElement Expanded a]
new

    -- Set operations, also looking into 'Autosegment's

    subtractC, intersectC
        :: [[Lexeme Expanded a]]
        -> [[Lexeme Expanded a]]
        -> [[Lexeme Expanded a]]

    subtractC :: forall (a :: LexemeType).
[[Lexeme Expanded a]]
-> [[Lexeme Expanded a]] -> [[Lexeme Expanded a]]
subtractC [[Lexeme Expanded a]]
es [[Lexeme Expanded a]]
new = ([Lexeme Expanded a] -> Maybe [Lexeme Expanded a])
-> [[Lexeme Expanded a]] -> [[Lexeme Expanded a]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Lexeme Expanded a] -> Maybe [Lexeme Expanded a]
go' [[Lexeme Expanded a]]
es
      where
        go' :: [Lexeme Expanded a] -> Maybe [Lexeme Expanded a]
go' [Lexeme Expanded a]
g | [Lexeme Expanded a]
g [Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
forall (a :: LexemeType).
[Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
`elemAuto` [[Lexeme Expanded a]]
new = Maybe [Lexeme Expanded a]
forall a. Maybe a
Nothing
        go' [Autosegment [Char]
n [[([Char], Bool)]]
kvs [[Char]]
gs] =
            [Lexeme Expanded a] -> Maybe [Lexeme Expanded a]
forall a. a -> Maybe a
Just [[Char] -> [[([Char], Bool)]] -> [[Char]] -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> [[([Char], Bool)]] -> [[Char]] -> Lexeme category a
Autosegment [Char]
n
                  (([Lexeme Expanded a] -> Bool)
-> [[([Char], Bool)]] -> [[([Char], Bool)]]
forall (a :: LexemeType).
([Lexeme Expanded a] -> Bool)
-> [[([Char], Bool)]] -> [[([Char], Bool)]]
filterkvs ([Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Lexeme Expanded a]]
new) [[([Char], Bool)]]
kvs)
                  (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Lexeme Expanded a]]
new) ([Lexeme Expanded a] -> Bool)
-> ([Char] -> [Lexeme Expanded a]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Expanded a -> [Lexeme Expanded a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lexeme Expanded a -> [Lexeme Expanded a])
-> ([Char] -> Lexeme Expanded a) -> [Char] -> [Lexeme Expanded a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> Lexeme category a
Grapheme) [[Char]]
gs)]
        go' [Lexeme Expanded a]
g = [Lexeme Expanded a] -> Maybe [Lexeme Expanded a]
forall a. a -> Maybe a
Just [Lexeme Expanded a]
g

    intersectC :: forall (a :: LexemeType).
[[Lexeme Expanded a]]
-> [[Lexeme Expanded a]] -> [[Lexeme Expanded a]]
intersectC [[Lexeme Expanded a]]
es [[Lexeme Expanded a]]
new = ([Lexeme Expanded a] -> Maybe [Lexeme Expanded a])
-> [[Lexeme Expanded a]] -> [[Lexeme Expanded a]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Lexeme Expanded a] -> Maybe [Lexeme Expanded a]
go' [[Lexeme Expanded a]]
new
      where
        go' :: [Lexeme Expanded a] -> Maybe [Lexeme Expanded a]
go' [Lexeme Expanded a]
g | [Lexeme Expanded a]
g [Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
forall (a :: LexemeType).
[Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
`elemAuto` [[Lexeme Expanded a]]
es = [Lexeme Expanded a] -> Maybe [Lexeme Expanded a]
forall a. a -> Maybe a
Just [Lexeme Expanded a]
g
        go' [Autosegment [Char]
n [[([Char], Bool)]]
kvs [[Char]]
gs] =
            [Lexeme Expanded a] -> Maybe [Lexeme Expanded a]
forall a. a -> Maybe a
Just [[Char] -> [[([Char], Bool)]] -> [[Char]] -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> [[([Char], Bool)]] -> [[Char]] -> Lexeme category a
Autosegment [Char]
n
                  (([Lexeme Expanded a] -> Bool)
-> [[([Char], Bool)]] -> [[([Char], Bool)]]
forall (a :: LexemeType).
([Lexeme Expanded a] -> Bool)
-> [[([Char], Bool)]] -> [[([Char], Bool)]]
filterkvs ([Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Lexeme Expanded a]]
es) [[([Char], Bool)]]
kvs)
                  (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Lexeme Expanded a]]
es) ([Lexeme Expanded a] -> Bool)
-> ([Char] -> [Lexeme Expanded a]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Expanded a -> [Lexeme Expanded a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lexeme Expanded a -> [Lexeme Expanded a])
-> ([Char] -> Lexeme Expanded a) -> [Char] -> [Lexeme Expanded a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> Lexeme category a
Grapheme) [[Char]]
gs)]
        go' [Lexeme Expanded a]
_ = Maybe [Lexeme Expanded a]
forall a. Maybe a
Nothing

    elemAuto :: [Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
    elemAuto :: forall (a :: LexemeType).
[Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
elemAuto [Lexeme Expanded a]
_ [] = Bool
False
    elemAuto g' :: [Lexeme Expanded a]
g'@[Grapheme [Char]
gm] ([Autosegment [Char]
_ [[([Char], Bool)]]
_ [[Char]]
gs]:[[Lexeme Expanded a]]
ls) = ([Char]
gm [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
gs) Bool -> Bool -> Bool
|| [Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
forall (a :: LexemeType).
[Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
elemAuto [Lexeme Expanded a]
g' [[Lexeme Expanded a]]
ls
    elemAuto [Lexeme Expanded a]
g' ([Lexeme Expanded a]
g:[[Lexeme Expanded a]]
ls) = ([Lexeme Expanded a]
g' [Lexeme Expanded a] -> [Lexeme Expanded a] -> Bool
forall a. Eq a => a -> a -> Bool
== [Lexeme Expanded a]
g) Bool -> Bool -> Bool
|| [Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
forall (a :: LexemeType).
[Lexeme Expanded a] -> [[Lexeme Expanded a]] -> Bool
elemAuto [Lexeme Expanded a]
g' [[Lexeme Expanded a]]
ls

    filterkvs :: ([Lexeme Expanded a] -> Bool) -> [[(Grapheme, Bool)]] -> [[(Grapheme, Bool)]]
    filterkvs :: forall (a :: LexemeType).
([Lexeme Expanded a] -> Bool)
-> [[([Char], Bool)]] -> [[([Char], Bool)]]
filterkvs [Lexeme Expanded a] -> Bool
p = ([([Char], Bool)] -> [([Char], Bool)])
-> [[([Char], Bool)]] -> [[([Char], Bool)]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([([Char], Bool)] -> [([Char], Bool)])
 -> [[([Char], Bool)]] -> [[([Char], Bool)]])
-> ((([Char], Bool) -> ([Char], Bool))
    -> [([Char], Bool)] -> [([Char], Bool)])
-> (([Char], Bool) -> ([Char], Bool))
-> [[([Char], Bool)]]
-> [[([Char], Bool)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], Bool) -> ([Char], Bool))
-> [([Char], Bool)] -> [([Char], Bool)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([Char], Bool) -> ([Char], Bool))
 -> [[([Char], Bool)]] -> [[([Char], Bool)]])
-> (([Char], Bool) -> ([Char], Bool))
-> [[([Char], Bool)]]
-> [[([Char], Bool)]]
forall a b. (a -> b) -> a -> b
$ \([Char]
g, Bool
b) -> ([Char]
g, Bool
b Bool -> Bool -> Bool
&& [Lexeme Expanded a] -> Bool
p [[Char] -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> Lexeme category a
Grapheme [Char]
g])

expandLexeme :: Categories -> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme :: forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs (Grapheme [Char]
g)
    | Just ([Char]
g', Char
'~') <- [Char] -> Maybe ([Char], Char)
forall a. [a] -> Maybe ([a], a)
unsnoc [Char]
g
        = Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a b. b -> Either a b
Right (Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a))
-> Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a b. (a -> b) -> a -> b
$ [Char] -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> Lexeme category a
Grapheme [Char]
g'
    | Bool
otherwise =
        case [Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
forall (a :: LexemeType).
[Char] -> Categories -> Maybe (Either (Expanded a) AutosegmentDef)
lookup [Char]
g Categories
cs of
            Just (Left Expanded a
c) -> Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a b. b -> Either a b
Right (Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a))
-> Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a b. (a -> b) -> a -> b
$ Expanded a -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
category a -> Lexeme category a
Category Expanded a
c
            Just (Right AutosegmentDef
a) -> do
                [[[Char]]]
kvs <- Categories -> [Char] -> Either ExpandError [[[Char]]]
expandFeature Categories
cs (AutosegmentDef -> [Char]
autoFeature AutosegmentDef
a)
                Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a))
-> Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a b. (a -> b) -> a -> b
$ [Char] -> [[([Char], Bool)]] -> [[Char]] -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> [[([Char], Bool)]] -> [[Char]] -> Lexeme category a
Autosegment (AutosegmentDef -> [Char]
autoFeature AutosegmentDef
a) ((([[Char]] -> [([Char], Bool)]) -> [[[Char]]] -> [[([Char], Bool)]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(([[Char]] -> [([Char], Bool)])
 -> [[[Char]]] -> [[([Char], Bool)]])
-> (([Char] -> ([Char], Bool)) -> [[Char]] -> [([Char], Bool)])
-> ([Char] -> ([Char], Bool))
-> [[[Char]]]
-> [[([Char], Bool)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Char] -> ([Char], Bool)) -> [[Char]] -> [([Char], Bool)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (,Bool
True) [[[Char]]]
kvs) (AutosegmentDef -> [[Char]]
autoGraphemes AutosegmentDef
a)
            Maybe (Either (Expanded a) AutosegmentDef)
Nothing -> Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a b. b -> Either a b
Right (Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a))
-> Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a b. (a -> b) -> a -> b
$ [Char] -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> Lexeme category a
Grapheme [Char]
g
expandLexeme Categories
cs (Category CategorySpec a
c) = Expanded a -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
category a -> Lexeme category a
Category (Expanded a -> Lexeme Expanded a)
-> Either ExpandError (Expanded a)
-> Either ExpandError (Lexeme Expanded a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories -> CategorySpec a -> Either ExpandError (Expanded a)
forall (a :: LexemeType).
Categories -> CategorySpec a -> Either ExpandError (Expanded a)
expand Categories
cs CategorySpec a
c
expandLexeme Categories
cs (GreedyCategory CategorySpec 'Matched
c) = Expanded 'Matched -> Lexeme Expanded a
Expanded 'Matched -> Lexeme Expanded 'Matched
forall (category :: LexemeType -> *).
category 'Matched -> Lexeme category 'Matched
GreedyCategory (Expanded 'Matched -> Lexeme Expanded a)
-> Either ExpandError (Expanded 'Matched)
-> Either ExpandError (Lexeme Expanded a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories
-> CategorySpec 'Matched -> Either ExpandError (Expanded 'Matched)
forall (a :: LexemeType).
Categories -> CategorySpec a -> Either ExpandError (Expanded a)
expand Categories
cs CategorySpec 'Matched
c
expandLexeme Categories
cs (Optional [Lexeme CategorySpec a]
ls) = [Lexeme Expanded a] -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Lexeme category a] -> Lexeme category a
Optional ([Lexeme Expanded a] -> Lexeme Expanded a)
-> Either ExpandError [Lexeme Expanded a]
-> Either ExpandError (Lexeme Expanded a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a))
-> [Lexeme CategorySpec a]
-> Either ExpandError [Lexeme Expanded a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs) [Lexeme CategorySpec a]
ls
expandLexeme Categories
cs (GreedyOptional [Lexeme CategorySpec 'Matched]
ls) = [Lexeme Expanded 'Matched] -> Lexeme Expanded a
[Lexeme Expanded 'Matched] -> Lexeme Expanded 'Matched
forall (category :: LexemeType -> *).
[Lexeme category 'Matched] -> Lexeme category 'Matched
GreedyOptional ([Lexeme Expanded 'Matched] -> Lexeme Expanded a)
-> Either ExpandError [Lexeme Expanded 'Matched]
-> Either ExpandError (Lexeme Expanded a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Lexeme CategorySpec 'Matched
 -> Either ExpandError (Lexeme Expanded 'Matched))
-> [Lexeme CategorySpec 'Matched]
-> Either ExpandError [Lexeme Expanded 'Matched]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Categories
-> Lexeme CategorySpec 'Matched
-> Either ExpandError (Lexeme Expanded 'Matched)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs) [Lexeme CategorySpec 'Matched]
ls
expandLexeme Categories
_  Lexeme CategorySpec a
Metathesis = Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a b. b -> Either a b
Right Lexeme Expanded a
Lexeme Expanded 'Replacement
forall (category :: LexemeType -> *). Lexeme category 'Replacement
Metathesis
expandLexeme Categories
_  Lexeme CategorySpec a
Geminate = Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a b. b -> Either a b
Right Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a
Geminate
expandLexeme Categories
cs (Wildcard Lexeme CategorySpec a
l) = Lexeme Expanded a -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a -> Lexeme category a
Wildcard (Lexeme Expanded a -> Lexeme Expanded a)
-> Either ExpandError (Lexeme Expanded a)
-> Either ExpandError (Lexeme Expanded a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs Lexeme CategorySpec a
l
expandLexeme Categories
cs (Kleene Lexeme CategorySpec a
l) = Lexeme Expanded a -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a -> Lexeme category a
Kleene (Lexeme Expanded a -> Lexeme Expanded a)
-> Either ExpandError (Lexeme Expanded a)
-> Either ExpandError (Lexeme Expanded a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs Lexeme CategorySpec a
l
expandLexeme Categories
_  Lexeme CategorySpec a
Discard = Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a b. b -> Either a b
Right Lexeme Expanded a
Lexeme Expanded 'Replacement
forall (category :: LexemeType -> *). Lexeme category 'Replacement
Discard
expandLexeme Categories
cs (Backreference Either [Char] Int
i CategorySpec a
c) = Either [Char] Int -> Expanded a -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
Either [Char] Int -> category a -> Lexeme category a
Backreference Either [Char] Int
i (Expanded a -> Lexeme Expanded a)
-> Either ExpandError (Expanded a)
-> Either ExpandError (Lexeme Expanded a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories -> CategorySpec a -> Either ExpandError (Expanded a)
forall (a :: LexemeType).
Categories -> CategorySpec a -> Either ExpandError (Expanded a)
expand Categories
cs CategorySpec a
c
expandLexeme Categories
cs (Multiple CategorySpec 'Replacement
c) = Expanded 'Replacement -> Lexeme Expanded a
Expanded 'Replacement -> Lexeme Expanded 'Replacement
forall (category :: LexemeType -> *).
category 'Replacement -> Lexeme category 'Replacement
Multiple (Expanded 'Replacement -> Lexeme Expanded a)
-> Either ExpandError (Expanded 'Replacement)
-> Either ExpandError (Lexeme Expanded a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories
-> CategorySpec 'Replacement
-> Either ExpandError (Expanded 'Replacement)
forall (a :: LexemeType).
Categories -> CategorySpec a -> Either ExpandError (Expanded a)
expand Categories
cs CategorySpec 'Replacement
c
expandLexeme Categories
cs (Feature Bool
r [Char]
n Maybe [Char]
i [] Lexeme CategorySpec a
l) = do
    [[[Char]]]
kvs <- Categories -> [Char] -> Either ExpandError [[[Char]]]
expandFeature Categories
cs [Char]
n
    Lexeme Expanded a
l' <- Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs Lexeme CategorySpec a
l
    Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a))
-> Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a b. (a -> b) -> a -> b
$ Bool
-> [Char]
-> Maybe [Char]
-> [[[Char]]]
-> Lexeme Expanded a
-> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
Bool
-> [Char]
-> Maybe [Char]
-> [[[Char]]]
-> Lexeme category a
-> Lexeme category a
Feature Bool
r [Char]
n Maybe [Char]
i [[[Char]]]
kvs Lexeme Expanded a
l'
expandLexeme Categories
cs (Feature Bool
r [Char]
n Maybe [Char]
i [[[Char]]]
kvs Lexeme CategorySpec a
l) = Bool
-> [Char]
-> Maybe [Char]
-> [[[Char]]]
-> Lexeme Expanded a
-> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
Bool
-> [Char]
-> Maybe [Char]
-> [[[Char]]]
-> Lexeme category a
-> Lexeme category a
Feature Bool
r [Char]
n Maybe [Char]
i [[[Char]]]
kvs (Lexeme Expanded a -> Lexeme Expanded a)
-> Either ExpandError (Lexeme Expanded a)
-> Either ExpandError (Lexeme Expanded a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs Lexeme CategorySpec a
l
expandLexeme Categories
_  (Autosegment [Char]
n [[([Char], Bool)]]
kvs [[Char]]
gs) =
    -- in reality this case should never occur from parsed sound changes

    Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a))
-> Lexeme Expanded a -> Either ExpandError (Lexeme Expanded a)
forall a b. (a -> b) -> a -> b
$ [Char] -> [[([Char], Bool)]] -> [[Char]] -> Lexeme Expanded a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> [[([Char], Bool)]] -> [[Char]] -> Lexeme category a
Autosegment [Char]
n [[([Char], Bool)]]
kvs [[Char]]
gs

expandFeature :: Categories -> String -> Either ExpandError [[String]]
expandFeature :: Categories -> [Char] -> Either ExpandError [[[Char]]]
expandFeature Categories
cs [Char]
n = [[[Char]]] -> [[[Char]]]
forall a. [[a]] -> [[a]]
transpose ([[[Char]]] -> [[[Char]]])
-> ([([Char], [[Char]])] -> [[[Char]]])
-> [([Char], [[Char]])]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], [[Char]]) -> [[Char]])
-> [([Char], [[Char]])] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char], [[Char]]) -> [[Char]]
forall a b. (a, b) -> b
snd ([([Char], [[Char]])] -> [[[Char]]])
-> Either ExpandError [([Char], [[Char]])]
-> Either ExpandError [[[Char]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories -> [Char] -> Either ExpandError [([Char], [[Char]])]
lookupFeature Categories
cs [Char]
n

lookupFeature
    :: Categories
    -> String  -- ^ Feature name (no +/- prefix or +value suffix)

    -> Either ExpandError [(String, [String])]
lookupFeature :: Categories -> [Char] -> Either ExpandError [([Char], [[Char]])]
lookupFeature Categories
cs [Char]
n =
    let pluss :: M.Map String (String, Either (Expanded 'AnyPart) AutosegmentDef)
        pluss :: Map [Char] ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
pluss = ([Char]
 -> Either (Expanded 'AnyPart) AutosegmentDef
 -> Maybe ([Char], Either (Expanded 'AnyPart) AutosegmentDef))
-> Categories
-> Map [Char] ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
M.mapMaybeWithKey [Char]
-> Either (Expanded 'AnyPart) AutosegmentDef
-> Maybe ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
plusPrefix Categories
cs
    -- NB. consistency is guaranteed as 'elems' always returns items in ascending order

    in case Map [Char] ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
-> [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
forall k a. Map k a -> [a]
M.elems Map [Char] ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
pluss of
        [] -> ExpandError -> Either ExpandError [([Char], [[Char]])]
forall a b. a -> Either a b
Left (ExpandError -> Either ExpandError [([Char], [[Char]])])
-> ExpandError -> Either ExpandError [([Char], [[Char]])]
forall a b. (a -> b) -> a -> b
$ [Char] -> ExpandError
NotFound (Char
'+'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
n)
        [([Char]
"", Left (FromElements [[Lexeme Expanded 'AnyPart]]
positive))] ->
            case [Char]
-> Categories -> Maybe (Either (Expanded 'AnyPart) AutosegmentDef)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
n) Categories
cs of
                Just (Left (FromElements [[Lexeme Expanded 'AnyPart]]
negative))
                    | [[Lexeme Expanded 'AnyPart]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Lexeme Expanded 'AnyPart]]
positive Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [[Lexeme Expanded 'AnyPart]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Lexeme Expanded 'AnyPart]]
negative -> ExpandError -> Either ExpandError [([Char], [[Char]])]
forall a b. a -> Either a b
Left ExpandError
MismatchedLengths
                    | Just [[Char]]
positive' <- ([Lexeme Expanded 'AnyPart] -> Maybe [Char])
-> [[Lexeme Expanded 'AnyPart]] -> Maybe [[Char]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [Lexeme Expanded 'AnyPart] -> Maybe [Char]
getBaseValue [[Lexeme Expanded 'AnyPart]]
positive
                    , Just [[Char]]
negative' <- ([Lexeme Expanded 'AnyPart] -> Maybe [Char])
-> [[Lexeme Expanded 'AnyPart]] -> Maybe [[Char]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [Lexeme Expanded 'AnyPart] -> Maybe [Char]
getBaseValue [[Lexeme Expanded 'AnyPart]]
negative
                    -> [([Char], [[Char]])] -> Either ExpandError [([Char], [[Char]])]
forall a b. b -> Either a b
Right [([Char]
"-", [[Char]]
negative'), ([Char]
"+", [[Char]]
positive')]
                    | Bool
otherwise -> ExpandError -> Either ExpandError [([Char], [[Char]])]
forall a b. a -> Either a b
Left ExpandError
InvalidBaseValue
                Maybe (Either (Expanded 'AnyPart) AutosegmentDef)
_ -> ExpandError -> Either ExpandError [([Char], [[Char]])]
forall a b. a -> Either a b
Left (ExpandError -> Either ExpandError [([Char], [[Char]])])
-> ExpandError -> Either ExpandError [([Char], [[Char]])]
forall a b. (a -> b) -> a -> b
$ [Char] -> ExpandError
NotFound (Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
n)
        [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
kvs -> case (([Char], Either (Expanded 'AnyPart) AutosegmentDef)
 -> Maybe [[Lexeme Expanded 'AnyPart]])
-> [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
-> Maybe [[[Lexeme Expanded 'AnyPart]]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
-> Maybe [[Lexeme Expanded 'AnyPart]]
forall {a} {a :: LexemeType} {b}.
(a, Either (Expanded a) b) -> Maybe [CategoryElement Expanded a]
getCategory [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
kvs of
            Just vs :: [[[Lexeme Expanded 'AnyPart]]]
vs@([[Lexeme Expanded 'AnyPart]]
v:[[[Lexeme Expanded 'AnyPart]]]
vs')
                | ([[Lexeme Expanded 'AnyPart]] -> Bool)
-> [[[Lexeme Expanded 'AnyPart]]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (([[Lexeme Expanded 'AnyPart]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Lexeme Expanded 'AnyPart]]
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Int -> Bool)
-> ([[Lexeme Expanded 'AnyPart]] -> Int)
-> [[Lexeme Expanded 'AnyPart]]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Lexeme Expanded 'AnyPart]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[[Lexeme Expanded 'AnyPart]]]
vs' -> ExpandError -> Either ExpandError [([Char], [[Char]])]
forall a b. a -> Either a b
Left ExpandError
MismatchedLengths
                | Just [[[Char]]]
vs'' <- ([[Lexeme Expanded 'AnyPart]] -> Maybe [[Char]])
-> [[[Lexeme Expanded 'AnyPart]]] -> Maybe [[[Char]]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (([Lexeme Expanded 'AnyPart] -> Maybe [Char])
-> [[Lexeme Expanded 'AnyPart]] -> Maybe [[Char]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [Lexeme Expanded 'AnyPart] -> Maybe [Char]
getBaseValue) [[[Lexeme Expanded 'AnyPart]]]
vs
                -> [([Char], [[Char]])] -> Either ExpandError [([Char], [[Char]])]
forall a b. b -> Either a b
Right ([([Char], [[Char]])] -> Either ExpandError [([Char], [[Char]])])
-> [([Char], [[Char]])] -> Either ExpandError [([Char], [[Char]])]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[[Char]]] -> [([Char], [[Char]])]
forall a b. [a] -> [b] -> [(a, b)]
zip (([Char], Either (Expanded 'AnyPart) AutosegmentDef) -> [Char]
forall a b. (a, b) -> a
fst (([Char], Either (Expanded 'AnyPart) AutosegmentDef) -> [Char])
-> [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
-> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
kvs) [[[Char]]]
vs''
            Maybe [[[Lexeme Expanded 'AnyPart]]]
_ -> ExpandError -> Either ExpandError [([Char], [[Char]])]
forall a b. a -> Either a b
Left ExpandError
InvalidBaseValue
  where
    plusPrefix :: [Char]
-> Either (Expanded 'AnyPart) AutosegmentDef
-> Maybe ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
plusPrefix (Char
'+':[Char]
k) Either (Expanded 'AnyPart) AutosegmentDef
v = case [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
n [Char]
k of
        Just (Char
'+':[Char]
k') -> ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
-> Maybe ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
forall a. a -> Maybe a
Just ([Char]
k', Either (Expanded 'AnyPart) AutosegmentDef
v)
        Just [Char]
"" -> ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
-> Maybe ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
forall a. a -> Maybe a
Just ([Char]
"", Either (Expanded 'AnyPart) AutosegmentDef
v)
        Maybe [Char]
_ -> Maybe ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
forall a. Maybe a
Nothing
    plusPrefix [Char]
_ Either (Expanded 'AnyPart) AutosegmentDef
_ = Maybe ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
forall a. Maybe a
Nothing

    getCategory :: (a, Either (Expanded a) b) -> Maybe [CategoryElement Expanded a]
getCategory (a
_, Left (FromElements [CategoryElement Expanded a]
c)) = [CategoryElement Expanded a] -> Maybe [CategoryElement Expanded a]
forall a. a -> Maybe a
Just [CategoryElement Expanded a]
c
    getCategory (a, Either (Expanded a) b)
_ = Maybe [CategoryElement Expanded a]
forall a. Maybe a
Nothing

getBaseValue :: CategoryElement Expanded 'AnyPart -> Maybe String
getBaseValue :: [Lexeme Expanded 'AnyPart] -> Maybe [Char]
getBaseValue [Grapheme [Char]
g] = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
g
getBaseValue [Lexeme Expanded 'AnyPart]
_ = Maybe [Char]
forall a. Maybe a
Nothing

-- taken from base-4.19

unsnoc :: [a] -> Maybe ([a], a)
unsnoc :: forall a. [a] -> Maybe ([a], a)
unsnoc = (a -> Maybe ([a], a) -> Maybe ([a], a))
-> Maybe ([a], a) -> [a] -> Maybe ([a], a)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just (([a], a) -> Maybe ([a], a))
-> (Maybe ([a], a) -> ([a], a)) -> Maybe ([a], a) -> Maybe ([a], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], a) -> (([a], a) -> ([a], a)) -> Maybe ([a], a) -> ([a], a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([], a
x) (\(~([a]
a, a
b)) -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
a, a
b))) Maybe ([a], a)
forall a. Maybe a
Nothing
{-# INLINABLE unsnoc #-}

-- | Expand all categories in a given sound change 'Rule'.

expandRule :: Categories -> Rule CategorySpec -> Either ExpandError (Rule Expanded)
expandRule :: Categories
-> Rule CategorySpec -> Either ExpandError (Rule Expanded)
expandRule Categories
cs Rule CategorySpec
r = [Lexeme Expanded 'Matched]
-> [Lexeme Expanded 'Replacement]
-> [Environment Expanded]
-> Maybe (Environment Expanded)
-> Flags
-> [Char]
-> Rule Expanded
forall (c :: LexemeType -> *).
[Lexeme c 'Matched]
-> [Lexeme c 'Replacement]
-> [Environment c]
-> Maybe (Environment c)
-> Flags
-> [Char]
-> Rule c
Rule
    ([Lexeme Expanded 'Matched]
 -> [Lexeme Expanded 'Replacement]
 -> [Environment Expanded]
 -> Maybe (Environment Expanded)
 -> Flags
 -> [Char]
 -> Rule Expanded)
-> Either ExpandError [Lexeme Expanded 'Matched]
-> Either
     ExpandError
     ([Lexeme Expanded 'Replacement]
      -> [Environment Expanded]
      -> Maybe (Environment Expanded)
      -> Flags
      -> [Char]
      -> Rule Expanded)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Lexeme CategorySpec 'Matched
 -> Either ExpandError (Lexeme Expanded 'Matched))
-> [Lexeme CategorySpec 'Matched]
-> Either ExpandError [Lexeme Expanded 'Matched]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Categories
-> Lexeme CategorySpec 'Matched
-> Either ExpandError (Lexeme Expanded 'Matched)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs) (Rule CategorySpec -> [Lexeme CategorySpec 'Matched]
forall (c :: LexemeType -> *). Rule c -> [Lexeme c 'Matched]
target Rule CategorySpec
r)
    Either
  ExpandError
  ([Lexeme Expanded 'Replacement]
   -> [Environment Expanded]
   -> Maybe (Environment Expanded)
   -> Flags
   -> [Char]
   -> Rule Expanded)
-> Either ExpandError [Lexeme Expanded 'Replacement]
-> Either
     ExpandError
     ([Environment Expanded]
      -> Maybe (Environment Expanded)
      -> Flags
      -> [Char]
      -> Rule Expanded)
forall a b.
Either ExpandError (a -> b)
-> Either ExpandError a -> Either ExpandError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Lexeme CategorySpec 'Replacement
 -> Either ExpandError (Lexeme Expanded 'Replacement))
-> [Lexeme CategorySpec 'Replacement]
-> Either ExpandError [Lexeme Expanded 'Replacement]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Categories
-> Lexeme CategorySpec 'Replacement
-> Either ExpandError (Lexeme Expanded 'Replacement)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs) (Rule CategorySpec -> [Lexeme CategorySpec 'Replacement]
forall (c :: LexemeType -> *). Rule c -> [Lexeme c 'Replacement]
replacement Rule CategorySpec
r)
    Either
  ExpandError
  ([Environment Expanded]
   -> Maybe (Environment Expanded)
   -> Flags
   -> [Char]
   -> Rule Expanded)
-> Either ExpandError [Environment Expanded]
-> Either
     ExpandError
     (Maybe (Environment Expanded) -> Flags -> [Char] -> Rule Expanded)
forall a b.
Either ExpandError (a -> b)
-> Either ExpandError a -> Either ExpandError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([Lexeme CategorySpec 'Matched], [Lexeme CategorySpec 'Matched])
 -> Either ExpandError (Environment Expanded))
-> [([Lexeme CategorySpec 'Matched],
     [Lexeme CategorySpec 'Matched])]
-> Either ExpandError [Environment Expanded]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ([Lexeme CategorySpec 'Matched], [Lexeme CategorySpec 'Matched])
-> Either ExpandError (Environment Expanded)
expandEnvironment (Rule CategorySpec
-> [([Lexeme CategorySpec 'Matched],
     [Lexeme CategorySpec 'Matched])]
forall (c :: LexemeType -> *). Rule c -> [Environment c]
environment Rule CategorySpec
r)
    Either
  ExpandError
  (Maybe (Environment Expanded) -> Flags -> [Char] -> Rule Expanded)
-> Either ExpandError (Maybe (Environment Expanded))
-> Either ExpandError (Flags -> [Char] -> Rule Expanded)
forall a b.
Either ExpandError (a -> b)
-> Either ExpandError a -> Either ExpandError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([Lexeme CategorySpec 'Matched], [Lexeme CategorySpec 'Matched])
 -> Either ExpandError (Environment Expanded))
-> Maybe
     ([Lexeme CategorySpec 'Matched], [Lexeme CategorySpec 'Matched])
-> Either ExpandError (Maybe (Environment Expanded))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ([Lexeme CategorySpec 'Matched], [Lexeme CategorySpec 'Matched])
-> Either ExpandError (Environment Expanded)
expandEnvironment (Rule CategorySpec
-> Maybe
     ([Lexeme CategorySpec 'Matched], [Lexeme CategorySpec 'Matched])
forall (c :: LexemeType -> *). Rule c -> Maybe (Environment c)
exception Rule CategorySpec
r)
    Either ExpandError (Flags -> [Char] -> Rule Expanded)
-> Either ExpandError Flags
-> Either ExpandError ([Char] -> Rule Expanded)
forall a b.
Either ExpandError (a -> b)
-> Either ExpandError a -> Either ExpandError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Flags -> Either ExpandError Flags
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rule CategorySpec -> Flags
forall (c :: LexemeType -> *). Rule c -> Flags
flags Rule CategorySpec
r)
    Either ExpandError ([Char] -> Rule Expanded)
-> Either ExpandError [Char] -> Either ExpandError (Rule Expanded)
forall a b.
Either ExpandError (a -> b)
-> Either ExpandError a -> Either ExpandError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Either ExpandError [Char]
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rule CategorySpec -> [Char]
forall (c :: LexemeType -> *). Rule c -> [Char]
plaintext Rule CategorySpec
r)
  where
    expandEnvironment :: ([Lexeme CategorySpec 'Matched], [Lexeme CategorySpec 'Matched])
-> Either ExpandError (Environment Expanded)
expandEnvironment ([Lexeme CategorySpec 'Matched]
e1, [Lexeme CategorySpec 'Matched]
e2) = (,)
        ([Lexeme Expanded 'Matched]
 -> [Lexeme Expanded 'Matched] -> Environment Expanded)
-> Either ExpandError [Lexeme Expanded 'Matched]
-> Either
     ExpandError ([Lexeme Expanded 'Matched] -> Environment Expanded)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Lexeme CategorySpec 'Matched
 -> Either ExpandError (Lexeme Expanded 'Matched))
-> [Lexeme CategorySpec 'Matched]
-> Either ExpandError [Lexeme Expanded 'Matched]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Categories
-> Lexeme CategorySpec 'Matched
-> Either ExpandError (Lexeme Expanded 'Matched)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs) [Lexeme CategorySpec 'Matched]
e1
        Either
  ExpandError ([Lexeme Expanded 'Matched] -> Environment Expanded)
-> Either ExpandError [Lexeme Expanded 'Matched]
-> Either ExpandError (Environment Expanded)
forall a b.
Either ExpandError (a -> b)
-> Either ExpandError a -> Either ExpandError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Lexeme CategorySpec 'Matched
 -> Either ExpandError (Lexeme Expanded 'Matched))
-> [Lexeme CategorySpec 'Matched]
-> Either ExpandError [Lexeme Expanded 'Matched]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Categories
-> Lexeme CategorySpec 'Matched
-> Either ExpandError (Lexeme Expanded 'Matched)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs) [Lexeme CategorySpec 'Matched]
e2

expandFilter :: Categories -> Filter CategorySpec -> Either ExpandError (Filter Expanded)
expandFilter :: Categories
-> Filter CategorySpec -> Either ExpandError (Filter Expanded)
expandFilter Categories
cs (Filter [Char]
p [Lexeme CategorySpec 'Matched]
f) = [Char] -> [Lexeme Expanded 'Matched] -> Filter Expanded
forall (c :: LexemeType -> *).
[Char] -> [Lexeme c 'Matched] -> Filter c
Filter [Char]
p ([Lexeme Expanded 'Matched] -> Filter Expanded)
-> Either ExpandError [Lexeme Expanded 'Matched]
-> Either ExpandError (Filter Expanded)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Lexeme CategorySpec 'Matched
 -> Either ExpandError (Lexeme Expanded 'Matched))
-> [Lexeme CategorySpec 'Matched]
-> Either ExpandError [Lexeme Expanded 'Matched]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Categories
-> Lexeme CategorySpec 'Matched
-> Either ExpandError (Lexeme Expanded 'Matched)
forall (a :: LexemeType).
Categories
-> Lexeme CategorySpec a -> Either ExpandError (Lexeme Expanded a)
expandLexeme Categories
cs) [Lexeme CategorySpec 'Matched]
f

-- | Extend a set of previously defined t'Categories' to give the

-- resulting state after a v'Categories' directive.

extendCategories
    :: Categories
    -> (Bool, [CategoryDefinition])  -- ^ The fields of a v'Categories' directive

    -> Either ExpandError Categories
extendCategories :: Categories
-> (Bool, [CategoryDefinition]) -> Either ExpandError Categories
extendCategories Categories
cs' (Bool
overwrite, [CategoryDefinition]
defs) =
    (Categories -> CategoryDefinition -> Either ExpandError Categories)
-> Categories
-> [CategoryDefinition]
-> Either ExpandError Categories
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Categories -> CategoryDefinition -> Either ExpandError Categories
go (if Bool
overwrite then Categories
forall k a. Map k a
M.empty else Categories
cs') [CategoryDefinition]
defs
  where
    go :: Categories -> CategoryDefinition -> Either ExpandError Categories
    go :: Categories -> CategoryDefinition -> Either ExpandError Categories
go Categories
cs (DefineCategory [Char]
name CategorySpec 'AnyPart
val) = (Either (Expanded 'AnyPart) AutosegmentDef
 -> Categories -> Categories)
-> Categories
-> Either (Expanded 'AnyPart) AutosegmentDef
-> Categories
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Char]
-> Either (Expanded 'AnyPart) AutosegmentDef
-> Categories
-> Categories
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert [Char]
name) Categories
cs (Either (Expanded 'AnyPart) AutosegmentDef -> Categories)
-> (Expanded 'AnyPart -> Either (Expanded 'AnyPart) AutosegmentDef)
-> Expanded 'AnyPart
-> Categories
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expanded 'AnyPart -> Either (Expanded 'AnyPart) AutosegmentDef
forall a b. a -> Either a b
Left (Expanded 'AnyPart -> Categories)
-> Either ExpandError (Expanded 'AnyPart)
-> Either ExpandError Categories
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories
-> CategorySpec 'AnyPart -> Either ExpandError (Expanded 'AnyPart)
forall (a :: LexemeType).
Categories -> CategorySpec a -> Either ExpandError (Expanded a)
expand Categories
cs CategorySpec 'AnyPart
val
    go Categories
cs (DefineFeature FeatureSpec
spec) = do
        Expanded 'AnyPart
baseValues <- Categories
-> CategorySpec 'AnyPart -> Either ExpandError (Expanded 'AnyPart)
forall (a :: LexemeType).
Categories -> CategorySpec a -> Either ExpandError (Expanded a)
expand Categories
cs (CategorySpec 'AnyPart -> Either ExpandError (Expanded 'AnyPart))
-> CategorySpec 'AnyPart -> Either ExpandError (Expanded 'AnyPart)
forall a b. (a -> b) -> a -> b
$ FeatureSpec -> CategorySpec 'AnyPart
featureBaseValues FeatureSpec
spec
        [([Char], Expanded 'AnyPart)]
derivedCats <- (([Char], CategorySpec 'AnyPart)
 -> Either ExpandError ([Char], Expanded 'AnyPart))
-> [([Char], CategorySpec 'AnyPart)]
-> Either ExpandError [([Char], Expanded 'AnyPart)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((CategorySpec 'AnyPart -> Either ExpandError (Expanded 'AnyPart))
-> ([Char], CategorySpec 'AnyPart)
-> Either ExpandError ([Char], Expanded 'AnyPart)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ([Char], a) -> f ([Char], b)
traverse ((CategorySpec 'AnyPart -> Either ExpandError (Expanded 'AnyPart))
 -> ([Char], CategorySpec 'AnyPart)
 -> Either ExpandError ([Char], Expanded 'AnyPart))
-> (CategorySpec 'AnyPart
    -> Either ExpandError (Expanded 'AnyPart))
-> ([Char], CategorySpec 'AnyPart)
-> Either ExpandError ([Char], Expanded 'AnyPart)
forall a b. (a -> b) -> a -> b
$ Categories
-> CategorySpec 'AnyPart -> Either ExpandError (Expanded 'AnyPart)
forall (a :: LexemeType).
Categories -> CategorySpec a -> Either ExpandError (Expanded a)
expand Categories
cs) ([([Char], CategorySpec 'AnyPart)]
 -> Either ExpandError [([Char], Expanded 'AnyPart)])
-> [([Char], CategorySpec 'AnyPart)]
-> Either ExpandError [([Char], Expanded 'AnyPart)]
forall a b. (a -> b) -> a -> b
$ FeatureSpec -> [([Char], CategorySpec 'AnyPart)]
featureDerived FeatureSpec
spec

        [[Char]]
baseValues' <- [[Lexeme Expanded 'AnyPart]]
-> ([Lexeme Expanded 'AnyPart] -> Either ExpandError [Char])
-> Either ExpandError [[Char]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Expanded 'AnyPart -> [[Lexeme Expanded 'AnyPart]]
forall (a :: LexemeType).
Expanded a -> [CategoryElement Expanded a]
elements Expanded 'AnyPart
baseValues) (([Lexeme Expanded 'AnyPart] -> Either ExpandError [Char])
 -> Either ExpandError [[Char]])
-> ([Lexeme Expanded 'AnyPart] -> Either ExpandError [Char])
-> Either ExpandError [[Char]]
forall a b. (a -> b) -> a -> b
$
            Either ExpandError [Char]
-> ([Char] -> Either ExpandError [Char])
-> Maybe [Char]
-> Either ExpandError [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ExpandError -> Either ExpandError [Char]
forall a b. a -> Either a b
Left ExpandError
InvalidBaseValue) [Char] -> Either ExpandError [Char]
forall a b. b -> Either a b
Right (Maybe [Char] -> Either ExpandError [Char])
-> ([Lexeme Expanded 'AnyPart] -> Maybe [Char])
-> [Lexeme Expanded 'AnyPart]
-> Either ExpandError [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Lexeme Expanded 'AnyPart] -> Maybe [Char]
getBaseValue
        let baseLen :: Int
baseLen = [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
baseValues'
            derivedValues :: [[[Lexeme Expanded 'AnyPart]]]
derivedValues = Expanded 'AnyPart -> [[Lexeme Expanded 'AnyPart]]
forall (a :: LexemeType).
Expanded a -> [CategoryElement Expanded a]
elements (Expanded 'AnyPart -> [[Lexeme Expanded 'AnyPart]])
-> (([Char], Expanded 'AnyPart) -> Expanded 'AnyPart)
-> ([Char], Expanded 'AnyPart)
-> [[Lexeme Expanded 'AnyPart]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Expanded 'AnyPart) -> Expanded 'AnyPart
forall a b. (a, b) -> b
snd (([Char], Expanded 'AnyPart) -> [[Lexeme Expanded 'AnyPart]])
-> [([Char], Expanded 'AnyPart)] -> [[[Lexeme Expanded 'AnyPart]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], Expanded 'AnyPart)]
derivedCats
        Bool -> Either ExpandError () -> Either ExpandError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (([[Lexeme Expanded 'AnyPart]] -> Bool)
-> [[[Lexeme Expanded 'AnyPart]]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
baseLen) (Int -> Bool)
-> ([[Lexeme Expanded 'AnyPart]] -> Int)
-> [[Lexeme Expanded 'AnyPart]]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Lexeme Expanded 'AnyPart]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[[Lexeme Expanded 'AnyPart]]]
derivedValues) (Either ExpandError () -> Either ExpandError ())
-> Either ExpandError () -> Either ExpandError ()
forall a b. (a -> b) -> a -> b
$
            ExpandError -> Either ExpandError ()
forall a b. a -> Either a b
Left ExpandError
MismatchedLengths

        let features :: [([Char], Expanded 'AnyPart)]
features = ([Char]
 -> [[Lexeme Expanded 'AnyPart]] -> ([Char], Expanded 'AnyPart))
-> [[Char]]
-> [[[Lexeme Expanded 'AnyPart]]]
-> [([Char], Expanded 'AnyPart)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
               (\[Char]
base [[Lexeme Expanded 'AnyPart]]
ds -> ([Char]
base, [[Lexeme Expanded 'AnyPart]] -> Expanded 'AnyPart
forall (a :: LexemeType).
[CategoryElement Expanded a] -> Expanded a
FromElements ([[Lexeme Expanded 'AnyPart]] -> Expanded 'AnyPart)
-> [[Lexeme Expanded 'AnyPart]] -> Expanded 'AnyPart
forall a b. (a -> b) -> a -> b
$ [[Char] -> Lexeme Expanded 'AnyPart
forall (category :: LexemeType -> *) (a :: LexemeType).
[Char] -> Lexeme category a
Grapheme [Char]
base] [Lexeme Expanded 'AnyPart]
-> [[Lexeme Expanded 'AnyPart]] -> [[Lexeme Expanded 'AnyPart]]
forall a. a -> [a] -> [a]
: [[Lexeme Expanded 'AnyPart]]
ds))
               [[Char]]
baseValues'
               ([[[Lexeme Expanded 'AnyPart]]] -> [[[Lexeme Expanded 'AnyPart]]]
forall a. [[a]] -> [[a]]
transpose [[[Lexeme Expanded 'AnyPart]]]
derivedValues)
            newCats :: [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
newCats = (([Char], Expanded 'AnyPart)
 -> ([Char], Either (Expanded 'AnyPart) AutosegmentDef))
-> [([Char], Expanded 'AnyPart)]
-> [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expanded 'AnyPart -> Either (Expanded 'AnyPart) AutosegmentDef)
-> ([Char], Expanded 'AnyPart)
-> ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Expanded 'AnyPart -> Either (Expanded 'AnyPart) AutosegmentDef
forall a b. a -> Either a b
Left) ([([Char], Expanded 'AnyPart)]
 -> [([Char], Either (Expanded 'AnyPart) AutosegmentDef)])
-> [([Char], Expanded 'AnyPart)]
-> [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
forall a b. (a -> b) -> a -> b
$
                [([Char], Expanded 'AnyPart)]
-> ([Char] -> [([Char], Expanded 'AnyPart)])
-> Maybe [Char]
-> [([Char], Expanded 'AnyPart)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (([Char], Expanded 'AnyPart) -> [([Char], Expanded 'AnyPart)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Char], Expanded 'AnyPart) -> [([Char], Expanded 'AnyPart)])
-> ([Char] -> ([Char], Expanded 'AnyPart))
-> [Char]
-> [([Char], Expanded 'AnyPart)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Expanded 'AnyPart
baseValues)) (FeatureSpec -> Maybe [Char]
featureBaseName FeatureSpec
spec)
                [([Char], Expanded 'AnyPart)]
-> [([Char], Expanded 'AnyPart)] -> [([Char], Expanded 'AnyPart)]
forall a. [a] -> [a] -> [a]
++ [([Char], Expanded 'AnyPart)]
derivedCats
                [([Char], Expanded 'AnyPart)]
-> [([Char], Expanded 'AnyPart)] -> [([Char], Expanded 'AnyPart)]
forall a. [a] -> [a] -> [a]
++ [([Char], Expanded 'AnyPart)]
features
        Categories -> Either ExpandError Categories
forall a b. b -> Either a b
Right (Categories -> Either ExpandError Categories)
-> Categories -> Either ExpandError Categories
forall a b. (a -> b) -> a -> b
$ (Categories
 -> ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
 -> Categories)
-> Categories
-> [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
-> Categories
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((([Char], Either (Expanded 'AnyPart) AutosegmentDef)
 -> Categories -> Categories)
-> Categories
-> ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
-> Categories
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((([Char], Either (Expanded 'AnyPart) AutosegmentDef)
  -> Categories -> Categories)
 -> Categories
 -> ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
 -> Categories)
-> (([Char], Either (Expanded 'AnyPart) AutosegmentDef)
    -> Categories -> Categories)
-> Categories
-> ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
-> Categories
forall a b. (a -> b) -> a -> b
$ ([Char]
 -> Either (Expanded 'AnyPart) AutosegmentDef
 -> Categories
 -> Categories)
-> ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
-> Categories
-> Categories
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char]
-> Either (Expanded 'AnyPart) AutosegmentDef
-> Categories
-> Categories
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert) Categories
cs [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
newCats
    go Categories
cs (DefineAuto [Char]
catName) = do
        let ([Char]
featureName, [Char]
featureValue) = case [Char]
catName of
                Char
'-':[Char]
n -> ([Char]
n, [Char]
"-")
                Char
'+':[Char]
n -> case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'+') [Char]
n of
                    ([Char]
prefix, Char
'+':[Char]
suffix) -> ([Char]
prefix, [Char]
suffix)
                    ([Char]
_, []) -> ([Char]
n, [Char]
"+")
                    ([Char], [Char])
_ -> [Char] -> ([Char], [Char])
forall a. HasCallStack => [Char] -> a
error [Char]
"extendCategories: unexpected output from 'break'"
                [Char]
n -> ([Char]
n, [Char]
"")  -- let it error out below

        Map [Char] [[Char]]
features <- [([Char], [[Char]])] -> Map [Char] [[Char]]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([Char], [[Char]])] -> Map [Char] [[Char]])
-> Either ExpandError [([Char], [[Char]])]
-> Either ExpandError (Map [Char] [[Char]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories -> [Char] -> Either ExpandError [([Char], [[Char]])]
lookupFeature Categories
cs [Char]
featureName
        case [Char] -> Map [Char] [[Char]] -> Maybe [[Char]]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
featureValue Map [Char] [[Char]]
features of
            Maybe [[Char]]
Nothing -> ExpandError -> Either ExpandError Categories
forall a b. a -> Either a b
Left (ExpandError -> Either ExpandError Categories)
-> ExpandError -> Either ExpandError Categories
forall a b. (a -> b) -> a -> b
$ [Char] -> ExpandError
NotFound [Char]
catName
            Just [[Char]]
gs ->
                -- NB. consistency is guaranteed as 'elems' always returns items in ascending order

                let autoCs :: Categories
autoCs = [([Char], Either (Expanded 'AnyPart) AutosegmentDef)] -> Categories
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
 -> Categories)
-> [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
-> Categories
forall a b. (a -> b) -> a -> b
$
                        ([Char]
 -> [[Char]] -> ([Char], Either (Expanded 'AnyPart) AutosegmentDef))
-> [[Char]]
-> [[[Char]]]
-> [([Char], Either (Expanded 'AnyPart) AutosegmentDef)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([Char]
-> [Char]
-> [[Char]]
-> ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
mkAuto [Char]
featureName) [[Char]]
gs ([[[Char]]] -> [[[Char]]]
forall a. [[a]] -> [[a]]
transpose ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> a -> b
$ Map [Char] [[Char]] -> [[[Char]]]
forall k a. Map k a -> [a]
M.elems Map [Char] [[Char]]
features)
                in Categories -> Either ExpandError Categories
forall a. a -> Either ExpandError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Categories -> Either ExpandError Categories)
-> Categories -> Either ExpandError Categories
forall a b. (a -> b) -> a -> b
$ SimpleWhenMissing
  [Char]
  (Either (Expanded 'AnyPart) AutosegmentDef)
  (Either (Expanded 'AnyPart) AutosegmentDef)
-> SimpleWhenMissing
     [Char]
     (Either (Expanded 'AnyPart) AutosegmentDef)
     (Either (Expanded 'AnyPart) AutosegmentDef)
-> SimpleWhenMatched
     [Char]
     (Either (Expanded 'AnyPart) AutosegmentDef)
     (Either (Expanded 'AnyPart) AutosegmentDef)
     (Either (Expanded 'AnyPart) AutosegmentDef)
-> Categories
-> Categories
-> Categories
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
M.merge
                    SimpleWhenMissing
  [Char]
  (Either (Expanded 'AnyPart) AutosegmentDef)
  (Either (Expanded 'AnyPart) AutosegmentDef)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing SimpleWhenMissing
  [Char]
  (Either (Expanded 'AnyPart) AutosegmentDef)
  (Either (Expanded 'AnyPart) AutosegmentDef)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing
                    (([Char]
 -> Either (Expanded 'AnyPart) AutosegmentDef
 -> Either (Expanded 'AnyPart) AutosegmentDef
 -> Either (Expanded 'AnyPart) AutosegmentDef)
-> SimpleWhenMatched
     [Char]
     (Either (Expanded 'AnyPart) AutosegmentDef)
     (Either (Expanded 'AnyPart) AutosegmentDef)
     (Either (Expanded 'AnyPart) AutosegmentDef)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
M.zipWithMatched (([Char]
  -> Either (Expanded 'AnyPart) AutosegmentDef
  -> Either (Expanded 'AnyPart) AutosegmentDef
  -> Either (Expanded 'AnyPart) AutosegmentDef)
 -> SimpleWhenMatched
      [Char]
      (Either (Expanded 'AnyPart) AutosegmentDef)
      (Either (Expanded 'AnyPart) AutosegmentDef)
      (Either (Expanded 'AnyPart) AutosegmentDef))
-> ([Char]
    -> Either (Expanded 'AnyPart) AutosegmentDef
    -> Either (Expanded 'AnyPart) AutosegmentDef
    -> Either (Expanded 'AnyPart) AutosegmentDef)
-> SimpleWhenMatched
     [Char]
     (Either (Expanded 'AnyPart) AutosegmentDef)
     (Either (Expanded 'AnyPart) AutosegmentDef)
     (Either (Expanded 'AnyPart) AutosegmentDef)
forall a b. (a -> b) -> a -> b
$ \[Char]
_ Either (Expanded 'AnyPart) AutosegmentDef
_ Either (Expanded 'AnyPart) AutosegmentDef
c -> Either (Expanded 'AnyPart) AutosegmentDef
c)
                    Categories
cs Categories
autoCs

    mkAuto :: String -> String -> [String] -> (String, Either (Expanded 'AnyPart) AutosegmentDef)
    mkAuto :: [Char]
-> [Char]
-> [[Char]]
-> ([Char], Either (Expanded 'AnyPart) AutosegmentDef)
mkAuto [Char]
f [Char]
g [[Char]]
gs = ([Char]
g, AutosegmentDef -> Either (Expanded 'AnyPart) AutosegmentDef
forall a b. b -> Either a b
Right (AutosegmentDef -> Either (Expanded 'AnyPart) AutosegmentDef)
-> AutosegmentDef -> Either (Expanded 'AnyPart) AutosegmentDef
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> AutosegmentDef
AutosegmentDef [Char]
f [[Char]]
gs)

-- | Expand a set of 'SoundChanges'. Expansion proceeds from beginning

-- to end as follows:

--

--     * Rules and filters are expanded by expanding all categories

--       within them (with 'expand'). Graphemes are replaced with

--       categories or autosegments if previously defined as such.

--

--     * If a v'Categories' definition block is found, the categories

--       defined within it are expanded and added to (or replace) the

--       list of current categories. The block is replaced with a list

--       of currently defined graphemes.

--

--     * If 'ExtraGraphemes' are found, they are added to a list of

--       currently defined graphemes. They are replaced with a

--       'GraphemeList' only if no categories are defined in the

--       'SoundChanges'.

expandSoundChanges
    :: SoundChanges CategorySpec Directive
    -> Either ExpandError (SoundChanges Expanded GraphemeList)
expandSoundChanges :: SoundChanges CategorySpec Directive
-> Either ExpandError (SoundChanges Expanded GraphemeList)
expandSoundChanges SoundChanges CategorySpec Directive
scs = ([Maybe (Statement Expanded GraphemeList)]
 -> SoundChanges Expanded GraphemeList)
-> Either ExpandError [Maybe (Statement Expanded GraphemeList)]
-> Either ExpandError (SoundChanges Expanded GraphemeList)
forall a b.
(a -> b) -> Either ExpandError a -> Either ExpandError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (Statement Expanded GraphemeList)]
-> SoundChanges Expanded GraphemeList
forall a. [Maybe a] -> [a]
catMaybes (Either ExpandError [Maybe (Statement Expanded GraphemeList)]
 -> Either ExpandError (SoundChanges Expanded GraphemeList))
-> Either ExpandError [Maybe (Statement Expanded GraphemeList)]
-> Either ExpandError (SoundChanges Expanded GraphemeList)
forall a b. (a -> b) -> a -> b
$ (StateT
   (Categories, [[Char]])
   (Either ExpandError)
   [Maybe (Statement Expanded GraphemeList)]
 -> (Categories, [[Char]])
 -> Either ExpandError [Maybe (Statement Expanded GraphemeList)])
-> (Categories, [[Char]])
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     [Maybe (Statement Expanded GraphemeList)]
-> Either ExpandError [Maybe (Statement Expanded GraphemeList)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  (Categories, [[Char]])
  (Either ExpandError)
  [Maybe (Statement Expanded GraphemeList)]
-> (Categories, [[Char]])
-> Either ExpandError [Maybe (Statement Expanded GraphemeList)]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Categories
forall k a. Map k a
M.empty, []) (StateT
   (Categories, [[Char]])
   (Either ExpandError)
   [Maybe (Statement Expanded GraphemeList)]
 -> Either ExpandError [Maybe (Statement Expanded GraphemeList)])
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     [Maybe (Statement Expanded GraphemeList)]
-> Either ExpandError [Maybe (Statement Expanded GraphemeList)]
forall a b. (a -> b) -> a -> b
$ (Statement CategorySpec Directive
 -> StateT
      (Categories, [[Char]])
      (Either ExpandError)
      (Maybe (Statement Expanded GraphemeList)))
-> SoundChanges CategorySpec Directive
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     [Maybe (Statement Expanded GraphemeList)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Statement CategorySpec Directive
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     (Maybe (Statement Expanded GraphemeList))
go SoundChanges CategorySpec Directive
scs
  where
    noCategories :: Bool
noCategories = (Statement CategorySpec Directive -> Bool)
-> SoundChanges CategorySpec Directive -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\case DeclS (Categories {}) -> Bool
True; Statement CategorySpec Directive
_ -> Bool
False) SoundChanges CategorySpec Directive
scs

    go  :: Statement CategorySpec Directive
        -> StateT
            (Categories, [String])
            (Either ExpandError)
            (Maybe (Statement Expanded GraphemeList))
    go :: Statement CategorySpec Directive
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     (Maybe (Statement Expanded GraphemeList))
go (RuleS Rule CategorySpec
r) = do
        Categories
cs <- ((Categories, [[Char]]) -> Categories)
-> StateT (Categories, [[Char]]) (Either ExpandError) Categories
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Categories, [[Char]]) -> Categories
forall a b. (a, b) -> a
fst
        Either ExpandError (Maybe (Statement Expanded GraphemeList))
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     (Maybe (Statement Expanded GraphemeList))
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Categories, [[Char]]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ExpandError (Maybe (Statement Expanded GraphemeList))
 -> StateT
      (Categories, [[Char]])
      (Either ExpandError)
      (Maybe (Statement Expanded GraphemeList)))
-> Either ExpandError (Maybe (Statement Expanded GraphemeList))
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     (Maybe (Statement Expanded GraphemeList))
forall a b. (a -> b) -> a -> b
$ Statement Expanded GraphemeList
-> Maybe (Statement Expanded GraphemeList)
forall a. a -> Maybe a
Just (Statement Expanded GraphemeList
 -> Maybe (Statement Expanded GraphemeList))
-> (Rule Expanded -> Statement Expanded GraphemeList)
-> Rule Expanded
-> Maybe (Statement Expanded GraphemeList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule Expanded -> Statement Expanded GraphemeList
forall (c :: LexemeType -> *) decl. Rule c -> Statement c decl
RuleS (Rule Expanded -> Maybe (Statement Expanded GraphemeList))
-> Either ExpandError (Rule Expanded)
-> Either ExpandError (Maybe (Statement Expanded GraphemeList))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories
-> Rule CategorySpec -> Either ExpandError (Rule Expanded)
expandRule Categories
cs Rule CategorySpec
r
    go (FilterS Filter CategorySpec
f) = do
        Categories
cs <- ((Categories, [[Char]]) -> Categories)
-> StateT (Categories, [[Char]]) (Either ExpandError) Categories
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Categories, [[Char]]) -> Categories
forall a b. (a, b) -> a
fst
        Either ExpandError (Maybe (Statement Expanded GraphemeList))
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     (Maybe (Statement Expanded GraphemeList))
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Categories, [[Char]]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ExpandError (Maybe (Statement Expanded GraphemeList))
 -> StateT
      (Categories, [[Char]])
      (Either ExpandError)
      (Maybe (Statement Expanded GraphemeList)))
-> Either ExpandError (Maybe (Statement Expanded GraphemeList))
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     (Maybe (Statement Expanded GraphemeList))
forall a b. (a -> b) -> a -> b
$ Statement Expanded GraphemeList
-> Maybe (Statement Expanded GraphemeList)
forall a. a -> Maybe a
Just (Statement Expanded GraphemeList
 -> Maybe (Statement Expanded GraphemeList))
-> (Filter Expanded -> Statement Expanded GraphemeList)
-> Filter Expanded
-> Maybe (Statement Expanded GraphemeList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Filter Expanded -> Statement Expanded GraphemeList
forall (c :: LexemeType -> *) decl. Filter c -> Statement c decl
FilterS (Filter Expanded -> Maybe (Statement Expanded GraphemeList))
-> Either ExpandError (Filter Expanded)
-> Either ExpandError (Maybe (Statement Expanded GraphemeList))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Categories
-> Filter CategorySpec -> Either ExpandError (Filter Expanded)
expandFilter Categories
cs Filter CategorySpec
f
    go Statement CategorySpec Directive
ReportS = Maybe (Statement Expanded GraphemeList)
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     (Maybe (Statement Expanded GraphemeList))
forall a. a -> StateT (Categories, [[Char]]) (Either ExpandError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Statement Expanded GraphemeList
-> Maybe (Statement Expanded GraphemeList)
forall a. a -> Maybe a
Just Statement Expanded GraphemeList
forall (c :: LexemeType -> *) decl. Statement c decl
ReportS)
    go (DeclS (ExtraGraphemes [[Char]]
extra)) = do
        (Categories
cs, [[Char]]
_) <- StateT
  (Categories, [[Char]]) (Either ExpandError) (Categories, [[Char]])
forall s (m :: * -> *). MonadState s m => m s
get
        (Categories, [[Char]])
-> StateT (Categories, [[Char]]) (Either ExpandError) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Categories
cs, [[Char]]
extra)
        Maybe (Statement Expanded GraphemeList)
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     (Maybe (Statement Expanded GraphemeList))
forall a. a -> StateT (Categories, [[Char]]) (Either ExpandError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Statement Expanded GraphemeList)
 -> StateT
      (Categories, [[Char]])
      (Either ExpandError)
      (Maybe (Statement Expanded GraphemeList)))
-> Maybe (Statement Expanded GraphemeList)
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     (Maybe (Statement Expanded GraphemeList))
forall a b. (a -> b) -> a -> b
$
            if Bool
noCategories
            then Statement Expanded GraphemeList
-> Maybe (Statement Expanded GraphemeList)
forall a. a -> Maybe a
Just (Statement Expanded GraphemeList
 -> Maybe (Statement Expanded GraphemeList))
-> Statement Expanded GraphemeList
-> Maybe (Statement Expanded GraphemeList)
forall a b. (a -> b) -> a -> b
$ GraphemeList -> Statement Expanded GraphemeList
forall (c :: LexemeType -> *) decl. decl -> Statement c decl
DeclS (GraphemeList -> Statement Expanded GraphemeList)
-> GraphemeList -> Statement Expanded GraphemeList
forall a b. (a -> b) -> a -> b
$ Bool -> [[Char]] -> GraphemeList
GraphemeList Bool
True [[Char]]
extra
            else Maybe (Statement Expanded GraphemeList)
forall a. Maybe a
Nothing
    go (DeclS (Categories Bool
overwrite Bool
noreplace [CategoryDefinition]
defs)) = do
        (Categories
cs, [[Char]]
extra) <- StateT
  (Categories, [[Char]]) (Either ExpandError) (Categories, [[Char]])
forall s (m :: * -> *). MonadState s m => m s
get
        Categories
cs' <- Either ExpandError Categories
-> StateT (Categories, [[Char]]) (Either ExpandError) Categories
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Categories, [[Char]]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ExpandError Categories
 -> StateT (Categories, [[Char]]) (Either ExpandError) Categories)
-> Either ExpandError Categories
-> StateT (Categories, [[Char]]) (Either ExpandError) Categories
forall a b. (a -> b) -> a -> b
$ Categories
-> (Bool, [CategoryDefinition]) -> Either ExpandError Categories
extendCategories Categories
cs (Bool
overwrite, [CategoryDefinition]
defs)
        (Categories, [[Char]])
-> StateT (Categories, [[Char]]) (Either ExpandError) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Categories
cs', [[Char]]
extra)
        Maybe (Statement Expanded GraphemeList)
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     (Maybe (Statement Expanded GraphemeList))
forall a. a -> StateT (Categories, [[Char]]) (Either ExpandError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Statement Expanded GraphemeList)
 -> StateT
      (Categories, [[Char]])
      (Either ExpandError)
      (Maybe (Statement Expanded GraphemeList)))
-> Maybe (Statement Expanded GraphemeList)
-> StateT
     (Categories, [[Char]])
     (Either ExpandError)
     (Maybe (Statement Expanded GraphemeList))
forall a b. (a -> b) -> a -> b
$ Statement Expanded GraphemeList
-> Maybe (Statement Expanded GraphemeList)
forall a. a -> Maybe a
Just (Statement Expanded GraphemeList
 -> Maybe (Statement Expanded GraphemeList))
-> Statement Expanded GraphemeList
-> Maybe (Statement Expanded GraphemeList)
forall a b. (a -> b) -> a -> b
$ GraphemeList -> Statement Expanded GraphemeList
forall (c :: LexemeType -> *) decl. decl -> Statement c decl
DeclS (GraphemeList -> Statement Expanded GraphemeList)
-> GraphemeList -> Statement Expanded GraphemeList
forall a b. (a -> b) -> a -> b
$ Bool -> [[Char]] -> GraphemeList
GraphemeList Bool
noreplace ([[Char]] -> GraphemeList) -> [[Char]] -> GraphemeList
forall a b. (a -> b) -> a -> b
$ [[Char]]
extra [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Lexeme Expanded 'AnyPart] -> Maybe [Char])
-> [[Lexeme Expanded 'AnyPart]] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Lexeme Expanded 'AnyPart] -> Maybe [Char]
forall {category :: LexemeType -> *} {a :: LexemeType}.
[Lexeme category a] -> Maybe [Char]
grapheme (Categories -> [[Lexeme Expanded 'AnyPart]]
values Categories
cs')

    grapheme :: [Lexeme category a] -> Maybe [Char]
grapheme [Grapheme [Char]
g] = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
g
    grapheme [Lexeme category a]
_ = Maybe [Char]
forall a. Maybe a
Nothing