{-# LANGUAGE DeriveAnyClass  #-}
{-# LANGUAGE DeriveFunctor   #-}
{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE TupleSections   #-}

{-| __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.
-}
module Brassica.SoundChange.Frontend.Internal where

import Data.Bifunctor (second)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Void (Void)
import GHC.Generics (Generic)

import Control.DeepSeq (NFData)
import Text.Megaparsec (ParseErrorBundle)

import Brassica.MDF (MDF, parseMDFWithTokenisation, componentiseMDF, componentiseMDFWordsOnly, duplicateEtymologies)
import Brassica.SoundChange.Apply
import Brassica.SoundChange.Apply.Internal (applyChangesWithLog, toPWordLog)
import Brassica.SoundChange.Category
import Brassica.SoundChange.Tokenise
import Brassica.SoundChange.Types

-- | Rule application mode of the SCA.

data ApplicationMode
    = ApplyRules HighlightMode OutputMode String
    | ReportRulesApplied
    deriving (Int -> ApplicationMode -> ShowS
[ApplicationMode] -> ShowS
ApplicationMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationMode] -> ShowS
$cshowList :: [ApplicationMode] -> ShowS
show :: ApplicationMode -> String
$cshow :: ApplicationMode -> String
showsPrec :: Int -> ApplicationMode -> ShowS
$cshowsPrec :: Int -> ApplicationMode -> ShowS
Show, ApplicationMode -> ApplicationMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationMode -> ApplicationMode -> Bool
$c/= :: ApplicationMode -> ApplicationMode -> Bool
== :: ApplicationMode -> ApplicationMode -> Bool
$c== :: ApplicationMode -> ApplicationMode -> Bool
Eq)

data HighlightMode
    = NoHighlight
    | DifferentToLastRun
    | DifferentToInput
    deriving (Int -> HighlightMode -> ShowS
[HighlightMode] -> ShowS
HighlightMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HighlightMode] -> ShowS
$cshowList :: [HighlightMode] -> ShowS
show :: HighlightMode -> String
$cshow :: HighlightMode -> String
showsPrec :: Int -> HighlightMode -> ShowS
$cshowsPrec :: Int -> HighlightMode -> ShowS
Show, HighlightMode -> HighlightMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HighlightMode -> HighlightMode -> Bool
$c/= :: HighlightMode -> HighlightMode -> Bool
== :: HighlightMode -> HighlightMode -> Bool
$c== :: HighlightMode -> HighlightMode -> Bool
Eq)
instance Enum HighlightMode where
    -- used for conversion to and from C, so want control over values

    fromEnum :: HighlightMode -> Int
fromEnum HighlightMode
NoHighlight = Int
0
    fromEnum HighlightMode
DifferentToLastRun = Int
1
    fromEnum HighlightMode
DifferentToInput = Int
2

    toEnum :: Int -> HighlightMode
toEnum Int
0 = HighlightMode
NoHighlight
    toEnum Int
1 = HighlightMode
DifferentToLastRun
    toEnum Int
2 = HighlightMode
DifferentToInput
    toEnum Int
_ = forall a. HasCallStack => a
undefined

data OutputMode
    = MDFOutput
    | WordsOnlyOutput
    | MDFOutputWithEtymons
    | WordsWithProtoOutput
    deriving (Int -> OutputMode -> ShowS
[OutputMode] -> ShowS
OutputMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputMode] -> ShowS
$cshowList :: [OutputMode] -> ShowS
show :: OutputMode -> String
$cshow :: OutputMode -> String
showsPrec :: Int -> OutputMode -> ShowS
$cshowsPrec :: Int -> OutputMode -> ShowS
Show, OutputMode -> OutputMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputMode -> OutputMode -> Bool
$c/= :: OutputMode -> OutputMode -> Bool
== :: OutputMode -> OutputMode -> Bool
$c== :: OutputMode -> OutputMode -> Bool
Eq)
instance Enum OutputMode where
    -- used for conversion to and from C, so want control over values

    fromEnum :: OutputMode -> Int
fromEnum OutputMode
MDFOutput = Int
0
    fromEnum OutputMode
