{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DerivingVia           #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

-- |
-- Module      : Brassica.SoundChange.Types
-- Copyright   : See LICENSE file
-- License     : BSD3
-- Maintainer  : Brad Neimann
--
-- This module contains the types used to represent sound changes and
-- words in Brassica. In brief:
--
--     * A set of 'SoundChanges' is composed of a list of elements
--
--     * Their most important elements are sound change 'Rule's
--
--     * Sound changes are composed of 'Lexeme's denoting parts of the
--       input and output words
--
--     * Each word is a sequence of t'Grapheme's
--
-- For more details on the syntax and semantics of sound changes,
-- refer to the [reference guide](https://github.com/bradrn/brassica/blob/v1.0.0/docs/Reference.md).
module Brassica.SoundChange.Types
       (
       -- * Words and graphemes
         Grapheme
       , PWord
       , addBoundaries
       , removeBoundaries
       , concatWithBoundary
       -- * Lexemes
       , Lexeme(..)
       , LexemeType(..)
       , generalise
       -- * Categories
       , mapCategory
       , mapCategoryA
       , CategoryElement
       , CategorySpec(..)
       , CategoryModification(..)
       , Expanded(..)
       , generaliseExpanded
       -- * Rules
       , Rule(..)
       , Environment
       , Direction(..)
       , Sporadicity(..)
       , Flags(..)
       , defFlags
       -- * Statements
       , Filter(..)
       , Statement(..)
       , plaintext'
       , SoundChanges
       -- * Directives
       , Directive(..)
       , CategoryDefinition(..)
       , FeatureSpec(..)
       , GraphemeList(..)
       ) where

import Control.DeepSeq (NFData(..), deepseq)
import GHC.Generics (Generic)
import GHC.OldList (dropWhileEnd)

-- | The type of graphemes within a word. @"#"@ is taken to denote a
-- word boundary (whch is universally treated as a normal grapheme in
-- sound changes.)
type Grapheme = [Char]

-- | Brassica views a word, or a subsequence of one, as a list of
-- @Grapheme@s. For instance, Portuguese "filha" becomes
-- @["f", "i", "lh", "a"]@ when tokenised correctly.
--
-- (The name 'PWord' is from ‘phonological word’, these being what
-- sound changes typically manipulate. The name was chosen to avoid a
-- clash with @t'Word'@ from @base@.)
type PWord = [Grapheme]

-- | Add word boundaries (@"#"@) at the beginning and end of a 'PWord'.
addBoundaries :: PWord -> PWord
addBoundaries :: PWord -> PWord
addBoundaries PWord
w = Grapheme
"#" Grapheme -> PWord -> PWord
forall a. a -> [a] -> [a]
: PWord
w PWord -> PWord -> PWord
forall a. [a] -> [a] -> [a]
++ [Grapheme
"#"]

-- | Remove word boundaries (@"#"@) from the beginning and end of a 'PWord'.
removeBoundaries :: PWord -> PWord
removeBoundaries :: PWord -> PWord
removeBoundaries = (Grapheme -> Bool) -> PWord -> PWord
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Grapheme -> Grapheme -> Bool
forall a. Eq a => a -> a -> Bool
==Grapheme
"#") (PWord -> PWord) -> (PWord -> PWord) -> PWord -> PWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Grapheme -> Bool) -> PWord -> PWord
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Grapheme -> Grapheme -> Bool
forall a. Eq a => a -> a -> Bool
==Grapheme
"#")

-- | Render a 'PWord' as a 'String': does 'removeBoundaries' then 'concat'.
concatWithBoundary :: PWord -> String
concatWithBoundary :: PWord -> Grapheme
concatWithBoundary = PWord -> Grapheme
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (PWord -> Grapheme) -> (PWord -> PWord) -> PWord -> Grapheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PWord -> PWord
removeBoundaries

-- | The part of a 'Rule' in which a 'Lexeme' may occur.
data LexemeType
    = Matched      -- ^ In the target, environment or exception (‘matching’ position)
    | Replacement  -- ^ In the replacement only
    | AnyPart      -- ^ Not restricted to any one part

