brassica-0.2.0: Featureful sound change applier
Safe HaskellSafe-Inferred
LanguageHaskell2010

Brassica.SoundChange.Apply.Internal

Description

Warning: This module is internal, and does not follow the Package Versioning Policy. It may be useful for extending Brassica, but be prepared to track development closely if you import this module.

Synopsis

Types

data RuleTag Source #

Defines the tags used when applying a Rule.

Constructors

AppStart

The start of a rule application

TargetStart

The start of the target

TargetEnd

The end of the target

Instances

Instances details
Show RuleTag Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

Eq RuleTag Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

Methods

(==) :: RuleTag -> RuleTag -> Bool #

(/=) :: RuleTag -> RuleTag -> Bool #

Ord RuleTag Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

Lexeme matching

match Source #

Arguments

:: forall a t. OneOf a 'Target 'Env 
=> MatchOutput

The previous MatchOutput

-> Maybe Grapheme

The previously-matched grapheme, if any. (Used to match a Geminate.)

-> Lexeme Expanded a

The lexeme to match.

-> MultiZipper t Grapheme

The MultiZipper to match against.

-> [(MatchOutput, MultiZipper t Grapheme)]

The output: a tuple (g, mz) as described below.

Match a single Lexeme against a MultiZipper, and advance the MultiZipper past the match. For each match found, returns the MatchOutput tupled with the updated MultiZipper.

matchMany :: OneOf a 'Target 'Env => MatchOutput -> Maybe Grapheme -> [Lexeme Expanded a] -> MultiZipper t Grapheme -> [(MatchOutput, MultiZipper t Grapheme)] Source #

Match a list of several Lexemes against a MultiZipper. Arguments and output are the same as with match, though the outputs are given as a list of indices and graphemes rather than as a single index and grapheme.

matchMany' :: OneOf a 'Target 'Env => Maybe Grapheme -> [Lexeme Expanded a] -> MultiZipper t Grapheme -> [(MatchOutput, MultiZipper t Grapheme)] Source #

matchMany without any previous match output.

mkReplacement Source #

Arguments

:: MatchOutput

The result of matching against the target