WordsOnlyOutput = Int
1
    fromEnum OutputMode
MDFOutputWithEtymons = Int
2
    fromEnum OutputMode
WordsWithProtoOutput = Int
3

    toEnum :: Int -> OutputMode
toEnum Int
0 = OutputMode
MDFOutput
    toEnum Int
1 = OutputMode
WordsOnlyOutput
    toEnum Int
2 = OutputMode
MDFOutputWithEtymons
    toEnum Int
3 = OutputMode
WordsWithProtoOutput
    toEnum Int
_ = forall a. HasCallStack => a
undefined

data TokenisationMode = Normal | AddEtymons
    deriving (Int -> TokenisationMode -> ShowS
[TokenisationMode] -> ShowS
TokenisationMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenisationMode] -> ShowS
$cshowList :: [TokenisationMode] -> ShowS
show :: TokenisationMode -> String
$cshow :: TokenisationMode -> String
showsPrec :: Int -> TokenisationMode -> ShowS
$cshowsPrec :: Int -> TokenisationMode -> ShowS
Show, TokenisationMode -> TokenisationMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenisationMode -> TokenisationMode -> Bool
$c/= :: TokenisationMode -> TokenisationMode -> Bool
== :: TokenisationMode -> TokenisationMode -> Bool
$c== :: TokenisationMode -> TokenisationMode -> Bool
Eq)
instance Enum TokenisationMode where
    -- used for conversion to and from C, so want control over values

    fromEnum :: TokenisationMode -> Int
fromEnum TokenisationMode
Normal = Int
0
    fromEnum TokenisationMode
AddEtymons = Int
1

    toEnum :: Int -> TokenisationMode
toEnum Int
0 = TokenisationMode
Normal
    toEnum Int
1 = TokenisationMode
AddEtymons
    toEnum Int
_ = forall a. HasCallStack => a
undefined

tokenisationModeFor :: ApplicationMode -> TokenisationMode
tokenisationModeFor :: ApplicationMode -> TokenisationMode
tokenisationModeFor (ApplyRules HighlightMode
_ OutputMode
MDFOutputWithEtymons String
_) = TokenisationMode
AddEtymons
tokenisationModeFor ApplicationMode
_ = TokenisationMode
Normal

-- | Output of a single application of rules to a wordlist: either a

-- list of possibly highlighted words, an applied rules table, or a

-- parse error.

data ApplicationOutput a r
    = HighlightedWords [Component (a, Bool)]
    | AppliedRulesTable [PWordLog r]
    | ParseError (ParseErrorBundle String Void)
    | ExpandError ExpandError
    deriving (Int -> ApplicationOutput a r -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a r.
(Show a, Show r) =>
Int -> ApplicationOutput a r -> ShowS
forall a r. (Show a, Show r) => [ApplicationOutput a r] -> ShowS
forall a r. (Show a, Show r) => ApplicationOutput a r -> String
showList :: [ApplicationOutput a r] -> ShowS
$cshowList :: forall a r. (Show a, Show r) => [ApplicationOutput a r] -> ShowS
show :: ApplicationOutput a r -> String
$cshow :: forall a r. (Show a, Show r) => ApplicationOutput a r -> String
showsPrec :: Int -> ApplicationOutput a r -> ShowS
$cshowsPrec :: forall a r.
(Show a, Show r) =>
Int -> ApplicationOutput a r -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a r x.
Rep (ApplicationOutput a r) x -> ApplicationOutput a r
forall a r x.
ApplicationOutput a r -> Rep (ApplicationOutput a r) x
$cto :: forall a r x.
Rep (ApplicationOutput a r) x -> ApplicationOutput a r
$cfrom :: forall a r x.
ApplicationOutput a r -> Rep (ApplicationOutput a r) x
Generic, forall a. (a -> ()) -> NFData a
forall a r. (NFData a, NFData r) => ApplicationOutput a r -> ()
rnf :: ApplicationOutput a r -> ()
$crnf :: forall a r. (NFData a, NFData r) => ApplicationOutput a r -> ()
NFData)

-- | Kind of input: either a raw wordlist, or an MDF file.