-- | Each part of a sound change is made up of a sequence of
-- 'Lexeme's. Each 'Lexeme' denotes part of an input or output word.
--
-- The first type variable @category@ is the type used to represent
-- categories within the sound change. This will usually be
-- 'CategorySpec' after parsing, or 'Expanded' after expansion.
--
-- The second type variable is phantom and represents the part of the
-- rule in which the lexeme is placed. Various lexemes are restricted
-- to 'Matched' or 'Replacement' positions respectively.
--
-- For details on the syntax and semantics of each kind of lexeme,
-- refer to the [reference guide](https://github.com/bradrn/brassica/blob/v1.0.0/docs/Reference.md).
data Lexeme category (a :: LexemeType) where
    Grapheme :: Grapheme -> Lexeme category a
    Category :: category a -> Lexeme category a
    -- | Written @%category@, matching-only
    GreedyCategory :: category 'Matched -> Lexeme category 'Matched
    -- | Written @(lexemes)@
    Optional :: [Lexeme category a] -> Lexeme category a
    -- | Written @%(lexemes)@, matching-only
    GreedyOptional :: [Lexeme category 'Matched] -> Lexeme category 'Matched
    -- | Written @\\@, replacement-only
    Metathesis :: Lexeme category 'Replacement
    -- | Written @>@
    Geminate :: Lexeme category a
    -- | Written @^lexeme@
    Wildcard :: Lexeme category a -> Lexeme category a
    -- | Written @lexeme*@
    Kleene   :: Lexeme category a -> Lexeme category a
    -- | Written @~@, replacement-only
    Discard  :: Lexeme category 'Replacement
    -- | Written @\@n category@ or @\@#id category@
    Backreference :: Either String Int -> category a -> Lexeme category a
    -- | Written @\@? category@
    Multiple :: category 'Replacement -> Lexeme category 'Replacement
    -- | Written @lexeme$Name@ or variations (see reference guide)
    Feature
        :: Bool                -- ^ 'True' iff the feature is negated
        -> String              -- ^ Feature name
        -> Maybe String        -- ^ Identifier if backreferenced, else 'Nothing'
        -> [[Grapheme]]        -- ^ List of correspondence sets
        -> Lexeme category a
        -> Lexeme category a
    -- | Not directly available in Brassica syntax, inserted in expansion
    Autosegment
        :: Grapheme                -- ^ Feature name
        -> [[(Grapheme, Bool)]]    -- ^ List of correspondence sets, with exclusion states
        -> [Grapheme]              -- ^ Graphemes to be matched by this 'Autosegment'
        -> Lexeme category a

-- | Map a function over any categories in the given 'Lexeme'.
mapCategory :: (forall x. c x -> c' x) -> Lexeme c a -> Lexeme c' a
mapCategory :: forall (c :: LexemeType -> *) (c' :: LexemeType -> *)
       (a :: LexemeType).
(forall (x :: LexemeType). c x -> c' x)
-> Lexeme c a -> Lexeme c' a
mapCategory forall (x :: LexemeType). c x -> c' x
_ (Grapheme Grapheme
g) = Grapheme -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> Lexeme category a
Grapheme Grapheme
g
mapCategory forall (x :: LexemeType). c x -> c' x
f (Category c a
c) = c' a -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
category a -> Lexeme category a
Category (c a -> c' a
forall (x :: LexemeType). c x -> c' x
f c a
c)
mapCategory forall (x :: LexemeType). c x -> c' x
f (GreedyCategory c 'Matched
c) = c' 'Matched -> Lexeme c' 'Matched
forall (category :: LexemeType -> *).
category 'Matched -> Lexeme category 'Matched
GreedyCategory (c 'Matched -> c' 'Matched
forall (x :: LexemeType). c x -> c' x
f c 'Matched
c)
mapCategory forall (x :: LexemeType). c x -> c' x
f (Optional [Lexeme c a]
ls) = [Lexeme c' a] -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Lexeme category a] -> Lexeme category a
Optional ((forall (x :: LexemeType). c x -> c' x)
-> Lexeme c a -> Lexeme c' a
forall (c :: LexemeType -> *) (c' :: LexemeType -> *)
       (a :: LexemeType).
(forall (x :: LexemeType). c x -> c' x)
-> Lexeme c a -> Lexeme c' a
mapCategory c x -> c' x
forall (x :: LexemeType). c x -> c' x
f (Lexeme c a -> Lexeme c' a) -> [Lexeme c a] -> [Lexeme c' a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Lexeme c a]
ls)
mapCategory forall (x :: LexemeType). c x -> c' x
f (GreedyOptional [Lexeme c 'Matched]
ls) = [Lexeme c' 'Matched] -> Lexeme c' 'Matched
forall (category :: LexemeType -> *).
[Lexeme category 'Matched] -> Lexeme category 'Matched
GreedyOptional ((forall (x :: LexemeType). c x -> c' x)
-> Lexeme c 'Matched -> Lexeme c' 'Matched
forall (c :: LexemeType -> *) (c' :: LexemeType -> *)
       (a :: LexemeType).
(forall (x :: LexemeType). c x -> c' x)
-> Lexeme c a -> Lexeme c' a
mapCategory c x -> c' x
forall (x :: LexemeType). c x -> c' x
f (Lexeme c 'Matched -> Lexeme c' 'Matched)
-> [Lexeme c 'Matched] -> [Lexeme c' 'Matched]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Lexeme c 'Matched]
ls)
mapCategory forall (x :: LexemeType). c x -> c' x
_ Lexeme c a
Metathesis = Lexeme c' a
Lexeme c' 'Replacement
forall (category :: LexemeType -> *). Lexeme category 'Replacement
Metathesis
mapCategory forall (x :: LexemeType). c x -> c' x
_ Lexeme c a
Geminate = Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a
Geminate
mapCategory forall (x :: LexemeType). c x -> c' x
f (Wildcard Lexeme c a
l) = Lexeme c' a -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a -> Lexeme category a
Wildcard ((forall (x :: LexemeType). c x -> c' x)
-> Lexeme c a -> Lexeme c' a
forall (c :: LexemeType -> *) (c' :: LexemeType -> *)
       (a :: LexemeType).
(forall (x :: LexemeType). c x -> c' x)
-> Lexeme c a -> Lexeme c' a
mapCategory c x -> c' x
forall (x :: LexemeType). c x -> c' x
f Lexeme c a
l)
mapCategory forall (x :: LexemeType). c x -> c' x
f (Kleene Lexeme c a
l) = Lexeme c' a -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a -> Lexeme category a
Kleene ((forall (x :: LexemeType). c x -> c' x)
-> Lexeme c a -> Lexeme c' a
forall (c :: LexemeType -> *) (c' :: LexemeType -> *)
       (a :: LexemeType).
(forall (x :: LexemeType). c x -> c' x)
-> Lexeme c a -> Lexeme c' a
mapCategory c x -> c' x
forall (x :: LexemeType). c x -> c' x
f Lexeme c a
l)
mapCategory forall (x :: LexemeType). c x -> c' x
_ Lexeme c a
Discard = Lexeme c' a
Lexeme c' 'Replacement
forall (category :: LexemeType -> *). Lexeme category 'Replacement
Discard
mapCategory forall (x :: LexemeType). c x -> c' x
f (Backreference Either Grapheme Int
i c a
c) = Either Grapheme Int -> c' a -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Either Grapheme Int -> category a -> Lexeme category a
Backreference Either Grapheme Int
i (c a -> c' a
forall (x :: LexemeType). c x -> c' x
f c a
c)
mapCategory forall (x :: LexemeType). c x -> c' x
f (Multiple c 'Replacement
c) = c' 'Replacement -> Lexeme c' 'Replacement
forall (category :: LexemeType -> *).
category 'Replacement -> Lexeme category 'Replacement
Multiple (c 'Replacement -> c' 'Replacement
forall (x :: LexemeType). c x -> c' x
f c 'Replacement
c)
mapCategory forall (x :: LexemeType). c x -> c' x
f (Feature Bool
r Grapheme
n Maybe Grapheme
i [PWord]
kvs Lexeme c a
l) = Bool
-> Grapheme
-> Maybe Grapheme
-> [PWord]
-> Lexeme c' a
-> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Bool
-> Grapheme
-> Maybe Grapheme
-> [PWord]
-> Lexeme category a
-> Lexeme category a
Feature Bool
r Grapheme
n Maybe Grapheme
i [PWord]
kvs (Lexeme c' a -> Lexeme c' a) -> Lexeme c' a -> Lexeme c' a
forall a b. (a -> b) -> a -> b
$ (forall (x :: LexemeType). c x -> c' x)
-> Lexeme c a -> Lexeme c' a
forall (c :: LexemeType -> *) (c' :: LexemeType -> *)
       (a :: LexemeType).
(forall (x :: LexemeType). c x -> c' x)
-> Lexeme c a -> Lexeme c' a
mapCategory c x -> c' x
forall (x :: LexemeType). c x -> c' x
f Lexeme c a
l
mapCategory forall (x :: LexemeType). c x -> c' x
_ (Autosegment Grapheme
n [[(Grapheme, Bool)]]
kvs PWord
gs) = Grapheme -> [[(Grapheme, Bool)]] -> PWord -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> [[(Grapheme, Bool)]] -> PWord -> Lexeme category a
Autosegment Grapheme
n [[(Grapheme, Bool)]]
kvs PWord
gs

-- | Like 'mapCategory', with an 'Applicative' effect.
mapCategoryA
    :: Applicative t
    => (forall x. c x -> t (c' x))
    -> Lexeme c a
    -> t (Lexeme c' a)
mapCategoryA :: forall (t :: * -> *) (c :: LexemeType -> *) (c' :: LexemeType -> *)
       (a :: LexemeType).
Applicative t =>
(forall (x :: LexemeType). c x -> t (c' x))
-> Lexeme c a -> t (Lexeme c' a)
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
_ (Grapheme Grapheme
g) = Lexeme c' a -> t (Lexeme c' a)
forall a. a -> t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lexeme c' a -> t (Lexeme c' a)) -> Lexeme c' a -> t (Lexeme c' a)
forall a b. (a -> b) -> a -> b
$ Grapheme -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> Lexeme category a
Grapheme Grapheme
g
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
f (Category c a
c) = c' a -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
category a -> Lexeme category a
Category (c' a -> Lexeme c' a) -> t (c' a) -> t (Lexeme c' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c a -> t (c' a)
forall (x :: LexemeType). c x -> t (c' x)
f c a
c
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
f (GreedyCategory c 'Matched
c) = c' 'Matched -> Lexeme c' a
c' 'Matched -> Lexeme c' 'Matched
forall (category :: LexemeType -> *).
category 'Matched -> Lexeme category 'Matched
GreedyCategory (c' 'Matched -> Lexeme c' a) -> t (c' 'Matched) -> t (Lexeme c' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c 'Matched -> t (c' 'Matched)
forall (x :: LexemeType). c x -> t (c' x)
f c 'Matched
c
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
f (Optional [Lexeme c a]
ls) = [Lexeme c' a] -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Lexeme category a] -> Lexeme category a
Optional ([Lexeme c' a] -> Lexeme c' a)
-> t [Lexeme c' a] -> t (Lexeme c' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Lexeme c a -> t (Lexeme c' a)) -> [Lexeme c a] -> t [Lexeme c' 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 ((forall (x :: LexemeType). c x -> t (c' x))
-> Lexeme c a -> t (Lexeme c' a)
forall (t :: * -> *) (c :: LexemeType -> *) (c' :: LexemeType -> *)
       (a :: LexemeType).
Applicative t =>
(forall (x :: LexemeType). c x -> t (c' x))
-> Lexeme c a -> t (Lexeme c' a)
mapCategoryA c x -> t (c' x)
forall (x :: LexemeType). c x -> t (c' x)
f) [Lexeme c a]
ls
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
f (GreedyOptional [Lexeme c 'Matched]
ls) = [Lexeme c' 'Matched] -> Lexeme c' a
[Lexeme c' 'Matched] -> Lexeme c' 'Matched
forall (category :: LexemeType -> *).
[Lexeme category 'Matched] -> Lexeme category 'Matched
GreedyOptional ([Lexeme c' 'Matched] -> Lexeme c' a)
-> t [Lexeme c' 'Matched] -> t (Lexeme c' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Lexeme c 'Matched -> t (Lexeme c' 'Matched))
-> [Lexeme c 'Matched] -> t [Lexeme c' '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 ((forall (x :: LexemeType). c x -> t (c' x))
-> Lexeme c 'Matched -> t (Lexeme c' 'Matched)
forall (t :: * -> *) (c :: LexemeType -> *) (c' :: LexemeType -> *)
       (a :: LexemeType).
Applicative t =>
(forall (x :: LexemeType). c x -> t (c' x))
-> Lexeme c a -> t (Lexeme c' a)
mapCategoryA c x -> t (c' x)
forall (x :: LexemeType). c x -> t (c' x)
f) [Lexeme c 'Matched]
ls
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
_ Lexeme c a
Metathesis = Lexeme c' a -> t (Lexeme c' a)
forall a. a -> t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Lexeme c' a
Lexeme c' 'Replacement
forall (category :: LexemeType -> *). Lexeme category 'Replacement
Metathesis
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
_ Lexeme c a
Geminate = Lexeme c' a -> t (Lexeme c' a)
forall a. a -> t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a
Geminate
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
f (Wildcard Lexeme c a
l) = Lexeme c' a -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a -> Lexeme category a
Wildcard (Lexeme c' a -> Lexeme c' a) -> t (Lexeme c' a) -> t (Lexeme c' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (x :: LexemeType). c x -> t (c' x))
-> Lexeme c a -> t (Lexeme c' a)
forall (t :: * -> *) (c :: LexemeType -> *) (c' :: LexemeType -> *)
       (a :: LexemeType).
Applicative t =>
(forall (x :: LexemeType). c x -> t (c' x))
-> Lexeme c a -> t (Lexeme c' a)
mapCategoryA c x -> t (c' x)
forall (x :: LexemeType). c x -> t (c' x)
f Lexeme c a
l
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
f (Kleene Lexeme c a
l) = Lexeme c' a -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a -> Lexeme category a
Kleene (Lexeme c' a -> Lexeme c' a) -> t (Lexeme c' a) -> t (Lexeme c' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (x :: LexemeType). c x -> t (c' x))
-> Lexeme c a -> t (Lexeme c' a)
forall (t :: * -> *) (c :: LexemeType -> *) (c' :: LexemeType -> *)
       (a :: LexemeType).
Applicative t =>
(forall (x :: LexemeType). c x -> t (c' x))
-> Lexeme c a -> t (Lexeme c' a)
mapCategoryA c x -> t (c' x)
forall (x :: LexemeType). c x -> t (c' x)
f Lexeme c a
l
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
_ Lexeme c a
Discard = Lexeme c' a -> t (Lexeme c' a)
forall a. a -> t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Lexeme c' a
Lexeme c' 'Replacement
forall (category :: LexemeType -> *). Lexeme category 'Replacement
Discard
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
f (Backreference Either Grapheme Int
i c a
c) = Either Grapheme Int -> c' a -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Either Grapheme Int -> category a -> Lexeme category a
Backreference Either Grapheme Int
i (c' a -> Lexeme c' a) -> t (c' a) -> t (Lexeme c' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c a -> t (c' a)
forall (x :: LexemeType). c x -> t (c' x)
f c a
c
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
f (Multiple c 'Replacement
c) = c' 'Replacement -> Lexeme c' a
c' 'Replacement -> Lexeme c' 'Replacement
forall (category :: LexemeType -> *).
category 'Replacement -> Lexeme category 'Replacement
Multiple (c' 'Replacement -> Lexeme c' a)
-> t (c' 'Replacement) -> t (Lexeme c' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c 'Replacement -> t (c' 'Replacement)
forall (x :: LexemeType). c x -> t (c' x)
f c 'Replacement
c
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
f (Feature Bool
r Grapheme
n Maybe Grapheme
i [PWord]
kvs Lexeme c a
l) = Bool
-> Grapheme
-> Maybe Grapheme
-> [PWord]
-> Lexeme c' a
-> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Bool
-> Grapheme
-> Maybe Grapheme
-> [PWord]
-> Lexeme category a
-> Lexeme category a
Feature Bool
r Grapheme
n Maybe Grapheme
i [PWord]
kvs (Lexeme c' a -> Lexeme c' a) -> t (Lexeme c' a) -> t (Lexeme c' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (x :: LexemeType). c x -> t (c' x))
-> Lexeme c a -> t (Lexeme c' a)
forall (t :: * -> *) (c :: LexemeType -> *) (c' :: LexemeType -> *)
       (a :: LexemeType).
Applicative t =>
(forall (x :: LexemeType). c x -> t (c' x))
-> Lexeme c a -> t (Lexeme c' a)
mapCategoryA c x -> t (c' x)
forall (x :: LexemeType). c x -> t (c' x)
f Lexeme c a
l
mapCategoryA forall (x :: LexemeType). c x -> t (c' x)
_ (Autosegment Grapheme
n [[(Grapheme, Bool)]]
kvs PWord
gs) = Lexeme c' a -> t (Lexeme c' a)
forall a. a -> t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lexeme c' a -> t (Lexeme c' a)) -> Lexeme c' a -> t (Lexeme c' a)
forall a b. (a -> b) -> a -> b
$ Grapheme -> [[(Grapheme, Bool)]] -> PWord -> Lexeme c' a
forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> [[(Grapheme, Bool)]] -> PWord -> Lexeme category a
Autosegment Grapheme
n [[(Grapheme, Bool)]]
kvs PWord
gs

-- | The type of a category after expansion: a simple list of
-- 'CategoryElement's.
newtype Expanded a = FromElements { forall (a :: LexemeType).
Expanded a -> [CategoryElement Expanded a]
elements :: [CategoryElement Expanded a] }
    deriving (Expanded a -> Expanded a -> Bool
(Expanded a -> Expanded a -> Bool)
-> (Expanded a -> Expanded a -> Bool) -> Eq (Expanded a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: LexemeType). Expanded a -> Expanded a -> Bool
$c== :: forall (a :: LexemeType). Expanded a -> Expanded a -> Bool
== :: Expanded a -> Expanded a -> Bool
$c/= :: forall (a :: LexemeType). Expanded a -> Expanded a -> Bool
/= :: Expanded a -> Expanded a -> Bool
Eq, Eq (Expanded a)
Eq (Expanded a) =>
(Expanded a -> Expanded a -> Ordering)
-> (Expanded a -> Expanded a -> Bool)
-> (Expanded a -> Expanded a -> Bool)
-> (Expanded a -> Expanded a -> Bool)
-> (Expanded a -> Expanded a -> Bool)
-> (Expanded a -> Expanded a -> Expanded a)
-> (Expanded a -> Expanded a -> Expanded a)
-> Ord (Expanded a)
Expanded a -> Expanded a -> Bool
Expanded a -> Expanded a -> Ordering
Expanded a -> Expanded a -> Expanded a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (x :: LexemeType). Eq (Expanded x)
forall (a :: LexemeType). Expanded a -> Expanded a -> Bool
forall (a :: LexemeType). Expanded a -> Expanded a -> Ordering
forall (a :: LexemeType). Expanded a -> Expanded a -> Expanded a
$ccompare :: forall (a :: LexemeType). Expanded a -> Expanded a -> Ordering
compare :: Expanded a -> Expanded a -> Ordering
$c< :: forall (a :: LexemeType). Expanded a -> Expanded a -> Bool
< :: Expanded a -> Expanded a -> Bool
$c<= :: forall (a :: LexemeType). Expanded a -> Expanded a -> Bool
<= :: Expanded a -> Expanded a -> Bool
$c> :: forall (a :: LexemeType). Expanded a -> Expanded a -> Bool
> :: Expanded a -> Expanded a -> Bool
$c>= :: forall (a :: LexemeType). Expanded a -> Expanded a -> Bool
>= :: Expanded a -> Expanded a -> Bool
$cmax :: forall (a :: LexemeType). Expanded a -> Expanded a -> Expanded a
max :: Expanded a -> Expanded a -> Expanded a
$cmin :: forall (a :: LexemeType). Expanded a -> Expanded a -> Expanded a
min :: Expanded a -> Expanded a -> Expanded a
Ord, Int -> Expanded a -> ShowS
[Expanded a] -> ShowS
Expanded a -> Grapheme
(Int -> Expanded a -> ShowS)
-> (Expanded a -> Grapheme)
-> ([Expanded a] -> ShowS)
-> Show (Expanded a)
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
forall (a :: LexemeType). Int -> Expanded a -> ShowS
forall (a :: LexemeType). [Expanded a] -> ShowS
forall (a :: LexemeType). Expanded a -> Grapheme
$cshowsPrec :: forall (a :: LexemeType). Int -> Expanded a -> ShowS
showsPrec :: Int -> Expanded a -> ShowS
$cshow :: forall (a :: LexemeType). Expanded a -> Grapheme
show :: Expanded a -> Grapheme
$cshowList :: forall (a :: LexemeType). [Expanded a] -> ShowS
showList :: [Expanded a] -> ShowS
Show, (forall x. Expanded a -> Rep (Expanded a) x)
-> (forall x. Rep (Expanded a) x -> Expanded a)
-> Generic (Expanded a)
forall x. Rep (Expanded a) x -> Expanded a
forall x. Expanded a -> Rep (Expanded a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: LexemeType) x. Rep (Expanded a) x -> Expanded a
forall (a :: LexemeType) x. Expanded a -> Rep (Expanded a) x
$cfrom :: forall (a :: LexemeType) x. Expanded a -> Rep (Expanded a) x
from :: forall x. Expanded a -> Rep (Expanded a) x
$cto :: forall (a :: LexemeType) x. Rep (Expanded a) x -> Expanded a
to :: forall x. Rep (Expanded a) x -> Expanded a
Generic, Expanded a -> ()
(Expanded a -> ()) -> NFData (Expanded a)
forall a. (a -> ()) -> NFData a
forall (a :: LexemeType). Expanded a -> ()
$crnf :: forall (a :: LexemeType). Expanded a -> ()
rnf :: Expanded a -> ()
NFData)

instance Semigroup (Expanded a) where
    (FromElements [CategoryElement Expanded a]
es) <> :: Expanded a -> Expanded a -> Expanded a
<> (FromElements [CategoryElement Expanded a]
es') = [CategoryElement Expanded a] -> Expanded a
forall (a :: LexemeType).
[CategoryElement Expanded a] -> Expanded a
FromElements ([CategoryElement Expanded a]
es [CategoryElement Expanded a]
-> [CategoryElement Expanded a] -> [CategoryElement Expanded a]
forall a. Semigroup a => a -> a -> a
<> [CategoryElement Expanded a]
es')

instance Monoid (Expanded a) where
    mempty :: Expanded a
mempty = [CategoryElement Expanded a] -> Expanded a
forall (a :: LexemeType).
[CategoryElement Expanded a] -> Expanded a
FromElements []

-- | Generalise a @'Lexeme' c ''AnyPart'@ so it can be used in any
-- specific part of a sound change, given a way to similarly
-- generalise any categories it contains.
generalise :: (c 'AnyPart -> c a) -> Lexeme c 'AnyPart -> Lexeme c a
generalise :: forall (c :: LexemeType -> *) (a :: LexemeType).
(c 'AnyPart -> c a) -> Lexeme c 'AnyPart -> Lexeme c a
generalise c 'AnyPart -> c a
_ (Grapheme Grapheme
g) = Grapheme -> Lexeme c a
forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> Lexeme category a
Grapheme Grapheme
g
generalise c 'AnyPart -> c a
f (Category c 'AnyPart
es) = c a -> Lexeme c a
forall (category :: LexemeType -> *) (a :: LexemeType).
category a -> Lexeme category a
Category (c a -> Lexeme c a) -> c a -> Lexeme c a
forall a b. (a -> b) -> a -> b
$ c 'AnyPart -> c a
f c 'AnyPart
es
generalise c 'AnyPart -> c a
f (Optional [Lexeme c 'AnyPart]
ls) = [Lexeme c a] -> Lexeme c a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Lexeme category a] -> Lexeme category a
Optional ([Lexeme c a] -> Lexeme c a) -> [Lexeme c a] -> Lexeme c a
forall a b. (a -> b) -> a -> b
$ (c 'AnyPart -> c a) -> Lexeme c 'AnyPart -> Lexeme c a
forall (c :: LexemeType -> *) (a :: LexemeType).
(c 'AnyPart -> c a) -> Lexeme c 'AnyPart -> Lexeme c a
generalise c 'AnyPart -> c a
f (Lexeme c 'AnyPart -> Lexeme c a)
-> [Lexeme c 'AnyPart] -> [Lexeme c a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Lexeme c 'AnyPart]
ls
generalise c 'AnyPart -> c a
_ Lexeme c 'AnyPart
Geminate = Lexeme c a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a
Geminate
generalise c 'AnyPart -> c a
f (Backreference Either Grapheme Int
i c 'AnyPart
es) = Either Grapheme Int -> c a -> Lexeme c a
forall (category :: LexemeType -> *) (a :: LexemeType).
Either Grapheme Int -> category a -> Lexeme category a
Backreference Either Grapheme Int
i (c a -> Lexeme c a) -> c a -> Lexeme c a
forall a b. (a -> b) -> a -> b
$ c 'AnyPart -> c a
f c 'AnyPart
es
generalise c 'AnyPart -> c a
f (Wildcard Lexeme c 'AnyPart
l) = Lexeme c a -> Lexeme c a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a -> Lexeme category a
Wildcard (Lexeme c a -> Lexeme c a) -> Lexeme c a -> Lexeme c a
forall a b. (a -> b) -> a -> b
$ (c 'AnyPart -> c a) -> Lexeme c 'AnyPart -> Lexeme c a
forall (c :: LexemeType -> *) (a :: LexemeType).
(c 'AnyPart -> c a) -> Lexeme c 'AnyPart -> Lexeme c a
generalise c 'AnyPart -> c a
f Lexeme c 'AnyPart
l
generalise c 'AnyPart -> c a
f (Kleene Lexeme c 'AnyPart
l) = Lexeme c a -> Lexeme c a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a -> Lexeme category a
Kleene (Lexeme c a -> Lexeme c a) -> Lexeme c a -> Lexeme c a
forall a b. (a -> b) -> a -> b
$ (c 'AnyPart -> c a) -> Lexeme c 'AnyPart -> Lexeme c a
forall (c :: LexemeType -> *) (a :: LexemeType).
(c 'AnyPart -> c a) -> Lexeme c 'AnyPart -> Lexeme c a
generalise c 'AnyPart -> c a
f Lexeme c 'AnyPart
l
generalise c 'AnyPart -> c a
f (Feature Bool
r Grapheme
n Maybe Grapheme
i [PWord]
kvs Lexeme c 'AnyPart
l) = Bool
-> Grapheme
-> Maybe Grapheme
-> [PWord]
-> Lexeme c a
-> Lexeme c a
forall (category :: LexemeType -> *) (a :: LexemeType).
Bool
-> Grapheme
-> Maybe Grapheme
-> [PWord]
-> Lexeme category a
-> Lexeme category a
Feature Bool
r Grapheme
n Maybe Grapheme
i [PWord]
kvs (Lexeme c a -> Lexeme c a) -> Lexeme c a -> Lexeme c a
forall a b. (a -> b) -> a -> b
$ (c 'AnyPart -> c a) -> Lexeme c 'AnyPart -> Lexeme c a
forall (c :: LexemeType -> *) (a :: LexemeType).
(c 'AnyPart -> c a) -> Lexeme c 'AnyPart -> Lexeme c a
generalise c 'AnyPart -> c a
f Lexeme c 'AnyPart
l
generalise c 'AnyPart -> c a
_ (Autosegment Grapheme
n [[(Grapheme, Bool)]]
kvs PWord
gs) = Grapheme -> [[(Grapheme, Bool)]] -> PWord -> Lexeme c a
forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> [[(Grapheme, Bool)]] -> PWord -> Lexeme category a
Autosegment Grapheme
n [[(Grapheme, Bool)]]
kvs PWord
gs

-- | Generalise an 'Expanded' category to be used in any part of a
-- sound change, similarly to 'generalise'.
generaliseExpanded :: Expanded 'AnyPart -> Expanded a
generaliseExpanded :: forall (a :: LexemeType). Expanded 'AnyPart -> Expanded a
generaliseExpanded = [CategoryElement Expanded a] -> Expanded a
forall (a :: LexemeType).
[CategoryElement Expanded a] -> Expanded a
FromElements ([CategoryElement Expanded a] -> Expanded a)
-> (Expanded 'AnyPart -> [CategoryElement Expanded a])
-> Expanded 'AnyPart
-> Expanded a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Lexeme Expanded 'AnyPart] -> CategoryElement Expanded a)
-> [[Lexeme Expanded 'AnyPart]] -> [CategoryElement Expanded a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(([Lexeme Expanded 'AnyPart] -> CategoryElement Expanded a)
 -> [[Lexeme Expanded 'AnyPart]] -> [CategoryElement Expanded a])
-> ((Lexeme Expanded 'AnyPart -> Lexeme Expanded a)
    -> [Lexeme Expanded 'AnyPart] -> CategoryElement Expanded a)
-> (Lexeme Expanded 'AnyPart -> Lexeme Expanded a)
-> [[Lexeme Expanded 'AnyPart]]
-> [CategoryElement Expanded a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Lexeme Expanded 'AnyPart -> Lexeme Expanded a)
-> [Lexeme Expanded 'AnyPart] -> CategoryElement Expanded a
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ((Expanded 'AnyPart -> Expanded a)
-> Lexeme Expanded 'AnyPart -> Lexeme Expanded a
forall (c :: LexemeType -> *) (a :: LexemeType).
(c 'AnyPart -> c a) -> Lexeme c 'AnyPart -> Lexeme c a
generalise Expanded 'AnyPart -> Expanded a
forall (a :: LexemeType). Expanded 'AnyPart -> Expanded a
generaliseExpanded) ([[Lexeme Expanded 'AnyPart]] -> [CategoryElement Expanded a])
-> (Expanded 'AnyPart -> [[Lexeme Expanded 'AnyPart]])
-> Expanded 'AnyPart
-> [CategoryElement Expanded a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expanded 'AnyPart -> [[Lexeme Expanded 'AnyPart]]
forall (a :: LexemeType).
Expanded a -> [CategoryElement Expanded a]
elements

deriving instance (forall x. Show (c x)) => Show (Lexeme c a)
deriving instance (forall x. Eq (c x)) => Eq (Lexeme c a)
deriving instance (forall x. Ord (c x)) => Ord (Lexeme c a)

instance (forall x. NFData (c x)) => NFData (Lexeme c a) where
    rnf :: Lexeme c a -> ()
rnf (Grapheme Grapheme
g) = Grapheme -> ()
forall a. NFData a => a -> ()
rnf Grapheme
g
    rnf (Category c a
cs) = c a -> ()
forall a. NFData a => a -> ()
rnf c a
cs
    rnf (GreedyCategory c 'Matched
cs) = c 'Matched -> ()
forall a. NFData a => a -> ()
rnf c 'Matched
cs
    rnf (Optional [Lexeme c a]
ls) = [Lexeme c a] -> ()
forall a. NFData a => a -> ()
rnf [Lexeme c a]
ls
    rnf (GreedyOptional [Lexeme c 'Matched]
ls) = [Lexeme c 'Matched] -> ()
forall a. NFData a => a -> ()
rnf [Lexeme c 'Matched]
ls
    rnf Lexeme c a
Metathesis = ()
    rnf Lexeme c a
Geminate = ()
    rnf (Wildcard Lexeme c a
l) = Lexeme c a -> ()
forall a. NFData a => a -> ()
rnf Lexeme c a
l
    rnf (Kleene Lexeme c a
l) = Lexeme c a -> ()
forall a. NFData a => a -> ()
rnf Lexeme c a
l
    rnf Lexeme c a
Discard = ()
    rnf (Backreference Either Grapheme Int
i c a
l) = Either Grapheme Int
i Either Grapheme Int -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` c a -> ()
forall a. NFData a => a -> ()
rnf c a
l
    rnf (Multiple c 'Replacement
l) = c 'Replacement -> ()
forall a. NFData a => a -> ()
rnf c 'Replacement
l
    rnf (Feature Bool
r Grapheme
n Maybe Grapheme
i [PWord]
kvs Lexeme c a
l) = Bool
r Bool -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Lexeme c a
l Lexeme c a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Grapheme
n Grapheme -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Maybe Grapheme
i Maybe Grapheme -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` [PWord] -> ()
forall a. NFData a => a -> ()
rnf [PWord]
kvs
    rnf (Autosegment Grapheme
n [[(Grapheme, Bool)]]
kvs PWord
gs) = Grapheme
n Grapheme -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` [[(Grapheme, Bool)]]
kvs [[(Grapheme, Bool)]] -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` PWord -> ()
forall a. NFData a => a -> ()
rnf PWord
gs

-- | An 'Environment' is a tuple of @(before, after)@ components,
-- corresponding to an environment or exception in a sound change:
-- @before _ after@.
--
-- (An empty environment is just @([], [])@.)
type Environment c = ([Lexeme c 'Matched], [Lexeme c 'Matched])

-- | Specifies application direction of rule: either left-to-right or right-to-left.
data Direction = LTR | RTL
    deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> Grapheme
(Int -> Direction -> ShowS)
-> (Direction -> Grapheme)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> Grapheme
show :: Direction -> Grapheme
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, (forall x. Direction -> Rep Direction x)
-> (forall x. Rep Direction x -> Direction) -> Generic Direction
forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Direction -> Rep Direction x
from :: forall x. Direction -> Rep Direction x
$cto :: forall x. Rep Direction x -> Direction
to :: forall x. Rep Direction x -> Direction
Generic, Direction -> ()
(Direction -> ()) -> NFData Direction
forall a. (a -> ()) -> NFData a
$crnf :: Direction -> ()
rnf :: Direction -> ()
NFData)

-- | Specifies how regularly a rule should be applied. A sporadic
-- rule will produce two or more results, preserving the input as one
-- of the outputs.
data Sporadicity
    = ApplyAlways
    -- ^ Always apply the rule
    | PerWord
    -- ^ Apply sporadically, either to the whole word or to none of the word
    | PerApplication
    -- ^ Apply sporadically, at each application site
    deriving (Sporadicity -> Sporadicity -> Bool
(Sporadicity -> Sporadicity -> Bool)
-> (Sporadicity -> Sporadicity -> Bool) -> Eq Sporadicity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sporadicity -> Sporadicity -> Bool
== :: Sporadicity -> Sporadicity -> Bool
$c/= :: Sporadicity -> Sporadicity -> Bool
/= :: Sporadicity -> Sporadicity -> Bool
Eq, Int -> Sporadicity -> ShowS
[Sporadicity] -> ShowS
Sporadicity -> Grapheme
(Int -> Sporadicity -> ShowS)
-> (Sporadicity -> Grapheme)
-> ([Sporadicity] -> ShowS)
-> Show Sporadicity
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sporadicity -> ShowS
showsPrec :: Int -> Sporadicity -> ShowS
$cshow :: Sporadicity -> Grapheme
show :: Sporadicity -> Grapheme
$cshowList :: [Sporadicity] -> ShowS
showList :: [Sporadicity] -> ShowS
Show, (forall x. Sporadicity -> Rep Sporadicity x)
-> (forall x. Rep Sporadicity x -> Sporadicity)
-> Generic Sporadicity
forall x. Rep Sporadicity x -> Sporadicity
forall x. Sporadicity -> Rep Sporadicity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Sporadicity -> Rep Sporadicity x
from :: forall x. Sporadicity -> Rep Sporadicity x
$cto :: forall x. Rep Sporadicity x -> Sporadicity
to :: forall x. Rep Sporadicity x -> Sporadicity
Generic, Sporadicity -> ()
(Sporadicity -> ()) -> NFData Sporadicity
forall a. (a -> ()) -> NFData a
$crnf :: Sporadicity -> ()
rnf :: Sporadicity -> ()
NFData)

-- | Flags which can be enabled, disabled or altered on a 'Rule' to
-- change how it is applied.
data Flags = Flags
  { Flags -> Bool
highlightChanges :: Bool         -- ^ Whether results from this sound change can be highlighted in a GUI
  , Flags -> Direction
applyDirection   :: Direction    -- ^ Direction in which to apply the rule
  , Flags -> Bool
applyOnceOnly    :: Bool         -- ^ Whether to apply the rule only once to a word
  , Flags -> Sporadicity
sporadic         :: Sporadicity  -- ^ Whether the rule should be applied sporadically, and if so, how
  , Flags -> Bool
nonOverlappingTarget :: Bool     -- ^ Whether the rule should apply non-iteratively (avoiding environments which overlap with targets)
  } deriving (Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> Grapheme
(Int -> Flags -> ShowS)
-> (Flags -> Grapheme) -> ([Flags] -> ShowS) -> Show Flags
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Flags -> ShowS
showsPrec :: Int -> Flags -> ShowS
$cshow :: Flags -> Grapheme
show :: Flags -> Grapheme
$cshowList :: [Flags] -> ShowS
showList :: [Flags] -> ShowS
Show, (forall x. Flags -> Rep Flags x)
-> (forall x. Rep Flags x -> Flags) -> Generic Flags
forall x. Rep Flags x -> Flags
forall x. Flags -> Rep Flags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Flags -> Rep Flags x
from :: forall x. Flags -> Rep Flags x
$cto :: forall x. Rep Flags x -> Flags
to :: forall x. Rep Flags x -> Flags
Generic, Flags -> ()
(Flags -> ()) -> NFData Flags
forall a. (a -> ()) -> NFData a
$crnf :: Flags -> ()
rnf :: Flags -> ()
NFData)

-- | A default selection of flags which are appropriate for most
-- rules:
--
-- @
-- 'defFlags' = 'Flags'
--     { 'highlightChanges' = 'True'
--     , 'applyDirection' = 'LTR'
--     , 'applyOnceOnly' = 'False'
--     , 'sporadic' = 'False'
--     , 'nonOverlappingTarget' = 'False'
--     }
-- @
--
-- That is: apply repeatedly and iteratively from left to right,
-- non-sporadically, with the results available for highlighting.
defFlags :: Flags
defFlags :: Flags
defFlags = Flags
    { highlightChanges :: Bool
highlightChanges = Bool
True
    , applyDirection :: Direction
applyDirection = Direction
LTR
    , applyOnceOnly :: Bool
applyOnceOnly = Bool
False
    , sporadic :: Sporadicity
sporadic = Sporadicity
ApplyAlways
    , nonOverlappingTarget :: Bool
nonOverlappingTarget = Bool
False
    }

-- | A single sound change rule.
--
-- In Brassica sound-change syntax with all elements specified, this would be
-- @-flags target / replacement \/ environment1 \/ environment2 \/ … \/ exception@.
data Rule c = Rule
  { forall (c :: LexemeType -> *). Rule c -> [Lexeme c 'Matched]
target      :: [Lexeme c 'Matched]
  , forall (c :: LexemeType -> *). Rule c -> [Lexeme c 'Replacement]
replacement :: [Lexeme c 'Replacement]
  , forall (c :: LexemeType -> *). Rule c -> [Environment c]
environment :: [Environment c]
  , forall (c :: LexemeType -> *). Rule c -> Maybe (Environment c)
exception   :: Maybe (Environment c)
  , forall (c :: LexemeType -> *). Rule c -> Flags
flags       :: Flags
  , forall (c :: LexemeType -> *). Rule c -> Grapheme
plaintext   :: String  -- ^ Rule text before parsing (displayed e.g. for debugging purposes)
  } deriving ((forall x. Rule c -> Rep (Rule c) x)
-> (forall x. Rep (Rule c) x -> Rule c) -> Generic (Rule c)
forall x. Rep (Rule c) x -> Rule c
forall x. Rule c -> Rep (Rule c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (c :: LexemeType -> *) x. Rep (Rule c) x -> Rule c
forall (c :: LexemeType -> *) x. Rule c -> Rep (Rule c) x
$cfrom :: forall (c :: LexemeType -> *) x. Rule c -> Rep (Rule c) x
from :: forall x. Rule c -> Rep (Rule c) x
$cto :: forall (c :: LexemeType -> *) x. Rep (Rule c) x -> Rule c
to :: forall x. Rep (Rule c) x -> Rule c
Generic)

deriving instance (forall a. Show (c a)) => Show (Rule c)
deriving instance (forall a. NFData (c a)) => NFData (Rule c)

-- | A filter, constraining the output to not match the given elements.
-- (The 'String' is the plaintext, as with 'Rule'.)
data Filter c = Filter String [Lexeme c 'Matched]
    deriving ((forall x. Filter c -> Rep (Filter c) x)
-> (forall x. Rep (Filter c) x -> Filter c) -> Generic (Filter c)
forall x. Rep (Filter c) x -> Filter c
forall x. Filter c -> Rep (Filter c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (c :: LexemeType -> *) x. Rep (Filter c) x -> Filter c
forall (c :: LexemeType -> *) x. Filter c -> Rep (Filter c) x
$cfrom :: forall (c :: LexemeType -> *) x. Filter c -> Rep (Filter c) x
from :: forall x. Filter c -> Rep (Filter c) x
$cto :: forall (c :: LexemeType -> *) x. Rep (Filter c) x -> Filter c
to :: forall x. Rep (Filter c) x -> Filter c
Generic)

deriving instance (forall a. Show (c a)) => Show (Filter c)
deriving instance (forall a. NFData (c a)) => NFData (Filter c)

-- | A 'Statement' within a sound change file can be a single sound
-- change rule, a filter, an instruction to report intermediate
-- results, or some other declaration.
--
-- The declaration type depends on the current sound change
-- phase. Usually it will be 'Directive' after parsing, or
-- 'GraphemeList' after expansion.
data Statement c decl
    = RuleS (Rule c)        -- ^ Sound change rule
    | FilterS (Filter c)    -- ^ Filter
    | ReportS               -- ^ Report intermediate result
    | DeclS decl            -- ^ Declaration (phase-dependent)
    deriving ((forall x. Statement c decl -> Rep (Statement c decl) x)
-> (forall x. Rep (Statement c decl) x -> Statement c decl)
-> Generic (Statement c decl)
forall x. Rep (Statement c decl) x -> Statement c decl
forall x. Statement c decl -> Rep (Statement c decl) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (c :: LexemeType -> *) decl x.
Rep (Statement c decl) x -> Statement c decl
forall (c :: LexemeType -> *) decl x.
Statement c decl -> Rep (Statement c decl) x
$cfrom :: forall (c :: LexemeType -> *) decl x.
Statement c decl -> Rep (Statement c decl) x
from :: forall x. Statement c decl -> Rep (Statement c decl) x
$cto :: forall (c :: LexemeType -> *) decl x.
Rep (Statement c decl) x -> Statement c decl
to :: forall x. Rep (Statement c decl) x -> Statement c decl
Generic)

deriving instance (forall a. Show (c a), Show decl) => Show (Statement c decl)
deriving instance (forall a. NFData (c a), NFData decl) => NFData (Statement c decl)

-- | A simple wrapper around 'plaintext' for 'Statement's. Returns
-- @"\<declaration\>"@ for all 'DeclS' inputs.
plaintext' :: Statement c decl -> String
plaintext' :: forall (c :: LexemeType -> *) decl. Statement c decl -> Grapheme
plaintext' (RuleS Rule c
r) = Rule c -> Grapheme
forall (c :: LexemeType -> *). Rule c -> Grapheme
plaintext Rule c
r
plaintext' (FilterS (Filter Grapheme
p [Lexeme c 'Matched]
_)) = Grapheme
p
plaintext' Statement c decl
ReportS = Grapheme
"intermediate result"
plaintext' (DeclS decl
_) = Grapheme
"<declaration>"

-- | A set of 'SoundChanges' is simply a list of 'Statement's.
type SoundChanges c decl = [Statement c decl]

-- | The individual operations used to construct a category in
-- Brassica sound-change syntax.
data CategoryModification
    = Union     -- ^ Written @[Category1 &Category2]@ or @[Category1 Category2]@
    | Intersect -- ^ Written @[Category1 +Category2]@
    | Subtract  -- ^ Written @[Category1 -Category2]@
    deriving (Int -> CategoryModification -> ShowS
[CategoryModification] -> ShowS
CategoryModification -> Grapheme
(Int -> CategoryModification -> ShowS)
-> (CategoryModification -> Grapheme)
-> ([CategoryModification] -> ShowS)
-> Show CategoryModification
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CategoryModification -> ShowS
showsPrec :: Int -> CategoryModification -> ShowS
$cshow :: CategoryModification -> Grapheme
show :: CategoryModification -> Grapheme
$cshowList :: [CategoryModification] -> ShowS
showList :: [CategoryModification] -> ShowS
Show, CategoryModification -> CategoryModification -> Bool
(CategoryModification -> CategoryModification -> Bool)
-> (CategoryModification -> CategoryModification -> Bool)
-> Eq CategoryModification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CategoryModification -> CategoryModification -> Bool
== :: CategoryModification -> CategoryModification -> Bool
$c/= :: CategoryModification -> CategoryModification -> Bool
/= :: CategoryModification -> CategoryModification -> Bool
Eq, Eq CategoryModification
Eq CategoryModification =>
(CategoryModification -> CategoryModification -> Ordering)
-> (CategoryModification -> CategoryModification -> Bool)
-> (CategoryModification -> CategoryModification -> Bool)
-> (CategoryModification -> CategoryModification -> Bool)
-> (CategoryModification -> CategoryModification -> Bool)
-> (CategoryModification
    -> CategoryModification -> CategoryModification)
-> (CategoryModification
    -> CategoryModification -> CategoryModification)
-> Ord CategoryModification
CategoryModification -> CategoryModification -> Bool
CategoryModification -> CategoryModification -> Ordering
CategoryModification
-> CategoryModification -> CategoryModification
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CategoryModification -> CategoryModification -> Ordering
compare :: CategoryModification -> CategoryModification -> Ordering
$c< :: CategoryModification -> CategoryModification -> Bool
< :: CategoryModification -> CategoryModification -> Bool
$c<= :: CategoryModification -> CategoryModification -> Bool
<= :: CategoryModification -> CategoryModification -> Bool
$c> :: CategoryModification -> CategoryModification -> Bool
> :: CategoryModification -> CategoryModification -> Bool
$c>= :: CategoryModification -> CategoryModification -> Bool
>= :: CategoryModification -> CategoryModification -> Bool
$cmax :: CategoryModification
-> CategoryModification -> CategoryModification
max :: CategoryModification
-> CategoryModification -> CategoryModification
$cmin :: CategoryModification
-> CategoryModification -> CategoryModification
min :: CategoryModification
-> CategoryModification -> CategoryModification
Ord, (forall x. CategoryModification -> Rep CategoryModification x)
-> (forall x. Rep CategoryModification x -> CategoryModification)
-> Generic CategoryModification
forall x. Rep CategoryModification x -> CategoryModification
forall x. CategoryModification -> Rep CategoryModification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CategoryModification -> Rep CategoryModification x
from :: forall x. CategoryModification -> Rep CategoryModification x
$cto :: forall x. Rep CategoryModification x -> CategoryModification
to :: forall x. Rep CategoryModification x -> CategoryModification
Generic, CategoryModification -> ()
(CategoryModification -> ()) -> NFData CategoryModification
forall a. (a -> ()) -> NFData a
$crnf :: CategoryModification -> ()
rnf :: CategoryModification -> ()
NFData)

-- | A single element of a category: a sequence of 'Lexeme's. (Single
-- v'Grapheme's receive some special treatment, e.g. they can be
-- written without surrounding braces in Brassica syntax.)
type CategoryElement category a = [Lexeme category a]

-- | The specification of a category in Brassica sound-change
-- syntax. Usually this will be as a 'CategorySpec': a list of
-- 'CategoryElement's, each of which modifies the previous definition
-- using the given 'CategoryModification' method.
--
-- In some positions (e.g. after a 'Backreference') a category must be
-- provided, but that category can be predefined, to be inlined during
-- expansion. In such positions, the given category name is stored as
-- a 'MustInline' category. (In other positions predefined categories
-- are indistinguishable from normal v'Grapheme's, and represented as
-- such.)
data CategorySpec a
    = CategorySpec [(CategoryModification, CategoryElement CategorySpec a)]
    | MustInline String  -- ^ A single grapheme assumed to have been specified earlier as a category
    deriving (Int -> CategorySpec a -> ShowS
[CategorySpec a] -> ShowS
CategorySpec a -> Grapheme
(Int -> CategorySpec a -> ShowS)
-> (CategorySpec a -> Grapheme)
-> ([CategorySpec a] -> ShowS)
-> Show (CategorySpec a)
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
forall (a :: LexemeType). Int -> CategorySpec a -> ShowS
forall (a :: LexemeType). [CategorySpec a] -> ShowS
forall (a :: LexemeType). CategorySpec a -> Grapheme
$cshowsPrec :: forall (a :: LexemeType). Int -> CategorySpec a -> ShowS
showsPrec :: Int -> CategorySpec a -> ShowS
$cshow :: forall (a :: LexemeType). CategorySpec a -> Grapheme
show :: CategorySpec a -> Grapheme
$cshowList :: forall (a :: LexemeType). [CategorySpec a] -> ShowS
showList :: [CategorySpec a] -> ShowS
Show, CategorySpec a -> CategorySpec a -> Bool
(CategorySpec a -> CategorySpec a -> Bool)
-> (CategorySpec a -> CategorySpec a -> Bool)
-> Eq (CategorySpec a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: LexemeType). CategorySpec a -> CategorySpec a -> Bool
$c== :: forall (a :: LexemeType). CategorySpec a -> CategorySpec a -> Bool
== :: CategorySpec a -> CategorySpec a -> Bool
$c/= :: forall (a :: LexemeType). CategorySpec a -> CategorySpec a -> Bool
/= :: CategorySpec a -> CategorySpec a -> Bool
Eq, Eq (CategorySpec a)
Eq (CategorySpec a) =>
(CategorySpec a -> CategorySpec a -> Ordering)
-> (CategorySpec a -> CategorySpec a -> Bool)
-> (CategorySpec a -> CategorySpec a -> Bool)
-> (CategorySpec a -> CategorySpec a -> Bool)
-> (CategorySpec a -> CategorySpec a -> Bool)
-> (CategorySpec a -> CategorySpec a -> CategorySpec a)
-> (CategorySpec a -> CategorySpec a -> CategorySpec a)
-> Ord (CategorySpec a)
CategorySpec a -> CategorySpec a -> Bool
CategorySpec a -> CategorySpec a -> Ordering
CategorySpec a -> CategorySpec a -> CategorySpec a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (x :: LexemeType). Eq (CategorySpec x)
forall (a :: LexemeType). CategorySpec a -> CategorySpec a -> Bool
forall (a :: LexemeType).
CategorySpec a -> CategorySpec a -> Ordering
forall (a :: LexemeType).
CategorySpec a -> CategorySpec a -> CategorySpec a
$ccompare :: forall (a :: LexemeType).
CategorySpec a -> CategorySpec a -> Ordering
compare :: CategorySpec a -> CategorySpec a -> Ordering
$c< :: forall (a :: LexemeType). CategorySpec a -> CategorySpec a -> Bool
< :: CategorySpec a -> CategorySpec a -> Bool
$c<= :: forall (a :: LexemeType). CategorySpec a -> CategorySpec a -> Bool
<= :: CategorySpec a -> CategorySpec a -> Bool
$c> :: forall (a :: LexemeType). CategorySpec a -> CategorySpec a -> Bool
> :: CategorySpec a -> CategorySpec a -> Bool
$c>= :: forall (a :: LexemeType). CategorySpec a -> CategorySpec a -> Bool
>= :: CategorySpec a -> CategorySpec a -> Bool
$cmax :: forall (a :: LexemeType).
CategorySpec a -> CategorySpec a -> CategorySpec a
max :: CategorySpec a -> CategorySpec a -> CategorySpec a
$cmin :: forall (a :: LexemeType).
CategorySpec a -> CategorySpec a -> CategorySpec a
min :: CategorySpec a -> CategorySpec a -> CategorySpec a
Ord, (forall x. CategorySpec a -> Rep (CategorySpec a) x)
-> (forall x. Rep (CategorySpec a) x -> CategorySpec a)
-> Generic (CategorySpec a)
forall x. Rep (CategorySpec a) x -> CategorySpec a
forall x. CategorySpec a -> Rep (CategorySpec a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: LexemeType) x.
Rep (CategorySpec a) x -> CategorySpec a
forall (a :: LexemeType) x.
CategorySpec a -> Rep (CategorySpec a) x
$cfrom :: forall (a :: LexemeType) x.
CategorySpec a -> Rep (CategorySpec a) x
from :: forall x. CategorySpec a -> Rep (CategorySpec a) x
$cto :: forall (a :: LexemeType) x.
Rep (CategorySpec a) x -> CategorySpec a
to :: forall x. Rep (CategorySpec a) x -> CategorySpec a
Generic, CategorySpec a -> ()
(CategorySpec a -> ()) -> NFData (CategorySpec a)
forall a. (a -> ()) -> NFData a
forall (a :: LexemeType). CategorySpec a -> ()
$crnf :: forall (a :: LexemeType). CategorySpec a -> ()
rnf :: CategorySpec a -> ()
NFData)

-- | The specification of a suprasegmental feature in Brassica
-- sound-change syntax.
--
-- Deprecated since 1.0.0.
data FeatureSpec = FeatureSpec
    { FeatureSpec -> Maybe Grapheme
featureBaseName :: Maybe String
    , FeatureSpec -> CategorySpec 'AnyPart
featureBaseValues :: CategorySpec 'AnyPart
    , FeatureSpec -> [(Grapheme, CategorySpec 'AnyPart)]
featureDerived :: [(String, CategorySpec 'AnyPart)]
    }
    deriving (Int -> FeatureSpec -> ShowS
[FeatureSpec] -> ShowS
FeatureSpec -> Grapheme
(Int -> FeatureSpec -> ShowS)
-> (FeatureSpec -> Grapheme)
-> ([FeatureSpec] -> ShowS)
-> Show FeatureSpec
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FeatureSpec -> ShowS
showsPrec :: Int -> FeatureSpec -> ShowS
$cshow :: FeatureSpec -> Grapheme
show :: FeatureSpec -> Grapheme
$cshowList :: [FeatureSpec] -> ShowS
showList :: [FeatureSpec] -> ShowS
Show, FeatureSpec -> FeatureSpec -> Bool
(FeatureSpec -> FeatureSpec -> Bool)
-> (FeatureSpec -> FeatureSpec -> Bool) -> Eq FeatureSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FeatureSpec -> FeatureSpec -> Bool
== :: FeatureSpec -> FeatureSpec -> Bool
$c/= :: FeatureSpec -> FeatureSpec -> Bool
/= :: FeatureSpec -> FeatureSpec -> Bool
Eq, Eq FeatureSpec
Eq FeatureSpec =>
(FeatureSpec -> FeatureSpec -> Ordering)
-> (FeatureSpec -> FeatureSpec -> Bool)
-> (FeatureSpec -> FeatureSpec -> Bool)
-> (FeatureSpec -> FeatureSpec -> Bool)
-> (FeatureSpec -> FeatureSpec -> Bool)
-> (FeatureSpec -> FeatureSpec -> FeatureSpec)
-> (FeatureSpec -> FeatureSpec -> FeatureSpec)
-> Ord FeatureSpec
FeatureSpec -> FeatureSpec -> Bool
FeatureSpec -> FeatureSpec -> Ordering
FeatureSpec -> FeatureSpec -> FeatureSpec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FeatureSpec -> FeatureSpec -> Ordering
compare :: FeatureSpec -> FeatureSpec -> Ordering
$c< :: FeatureSpec -> FeatureSpec -> Bool
< :: FeatureSpec -> FeatureSpec -> Bool
$c<= :: FeatureSpec -> FeatureSpec -> Bool
<= :: FeatureSpec -> FeatureSpec -> Bool
$c> :: FeatureSpec -> FeatureSpec -> Bool
> :: FeatureSpec -> FeatureSpec -> Bool
$c>= :: FeatureSpec -> FeatureSpec -> Bool
>= :: FeatureSpec -> FeatureSpec -> Bool
$cmax :: FeatureSpec -> FeatureSpec -> FeatureSpec
max :: FeatureSpec -> FeatureSpec -> FeatureSpec
$cmin :: FeatureSpec -> FeatureSpec -> FeatureSpec
min :: FeatureSpec -> FeatureSpec -> FeatureSpec
Ord, (forall x. FeatureSpec -> Rep FeatureSpec x)
-> (forall x. Rep FeatureSpec x -> FeatureSpec)
-> Generic FeatureSpec
forall x. Rep FeatureSpec x -> FeatureSpec
forall x. FeatureSpec -> Rep FeatureSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FeatureSpec -> Rep FeatureSpec x
from :: forall x. FeatureSpec -> Rep FeatureSpec x
$cto :: forall x. Rep FeatureSpec x -> FeatureSpec
to :: forall x. Rep FeatureSpec x -> FeatureSpec
Generic, FeatureSpec -> ()
(FeatureSpec -> ()) -> NFData FeatureSpec
forall a. (a -> ()) -> NFData a
$crnf :: FeatureSpec -> ()
rnf :: FeatureSpec -> ()
NFData)

-- | A single definition within a category definition block.
data CategoryDefinition
    = DefineCategory String (CategorySpec 'AnyPart)
    -- ^ Defines a category with the given name and value
    | DefineFeature FeatureSpec
    -- ^ Defines a feature as a set of categories
    | DefineAuto String
    -- ^ Defines a category as autosegmental
    deriving (Int -> CategoryDefinition -> ShowS
[CategoryDefinition] -> ShowS
CategoryDefinition -> Grapheme
(Int -> CategoryDefinition -> ShowS)
-> (CategoryDefinition -> Grapheme)
-> ([CategoryDefinition] -> ShowS)
-> Show CategoryDefinition
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CategoryDefinition -> ShowS
showsPrec :: Int -> CategoryDefinition -> ShowS
$cshow :: CategoryDefinition -> Grapheme
show :: CategoryDefinition -> Grapheme
$cshowList :: [CategoryDefinition] -> ShowS
showList :: [CategoryDefinition] -> ShowS
Show, CategoryDefinition -> CategoryDefinition -> Bool
(CategoryDefinition -> CategoryDefinition -> Bool)
-> (CategoryDefinition -> CategoryDefinition -> Bool)
-> Eq CategoryDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CategoryDefinition -> CategoryDefinition -> Bool
== :: CategoryDefinition -> CategoryDefinition -> Bool
$c/= :: CategoryDefinition -> CategoryDefinition -> Bool
/= :: CategoryDefinition -> CategoryDefinition -> Bool
Eq, Eq CategoryDefinition
Eq CategoryDefinition =>
(CategoryDefinition -> CategoryDefinition -> Ordering)
-> (CategoryDefinition -> CategoryDefinition -> Bool)
-> (CategoryDefinition -> CategoryDefinition -> Bool)
-> (CategoryDefinition -> CategoryDefinition -> Bool)
-> (CategoryDefinition -> CategoryDefinition -> Bool)
-> (CategoryDefinition -> CategoryDefinition -> CategoryDefinition)
-> (CategoryDefinition -> CategoryDefinition -> CategoryDefinition)
-> Ord CategoryDefinition
CategoryDefinition -> CategoryDefinition -> Bool
CategoryDefinition -> CategoryDefinition -> Ordering
CategoryDefinition -> CategoryDefinition -> CategoryDefinition
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CategoryDefinition -> CategoryDefinition -> Ordering
compare :: CategoryDefinition -> CategoryDefinition -> Ordering
$c< :: CategoryDefinition -> CategoryDefinition -> Bool
< :: CategoryDefinition -> CategoryDefinition -> Bool
$c<= :: CategoryDefinition -> CategoryDefinition -> Bool
<= :: CategoryDefinition -> CategoryDefinition -> Bool
$c> :: CategoryDefinition -> CategoryDefinition -> Bool
> :: CategoryDefinition -> CategoryDefinition -> Bool
$c>= :: CategoryDefinition -> CategoryDefinition -> Bool
>= :: CategoryDefinition -> CategoryDefinition -> Bool
$cmax :: CategoryDefinition -> CategoryDefinition -> CategoryDefinition
max :: CategoryDefinition -> CategoryDefinition -> CategoryDefinition
$cmin :: CategoryDefinition -> CategoryDefinition -> CategoryDefinition
min :: CategoryDefinition -> CategoryDefinition -> CategoryDefinition
Ord, (forall x. CategoryDefinition -> Rep CategoryDefinition x)
-> (forall x. Rep CategoryDefinition x -> CategoryDefinition)
-> Generic CategoryDefinition
forall x. Rep CategoryDefinition x -> CategoryDefinition
forall x. CategoryDefinition -> Rep CategoryDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CategoryDefinition -> Rep CategoryDefinition x
from :: forall x. CategoryDefinition -> Rep CategoryDefinition x
$cto :: forall x. Rep CategoryDefinition x -> CategoryDefinition
to :: forall x. Rep CategoryDefinition x -> CategoryDefinition
Generic, CategoryDefinition -> ()
(CategoryDefinition -> ()) -> NFData CategoryDefinition
forall a. (a -> ()) -> NFData a
$crnf :: CategoryDefinition -> ()
rnf :: CategoryDefinition -> ()
NFData)

-- | A directive used in Brassica sound-change syntax: anything which
-- occurs in a sound change file with the primary purpose of defining
-- something for later use.
data Directive
    = Categories  -- ^ Category definition block
        Bool  -- ^ Whether category was introduced with @new@
        Bool  -- ^ Whether category was introduced with @noreplace@
        [CategoryDefinition]
    | ExtraGraphemes [String]
      -- ^ Extra graphemes declaration: @extra …@
    deriving (Int -> Directive -> ShowS
[Directive] -> ShowS
Directive -> Grapheme
(Int -> Directive -> ShowS)
-> (Directive -> Grapheme)
-> ([Directive] -> ShowS)
-> Show Directive
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Directive -> ShowS
showsPrec :: Int -> Directive -> ShowS
$cshow :: Directive -> Grapheme
show :: Directive -> Grapheme
$cshowList :: [Directive] -> ShowS
showList :: [Directive] -> ShowS
Show, Directive -> Directive -> Bool
(Directive -> Directive -> Bool)
-> (Directive -> Directive -> Bool) -> Eq Directive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Directive -> Directive -> Bool
== :: Directive -> Directive -> Bool
$c/= :: Directive -> Directive -> Bool
/= :: Directive -> Directive -> Bool
Eq, Eq Directive
Eq Directive =>
(Directive -> Directive -> Ordering)
-> (Directive -> Directive -> Bool)
-> (Directive -> Directive -> Bool)
-> (Directive -> Directive -> Bool)
-> (Directive -> Directive -> Bool)
-> (Directive -> Directive -> Directive)
-> (Directive -> Directive -> Directive)
-> Ord Directive
Directive -> Directive -> Bool
Directive -> Directive -> Ordering
Directive -> Directive -> Directive
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Directive -> Directive -> Ordering
compare :: Directive -> Directive -> Ordering
$c< :: Directive -> Directive -> Bool
< :: Directive -> Directive -> Bool
$c<= :: Directive -> Directive -> Bool
<= :: Directive -> Directive -> Bool
$c> :: Directive -> Directive -> Bool
> :: Directive -> Directive -> Bool
$c>= :: Directive -> Directive -> Bool
>= :: Directive -> Directive -> Bool
$cmax :: Directive -> Directive -> Directive
max :: Directive -> Directive -> Directive
$cmin :: Directive -> Directive -> Directive
min :: Directive -> Directive -> Directive
Ord, (forall x. Directive -> Rep Directive x)
-> (forall x. Rep Directive x -> Directive) -> Generic Directive
forall x. Rep Directive x -> Directive
forall x. Directive -> Rep Directive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Directive -> Rep Directive x
from :: forall x. Directive -> Rep Directive x
$cto :: forall x. Rep Directive x -> Directive
to :: forall x. Rep Directive x -> Directive
Generic, Directive -> ()
(Directive -> ()) -> NFData Directive
forall a. (a -> ()) -> NFData a
$crnf :: Directive -> ()
rnf :: Directive -> ()
NFData)

-- | A list of graphemes, replacing v'Categories' in expanded sound
-- changes. These are used in tokenisation to determine which
-- multigraphs are used, and in rule application to filter unwanted
-- graphemes. The first 'Bool' indicates whether filtration should
-- occur for any particular categories block.
data GraphemeList = GraphemeList Bool [Grapheme]
    deriving (GraphemeList -> GraphemeList -> Bool
(GraphemeList -> GraphemeList -> Bool)
-> (GraphemeList -> GraphemeList -> Bool) -> Eq GraphemeList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GraphemeList -> GraphemeList -> Bool
== :: GraphemeList -> GraphemeList -> Bool
$c/= :: GraphemeList -> GraphemeList -> Bool
/= :: GraphemeList -> GraphemeList -> Bool
Eq, Int -> GraphemeList -> ShowS
[GraphemeList] -> ShowS
GraphemeList -> Grapheme
(Int -> GraphemeList -> ShowS)
-> (GraphemeList -> Grapheme)
-> ([GraphemeList] -> ShowS)
-> Show GraphemeList
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GraphemeList -> ShowS
showsPrec :: Int -> GraphemeList -> ShowS
$cshow :: GraphemeList -> Grapheme
show :: GraphemeList -> Grapheme
$cshowList :: [GraphemeList] -> ShowS
showList :: [GraphemeList] -> ShowS
Show, Eq GraphemeList
Eq GraphemeList =>
(GraphemeList -> GraphemeList -> Ordering)
-> (GraphemeList -> GraphemeList -> Bool)
-> (GraphemeList -> GraphemeList -> Bool)
-> (GraphemeList -> GraphemeList -> Bool)
-> (GraphemeList -> GraphemeList -> Bool)
-> (GraphemeList -> GraphemeList -> GraphemeList)
-> (GraphemeList -> GraphemeList -> GraphemeList)
-> Ord GraphemeList
GraphemeList -> GraphemeList -> Bool
GraphemeList -> GraphemeList -> Ordering
GraphemeList -> GraphemeList -> GraphemeList
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GraphemeList -> GraphemeList -> Ordering
compare :: GraphemeList -> GraphemeList -> Ordering
$c< :: GraphemeList -> GraphemeList -> Bool
< :: GraphemeList -> GraphemeList -> Bool
$c<= :: GraphemeList -> GraphemeList -> Bool
<= :: GraphemeList -> GraphemeList -> Bool
$c> :: GraphemeList -> GraphemeList -> Bool
> :: GraphemeList -> GraphemeList -> Bool
$c>= :: GraphemeList -> GraphemeList -> Bool
>= :: GraphemeList -> GraphemeList -> Bool
$cmax :: GraphemeList -> GraphemeList -> GraphemeList
max :: GraphemeList -> GraphemeList -> GraphemeList
$cmin :: GraphemeList -> GraphemeList -> GraphemeList
min :: GraphemeList -> GraphemeList -> GraphemeList
Ord, (forall x. GraphemeList -> Rep GraphemeList x)
-> (forall x. Rep GraphemeList x -> GraphemeList)
-> Generic GraphemeList
forall x. Rep GraphemeList x -> GraphemeList
forall x. GraphemeList -> Rep GraphemeList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GraphemeList -> Rep GraphemeList x
from :: forall x. GraphemeList -> Rep GraphemeList x
$cto :: forall x. Rep GraphemeList x -> GraphemeList
to :: forall x. Rep GraphemeList x -> GraphemeList
Generic, GraphemeList -> ()
(GraphemeList -> ()) -> NFData GraphemeList
forall a. (a -> ()) -> NFData a
$crnf :: GraphemeList -> ()
rnf :: GraphemeList -> ()
NFData)