Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
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
- data RuleTag
- match :: forall a t. OneOf a 'Target 'Env => MatchOutput -> Maybe Grapheme -> Lexeme Expanded a -> MultiZipper t Grapheme -> [(MatchOutput, MultiZipper t Grapheme)]
- matchMany :: OneOf a 'Target 'Env => MatchOutput -> Maybe Grapheme -> [Lexeme Expanded a] -> MultiZipper t Grapheme -> [(MatchOutput, MultiZipper t Grapheme)]
- matchMany' :: OneOf a 'Target 'Env => Maybe Grapheme -> [Lexeme Expanded a] -> MultiZipper t Grapheme -> [(MatchOutput, MultiZipper t Grapheme)]
- mkReplacement :: MatchOutput -> [Lexeme Expanded 'Replacement] -> MultiZipper t Grapheme -> [MultiZipper t Grapheme]
- exceptionAppliesAtPoint :: [Lexeme Expanded 'Target] -> Environment Expanded -> MultiZipper RuleTag Grapheme -> [Int]
- matchRuleAtPoint :: [Lexeme Expanded 'Target] -> Environment Expanded -> MultiZipper RuleTag Grapheme -> [(MatchOutput, MultiZipper RuleTag Grapheme)]
- applyOnce :: Rule Expanded -> StateT (MultiZipper RuleTag Grapheme) [] Bool
- applyRule :: Rule Expanded -> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
- checkGraphemes :: [Grapheme] -> MultiZipper RuleTag Grapheme -> MultiZipper RuleTag Grapheme
- applyStatement :: Statement Expanded [Grapheme] -> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme]
- applyRuleStr :: Rule Expanded -> PWord -> [PWord]
- applyStatementStr :: Statement Expanded [Grapheme] -> PWord -> [PWord]
- applyChanges :: SoundChanges Expanded [Grapheme] -> PWord -> [PWord]
- data LogItem r = ActionApplied {}
- data PWordLog r = PWordLog {
- initialWord :: PWord
- derivations :: [(PWord, r)]
- toPWordLog :: [LogItem r] -> Maybe (PWordLog r)
- reportAsHtmlRows :: (r -> String) -> PWordLog r -> String
- reportAsText :: (r -> String) -> PWordLog r -> String
- applyStatementWithLog :: Statement Expanded [Grapheme] -> PWord -> [LogItem (Statement Expanded [Grapheme])]
- applyChangesWithLog :: SoundChanges Expanded [Grapheme] -> PWord -> [[LogItem (Statement Expanded [Grapheme])]]
- applyChangesWithLogs :: SoundChanges Expanded [Grapheme] -> PWord -> [PWordLog (Statement Expanded [Grapheme])]
- applyChangesWithChanges :: SoundChanges Expanded [Grapheme] -> PWord -> [(PWord, Bool)]
Types
Defines the tags used when applying a Rule
.
AppStart | The start of a rule application |
TargetStart | The start of the target |
TargetEnd | The end of the target |
Lexeme matching
:: forall a t. OneOf a 'Target 'Env | |
=> MatchOutput | The previous |
-> Maybe Grapheme | The previously-matched grapheme, if any. (Used to match a |
-> Lexeme Expanded a | The lexeme to match. |
-> MultiZipper t Grapheme | The |
-> [(MatchOutput, MultiZipper t Grapheme)] | The output: a tuple |
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 Lexeme
s against a
MultiZipper
. Arguments and output are the same as with match
,
though the outputs are given as a list of indices and graphemes
rather than as a single index and grapheme.
matchMany' :: OneOf a 'Target 'Env => Maybe Grapheme -> [Lexeme Expanded a] -> MultiZipper t Grapheme -> [(MatchOutput, MultiZipper t Grapheme)] Source #
matchMany
without any previous match output.
:: MatchOutput | The result of matching against the target |
-> [Lexeme Expanded 'Replacement] | The |
-> MultiZipper t Grapheme | |
-> [MultiZipper t Grapheme] |
Given a list of Lexeme
s 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 #
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.
applyStatement :: Statement Expanded [Grapheme] -> MultiZipper RuleTag Grapheme -> [MultiZipper RuleTag Grapheme] Source #
Apply a Statement
to a MultiZipper
. This is a simple wrapper
around applyRule
and checkGraphemes
.
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
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.
Instances
Functor LogItem Source # | |
Generic (LogItem r) Source # | |
Show r => Show (LogItem r) Source # | |
NFData r => NFData (LogItem r) Source # | |
Defined in Brassica.SoundChange.Apply.Internal | |
type Rep (LogItem r) Source # | |
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)))) |
Logs the evolution of a PWord
as various actions are applied to
it. The actions (usually Statement
s) are of type r
.
PWordLog | |
|
Instances
Functor PWordLog Source # | |
Generic (PWordLog r) Source # | |
Show r => Show (PWordLog r) Source # | |
NFData r => NFData (PWordLog r) Source # | |
Defined in Brassica.SoundChange.Apply.Internal | |
type Rep (PWordLog r) Source # | |
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>→</td><td>tazha</td><td>(r / zh)</td></tr><tr><td></td><td>→</td><td>tazh</td><td>(V / / _ #)</td></tr>"
Which might be displayed in an HTML table as something like the following:
tara | → | tazha | (r / zh) |
→ | tazh | (V _ #) |
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 #
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.)