data InputLexiconFormat = Raw | MDF
    deriving (Int -> InputLexiconFormat -> ShowS
[InputLexiconFormat] -> ShowS
InputLexiconFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputLexiconFormat] -> ShowS
$cshowList :: [InputLexiconFormat] -> ShowS
show :: InputLexiconFormat -> String
$cshow :: InputLexiconFormat -> String
showsPrec :: Int -> InputLexiconFormat -> ShowS
$cshowsPrec :: Int -> InputLexiconFormat -> ShowS
Show, InputLexiconFormat -> InputLexiconFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputLexiconFormat -> InputLexiconFormat -> Bool
$c/= :: InputLexiconFormat -> InputLexiconFormat -> Bool
== :: InputLexiconFormat -> InputLexiconFormat -> Bool
$c== :: InputLexiconFormat -> InputLexiconFormat -> Bool
Eq)
instance Enum InputLexiconFormat where
    -- used for conversion to and from C, so want control over values

    fromEnum :: InputLexiconFormat -> Int
fromEnum InputLexiconFormat
Raw = Int
0
    fromEnum InputLexiconFormat
MDF = Int
1

    toEnum :: Int -> InputLexiconFormat
toEnum Int
0 = InputLexiconFormat
Raw
    toEnum Int
1 = InputLexiconFormat
MDF
    toEnum Int
_ = forall a. HasCallStack => a
undefined

data ParseOutput a = ParsedRaw [Component a] | ParsedMDF (MDF [Component a])
    deriving (Int -> ParseOutput a -> ShowS
forall a. Show a => Int -> ParseOutput a -> ShowS
forall a. Show a => [ParseOutput a] -> ShowS
forall a. Show a => ParseOutput a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseOutput a] -> ShowS
$cshowList :: forall a. Show a => [ParseOutput a] -> ShowS
show :: ParseOutput a -> String
$cshow :: forall a. Show a => ParseOutput a -> String
showsPrec :: Int -> ParseOutput a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ParseOutput a -> ShowS
Show, forall a b. a -> ParseOutput b -> ParseOutput a
forall a b. (a -> b) -> ParseOutput a -> ParseOutput b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ParseOutput b -> ParseOutput a
$c<$ :: forall a b. a -> ParseOutput b -> ParseOutput a
fmap :: forall a b. (a -> b) -> ParseOutput a -> ParseOutput b
$cfmap :: forall a b. (a -> b) -> ParseOutput a -> ParseOutput b
Functor)

componentise :: OutputMode -> [a] -> ParseOutput a -> [Component a]
componentise :: forall a. OutputMode -> [a] -> ParseOutput a -> [Component a]
componentise OutputMode
WordsWithProtoOutput [a]
ws (ParsedRaw [Component a]
cs) = forall a. [a] -> [Component a] -> [Component a]
intersperseWords [a]
ws [Component a]
cs
componentise OutputMode
_                    [a]
_ (ParsedRaw [Component a]
cs) = [Component a]
cs
componentise OutputMode
MDFOutput            [a]
_ (ParsedMDF MDF [Component a]
mdf) = forall a. MDF [Component a] -> [Component a]
componentiseMDF MDF [Component a]
mdf
componentise OutputMode
MDFOutputWithEtymons [a]
_ (ParsedMDF MDF [Component a]
mdf) = forall a. MDF [Component a] -> [Component a]
componentiseMDF MDF [Component a]
mdf
componentise OutputMode
WordsOnlyOutput      [a]
_ (ParsedMDF MDF [Component a]
mdf) = forall a. MDF [Component a] -> [Component a]
componentiseMDFWordsOnly MDF [Component a]
mdf
componentise OutputMode
WordsWithProtoOutput [a]
ws (ParsedMDF MDF [Component a]
mdf) = forall a. [a] -> [Component a] -> [Component a]
intersperseWords [a]
ws forall a b. (a -> b) -> a -> b
$ forall a. MDF [Component a] -> [Component a]
componentiseMDFWordsOnly MDF [Component a]
mdf

