Copyright | See LICENSE file |
---|---|
License | BSD3 |
Maintainer | Brad Neimann |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Brassica.SoundChange.Apply
Description
This module contains functions to apply one or more expanded sound changes to words.
The most important function is applyChanges
, which applies a set
of SoundChanges
to an input word. It
returns a log of all sound changes and other actions which were
applied to produce intermediate forms and the final result. The
results can be summarised using the functions in
Reporting results.
Synopsis
- applyRuleStr :: Rule Expanded -> PWord -> [PWord]
- applyStatementStr :: Statement Expanded GraphemeList -> PWord -> [PWord]
- applyChanges :: SoundChanges Expanded GraphemeList -> PWord -> [Log (Statement Expanded GraphemeList)]
- data Log r = Log {
- inputWord :: PWord
- derivations :: [LogItem r]
- data LogItem r
- = ActionApplied r (Maybe PWord)
- | ReportWord PWord
- getOutput :: Log r -> Maybe PWord
- getReports :: Log r -> [PWord]
- getChangedOutputs :: Log (Statement c d) -> Maybe (PWord, Bool)
- getChangedReports :: Log (Statement c d) -> [(PWord, Bool)]
- reportAsText :: (r -> String) -> Log r -> String
- reportAsHtmlRows :: (r -> String) -> Log r -> String
Applying single rules
applyRuleStr :: Rule Expanded -> PWord -> [PWord] Source #
Apply a single sound change Rule
to a word.
applyStatementStr :: Statement Expanded GraphemeList -> PWord -> [PWord] Source #
Apply a single Statement
to a word. The statement can be a
sound change, a filter, or any other element which remains in a
sound change file after expansion.
Applying multiple sound changes
applyChanges :: SoundChanges Expanded GraphemeList -> PWord -> [Log (Statement Expanded GraphemeList)] Source #
Apply a set of SoundChanges
to a word, returning a log of which
sound changes applied to produce each output word.
Logs the evolution of a word as it undergoes sound changes and other actions.
Constructors
Log | |
Fields
|
Instances
Functor Log Source # | |
Generic (Log r) Source # | |
Show r => Show (Log r) Source # | |
NFData r => NFData (Log r) Source # | |
Defined in Brassica.SoundChange.Apply.Internal | |
type Rep (Log r) Source # | |
Defined in Brassica.SoundChange.Apply.Internal type Rep (Log r) = D1 ('MetaData "Log" "Brassica.SoundChange.Apply.Internal" "brassica-1.0.0-23v7eBGV3gz5i0Q0Z9IDsG" 'False) (C1 ('MetaCons "Log" 'PrefixI 'True) (S1 ('MetaSel ('Just "inputWord") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PWord) :*: S1 ('MetaSel ('Just "derivations") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [LogItem r]))) |
A log item representing a single action r
(usually a
Statement
), and the result from that action.
Constructors
ActionApplied r (Maybe PWord) | The word was modified: gives the output word, or |
ReportWord PWord | Corresponds to |
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-1.0.0-23v7eBGV3gz5i0Q0Z9IDsG" 'False) (C1 ('MetaCons "ActionApplied" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 r) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe PWord))) :+: C1 ('MetaCons "ReportWord" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PWord))) |
Reporting results
getReports :: Log r -> [PWord] Source #
Returns, in order: the input word, any intermediate results from
ReportS
, and then the final output.
getChangedOutputs :: Log (Statement c d) -> Maybe (PWord, Bool) Source #
Returns the final output from a sound change log, as well as an
indication of whether any sound changes have applied to it
(accounting for highlightChanges
flags).
getChangedReports :: Log (Statement c d) -> [(PWord, Bool)] Source #
A combination of getOutput
and getChangedOutputs
: returns all
intermediate results, as well as whether each has undergone any
sound changes.
Pretty-print a Log
as plain text. For instance, this log:
Log
{inputWord
= ["t", "a", "r", "a"] ,derivations
= [ (Just
["t", "a", "zh", "a"], "r / zh") , (Just
["t", "a", "zh"], "V / / _ #") ] }
Would be pretty-printed by
as:reportAsText
id
tara -> tazha (r / zh) -> tazh (V / / _ #)
Pretty-print a single Log
as rows of an HTML table. For
instance, the example log given in the documentation for
reportAsText
would be converted to the following HTML:
<tr><td>tara</td><td>→</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 a browser as follows:
tara | → | tazha | (r / zh) |
→ | tazh | (V _ #) |