-> [Lexeme Expanded 'Replacement]

The Lexemes specifying the replacement.

-> MultiZipper t Grapheme 
-> [MultiZipper t Grapheme] 

Given a list of Lexemes specifying a replacement, generate all possible replacements and apply them to the given input.

exceptionAppliesAtPoint :: [Lexeme Expanded 'Target] -> Environment Expanded -> MultiZipper RuleTag Grapheme -> [Int] Source #

Given a Rule and a MultiZipper, determines whether the exception of that rule (if any) applies starting at the current position of the MultiZipper; if it does, returns the index of the first element of each matching target.

matchRuleAtPoint :: [Lexeme Expanded 'Target] -> Environment Expanded -> MultiZipper RuleTag Grapheme -> [(MatchOutput, MultiZipper RuleTag Grapheme)] Source #

Given a target and environment, determine if they rule matches. If so, for each match, set the appropriate RuleTags and return a tuple of (is, gs), where gs is a list of matched Graphemes, and is is a list of indices, one for each Category lexeme matched.

Sound change application

applyOnce :: Rule Expanded -> StateT (MultiZipper RuleTag Grapheme) [] Bool Source #

Given a Rule, determine if the rule matches at the current point; if so, apply the rule, adding appropriate tags.

applyRule :: Rule Expanded -> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme] Source #

Apply a Rule to a MultiZipper. The application will start at the beginning of the MultiZipper, and will be repeated as many times as possible. Returns all valid results.

checkGraphemes :: [Grapheme] -> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme Source #

Check that the MultiZipper contains only graphemes listed in the given CategoriesDecl, replacing all unlisted graphemes with U+FFFD.

applyRuleStr :: Rule Expanded -> PWord -> [PWord] Source #

Apply a single Rule to a word.

Note: duplicate outputs from this function are removed. To keep duplicates, use the lower-level internal function applyRule directly.

applyStatementStr :: Statement Expanded [Grapheme] -> PWord -> [PWord] Source #

Apply a single Statement to a word.

Note: as with applyRuleStr, duplicate outputs from this function are removed. To keep duplicates, use the lower-level internal function applyStatement directly.

applyChanges :: SoundChanges Expanded [Grapheme] -> PWord -> [PWord] Source #

Apply a set of SoundChanges to a word.

Logging

data LogItem r Source #

A log item representing a single application of an action. (In practise this will usually be a Statement.) Specifies the action which was applied, as well as the ‘before’ and ‘after’ states.

Constructors

ActionApplied 

Fields

Instances

Instances details
Functor LogItem Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

Methods

fmap :: (a -> b) -> LogItem a -> LogItem b #

(<$) :: a -> LogItem b -> LogItem a #

Generic (LogItem r) Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

Associated Types

type Rep (LogItem r) :: Type -> Type #

Methods

from :: LogItem r -> Rep (LogItem r) x #

to :: Rep (LogItem r) x -> LogItem r #

Show r => Show (LogItem r) Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

Methods

showsPrec :: Int -> LogItem r -> ShowS #

show :: LogItem r -> String #

showList :: [LogItem r] -> ShowS #

NFData r => NFData (LogItem r) Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

Methods

rnf :: LogItem r -> () #

type Rep (LogItem r) Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

type Rep (LogItem r) = D1 ('MetaData "LogItem" "Brassica.SoundChange.Apply.Internal" "brassica-0.2.0-6DYGqWgsRcQ5pGt1m6P3TU" 'False) (C1 ('MetaCons "ActionApplied" 'PrefixI 'True) (S1 ('MetaSel ('Just "action") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 r) :*: (S1 ('MetaSel ('Just "input") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PWord) :*: S1 ('MetaSel ('Just "output") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PWord))))

data PWordLog r Source #

Logs the evolution of a PWord as various actions are applied to it. The actions (usually Statements) are of type r.

Constructors

PWordLog 

Fields

  • initialWord :: PWord

    The initial word, before any actions have been applied

  • derivations :: [(PWord, r)]

    The state of the word after each action r, stored alongside the action which was applied at each point

Instances

Instances details
Functor PWordLog Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

Methods

fmap :: (a -> b) -> PWordLog a -> PWordLog b #

(<$) :: a -> PWordLog b -> PWordLog a #

Generic (PWordLog r) Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

Associated Types

type Rep (PWordLog r) :: Type -> Type #

Methods

from :: PWordLog r -> Rep (PWordLog r) x #

to :: Rep (PWordLog r) x -> PWordLog r #

Show r => Show (PWordLog r) Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

Methods

showsPrec :: Int -> PWordLog r -> ShowS #

show :: PWordLog r -> String #

showList :: [PWordLog r] -> ShowS #

NFData r => NFData (PWordLog r) Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

Methods

rnf :: PWordLog r -> () #

type Rep (PWordLog r) Source # 
Instance details

Defined in Brassica.SoundChange.Apply.Internal

type Rep (PWordLog r) = D1 ('MetaData "PWordLog" "Brassica.SoundChange.Apply.Internal" "brassica-0.2.0-6DYGqWgsRcQ5pGt1m6P3TU" 'False) (C1 ('MetaCons "PWordLog" 'PrefixI 'True) (S1 ('MetaSel ('Just "initialWord") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PWord) :*: S1 ('MetaSel ('Just "derivations") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [(PWord, r)])))

reportAsHtmlRows :: (r -> String) -> PWordLog r -> String Source #

Render a single PWordLog to rows of an HTML table. For instance, the example log given in the documentation for reportAsText would be converted to the following HTML:

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

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

taratazha(r / zh)
tazh(V _ #)

reportAsText :: (r -> String) -> PWordLog r -> String Source #

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

PWordLog
  { initialWord = ["t", "a", "r", "a"]
  , derivations =
    [ (["t", "a", "zh", "a"], "r / zh")
    , (["t", "a", "zh"], "V / / _ #")
    ]
  }

Would render as:

tara
  -> tazha  (r / zh)
  -> tazh   (V / / _ #)

applyStatementWithLog :: Statement Expanded [Grapheme] -> PWord -> [LogItem (Statement Expanded [Grapheme])] Source #

Apply a single Statement to a word. Returns a LogItem for each possible result, or [] if the rule does not apply and the input is returned unmodified.

applyChangesWithLog :: SoundChanges Expanded [Grapheme] -> PWord -> [[LogItem (Statement Expanded [Grapheme])]] Source #

Apply SoundChanges to a word. For each possible result, returns a LogItem for each Statement which altered the input.

applyChangesWithLogs :: SoundChanges Expanded [Grapheme] -> PWord -> [PWordLog (Statement Expanded [Grapheme])] Source #

Apply SoundChanges to a word, returning an PWordLog for each possible result.

applyChangesWithChanges :: SoundChanges Expanded [Grapheme] -> PWord -> [(PWord, Bool)] Source #

Apply SoundChanges to a word returning the final results, as well as a boolean value indicating whether the word should be highlighted in a UI due to changes from its initial value. (Note that this accounts for highlightChanges values.)