intersperseWords :: [a] -> [Component a] -> [Component a]
intersperseWords :: forall a. [a] -> [Component a] -> [Component a]
intersperseWords (a
w:[a]
ws) (Word a
c:[Component a]
cs) =
    forall a. a -> Component a
Word a
w forall a. a -> [a] -> [a]
: forall a. String -> Component a
Separator String
" → " forall a. a -> [a] -> [a]
: forall a. a -> Component a
Word a
c forall a. a -> [a] -> [a]
: forall a. String -> Component a
Separator String
"\n" forall a. a -> [a] -> [a]
: forall a. [a] -> [Component a] -> [Component a]
intersperseWords [a]
ws [Component a]
cs
intersperseWords [a]
ws (Component a
_:[Component a]
cs) = forall a. [a] -> [Component a] -> [Component a]
intersperseWords [a]
ws [Component a]
cs
intersperseWords [] [Component a]
cs = [Component a]
cs
intersperseWords [a]
_ [] = []

tokeniseAccordingToInputFormat
    :: InputLexiconFormat
    -> TokenisationMode
    -> SoundChanges Expanded [Grapheme]
    -> String
    -> Either (ParseErrorBundle String Void) (ParseOutput PWord)
tokeniseAccordingToInputFormat :: InputLexiconFormat
-> TokenisationMode
-> SoundChanges Expanded PWord
-> String
-> Either (ParseErrorBundle String Void) (ParseOutput PWord)
tokeniseAccordingToInputFormat InputLexiconFormat
Raw TokenisationMode
_ SoundChanges Expanded PWord
cs =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Component a] -> ParseOutput a
ParsedRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (c :: LexemeType -> *).
([String] -> t) -> SoundChanges c PWord -> t
withFirstCategoriesDecl [String]
-> String
-> Either (ParseErrorBundle String Void) [Component PWord]
tokeniseWords SoundChanges Expanded PWord
cs
tokeniseAccordingToInputFormat InputLexiconFormat
MDF TokenisationMode
Normal SoundChanges Expanded PWord
cs =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. MDF [Component a] -> ParseOutput a
ParsedMDF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (c :: LexemeType -> *).
([String] -> t) -> SoundChanges c PWord -> t
withFirstCategoriesDecl [String]
-> String
-> Either (ParseErrorBundle String Void) (MDF [Component PWord])
parseMDFWithTokenisation SoundChanges Expanded PWord
cs
tokeniseAccordingToInputFormat InputLexiconFormat
MDF TokenisationMode
AddEtymons SoundChanges Expanded PWord
cs =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. MDF [Component a] -> ParseOutput a
ParsedMDF
    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 (forall v. (v -> String) -> MDF v -> MDF v
duplicateEtymologies forall a b. (a -> b) -> a -> b
$ (Char
'*'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Component PWord] -> String
detokeniseWords)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (c :: LexemeType -> *).
([String] -> t) -> SoundChanges c PWord -> t
withFirstCategoriesDecl [String]
-> String
-> Either (ParseErrorBundle String Void) (MDF [Component PWord])
parseMDFWithTokenisation SoundChanges Expanded PWord
cs

getParsedWords :: ParseOutput a -> [a]
getParsedWords :: forall a. ParseOutput a -> [a]
getParsedWords (ParsedRaw [Component a]
cs) = forall a. [Component a] -> [a]
getWords [Component a]
cs
getParsedWords (ParsedMDF MDF [Component a]
mdf) = forall a. [Component a] -> [a]
getWords forall a b. (a -> b) -> a -> b
$ forall a. MDF [Component a] -> [Component a]
componentiseMDF MDF [Component a]
mdf

-- | Top-level dispatcher for an interactive frontend: given a textual

-- wordlist and a list of sound changes, returns the result of running

-- the changes in the specified mode.

parseTokeniseAndApplyRules
    :: SoundChanges CategorySpec Directive -- ^ changes

    -> String       -- ^ words

    -> InputLexiconFormat
    -> ApplicationMode
    -> Maybe [Component PWord]  -- ^ previous results

    -> ApplicationOutput PWord (Statement Expanded [Grapheme])
parseTokeniseAndApplyRules :: SoundChanges CategorySpec Directive
-> String
-> InputLexiconFormat
-> ApplicationMode
-> Maybe [Component PWord]
-> ApplicationOutput PWord (Statement Expanded PWord)
parseTokeniseAndApplyRules SoundChanges CategorySpec Directive
statements String
ws InputLexiconFormat
intype ApplicationMode
mode Maybe [Component PWord]
prev =
    case SoundChanges CategorySpec Directive
-> Either ExpandError (SoundChanges Expanded PWord)
expandSoundChanges SoundChanges CategorySpec Directive
statements of
        Left ExpandError
e -> forall a r. ExpandError -> ApplicationOutput a r
ExpandError ExpandError
e
        Right SoundChanges Expanded PWord
statements' ->
            let tmode :: TokenisationMode
tmode = ApplicationMode -> TokenisationMode
tokenisationModeFor ApplicationMode
mode in
            case InputLexiconFormat
-> TokenisationMode
-> SoundChanges Expanded PWord
-> String
-> Either (ParseErrorBundle String Void) (ParseOutput PWord)
tokeniseAccordingToInputFormat InputLexiconFormat
intype TokenisationMode
tmode SoundChanges Expanded PWord
statements' String
ws of
                Left ParseErrorBundle String Void
e -> forall a r. ParseErrorBundle String Void -> ApplicationOutput a r
ParseError ParseErrorBundle String Void
e
                Right ParseOutput PWord
toks
                  | [PWord]
ws' <- forall a. ParseOutput a -> [a]
getParsedWords ParseOutput PWord
toks
                  -> case ApplicationMode
mode of
                    ApplicationMode
ReportRulesApplied ->
                        forall a r. [PWordLog r] -> ApplicationOutput a r
AppliedRulesTable forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall r. [LogItem r] -> Maybe (PWordLog r)
toPWordLog forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
                            forall a. [Component a] -> [a]
getWords forall a b. (a -> b) -> a -> b
$ forall a. OutputMode -> [a] -> ParseOutput a -> [Component a]
componentise OutputMode
WordsOnlyOutput [] forall a b. (a -> b) -> a -> b
$
                                SoundChanges Expanded PWord
-> PWord -> [[LogItem (Statement Expanded PWord)]]
applyChangesWithLog SoundChanges Expanded PWord
statements' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseOutput PWord
toks
                    ApplyRules HighlightMode
DifferentToLastRun OutputMode
mdfout String
sep ->
                        let result :: [Component PWord]
result = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. String -> Component [a] -> [Component a]
splitMultipleResults String
sep) forall a b. (a -> b) -> a -> b
$
                              forall a. OutputMode -> [a] -> ParseOutput a -> [Component a]
componentise OutputMode
mdfout (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure [PWord]
ws') forall a b. (a -> b) -> a -> b
$ SoundChanges Expanded PWord -> PWord -> [PWord]
applyChanges SoundChanges Expanded PWord
statements' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseOutput PWord
toks
                        in forall a r. [Component (a, Bool)] -> ApplicationOutput a r
HighlightedWords forall a b. (a -> b) -> a -> b
$
                            forall a b c.
[Component a]
-> [Component b] -> b -> (a -> b -> c) -> [Component c]
zipWithComponents [Component PWord]
result (forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Component PWord]
prev) [] forall a b. (a -> b) -> a -> b
$ \PWord
thisWord PWord
prevWord ->
                                (PWord
thisWord, PWord
thisWord forall a. Eq a => a -> a -> Bool
/= PWord
prevWord)
                    ApplyRules HighlightMode
DifferentToInput OutputMode
mdfout String
sep ->
                        forall a r. [Component (a, Bool)] -> ApplicationOutput a r
HighlightedWords forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. String -> Component [a] -> [Component a]
splitMultipleResults String
sep) forall a b. (a -> b) -> a -> b
$
                            forall a. OutputMode -> [a] -> ParseOutput a -> [Component a]
componentise OutputMode
mdfout (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Bool
False)) [PWord]
ws') forall a b. (a -> b) -> a -> b
$
                                SoundChanges Expanded PWord -> PWord -> [(PWord, Bool)]
applyChangesWithChanges SoundChanges Expanded PWord
statements' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseOutput PWord
toks
                    ApplyRules HighlightMode
NoHighlight OutputMode
mdfout String
sep ->
                        forall a r. [Component (a, Bool)] -> ApplicationOutput a r
HighlightedWords forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (,Bool
False) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. String -> Component [a] -> [Component a]
splitMultipleResults String
sep) forall a b. (a -> b) -> a -> b
$
                            forall a. OutputMode -> [a] -> ParseOutput a -> [Component a]
componentise OutputMode
mdfout (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure [PWord]
ws') forall a b. (a -> b) -> a -> b
$
                                SoundChanges Expanded PWord -> PWord -> [PWord]
applyChanges SoundChanges Expanded PWord
statements' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseOutput PWord
toks
  where
    -- Zips two tokenised input strings. Compared to normal 'zipWith'

    -- this has two special properties:

    --

    --   * It only zips v'Word's. Any non-v'Word's in the first argument

    --     will be passed unaltered to the output; any in the second

    --     argument will be ignored.

    --

    --   * The returned list will have the same number of elements as does

    --     the first argument. If a v'Word' in the first argument has no

    --     corresponding v'Word' in the second, the zipping function is

    --     called using the default @b@ value given as the third argument.

    --     Such a v'Word' in the second argument will simply be ignored.

    --

    -- Note the persistent assymetry in the definition: each 'Component'

    -- in the first argument will be reflected in the output, but each in

    -- the second argument may be ignored.

    zipWithComponents :: [Component a] -> [Component b] -> b -> (a -> b -> c) -> [Component c]
    zipWithComponents :: forall a b c.
[Component a]
-> [Component b] -> b -> (a -> b -> c) -> [Component c]
zipWithComponents []             [Component b]
_            b
_  a -> b -> c
_ = []
    zipWithComponents [Component a]
as            []            b
bd a -> b -> c
f = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (a -> b -> c
`f` b
bd) [Component a]
as
    zipWithComponents (Word a
a:[Component a]
as)   (Word b
b:[Component b]
bs)   b
bd a -> b -> c
f = forall a. a -> Component a
Word (a -> b -> c
f a
a b
b) forall a. a -> [a] -> [a]
: forall a b c.
[Component a]
-> [Component b] -> b -> (a -> b -> c) -> [Component c]
zipWithComponents [Component a]
as [Component b]
bs b
bd a -> b -> c
f
    zipWithComponents as :: [Component a]
as@(Word a
_:[Component a]
_) (Component b
_:[Component b]
bs)        b
bd a -> b -> c
f = forall a b c.
[Component a]
-> [Component b] -> b -> (a -> b -> c) -> [Component c]
zipWithComponents [Component a]
as [Component b]
bs b
bd a -> b -> c
f
    zipWithComponents (Component a
a:[Component a]
as)        bs :: [Component b]
bs@(Word b
_:[Component b]
_) b
bd a -> b -> c
f = forall a b. Component a -> Component b
unsafeCastComponent Component a
a forall a. a -> [a] -> [a]
: forall a b c.
[Component a]
-> [Component b] -> b -> (a -> b -> c) -> [Component c]
zipWithComponents [Component a]
as [Component b]
bs b
bd a -> b -> c
f
    zipWithComponents (Component a
a:[Component a]
as)        (Component b
_:[Component b]
bs)        b
bd a -> b -> c
f = forall a b. Component a -> Component b
unsafeCastComponent Component a
a forall a. a -> [a] -> [a]
: forall a b c.
[Component a]
-> [Component b] -> b -> (a -> b -> c) -> [Component c]
zipWithComponents [Component a]
as [Component b]
bs b
bd a -> b -> c
f

    unsafeCastComponent :: Component a -> Component b
    unsafeCastComponent :: forall a b. Component a -> Component b
unsafeCastComponent (Word a
_) = forall a. HasCallStack => String -> a
error String
"unsafeCastComponent: attempted to cast a word!"
    unsafeCastComponent (Separator String
s) = forall a. String -> Component a
Separator String
s
    unsafeCastComponent (Gloss String
s) = forall a. String -> Component a
Gloss String
s