{-# LANGUAGE DeriveAnyClass  #-}
{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE TupleSections   #-}

-- |

-- Module      : Brassica.SoundChange.Frontend.Internal

-- Copyright   : See LICENSE file

-- License     : BSD3

-- Maintainer  : Brad Neimann

--

-- __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.

--

-- This module exists primarily as an internal common interface for

-- Brassica’s two ‘official’ GUI frontends (desktop and web). If you

-- wish to make your own frontend to Brassica, it is probably easier

-- to write it yourself rather than trying to use this.

module Brassica.SoundChange.Frontend.Internal where

import Control.Monad ((<=<))
import Data.Containers.ListUtils (nubOrd)
import Data.List (transpose, intersperse)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Void (Void)
import GHC.Generics (Generic)
import Myers.Diff (getDiff, PolyDiff(..))

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

import Brassica.SFM.MDF
import Brassica.SFM.SFM
import Brassica.SoundChange.Apply
import Brassica.SoundChange.Tokenise
import Brassica.SoundChange.Types

-- | Rule application mode of the SCA.

data ApplicationMode
    = ApplyRules HighlightMode OutputMode String
    -- ^ Apply sound changes as normal, with the given modes and

    -- separator

    | ReportRulesApplied
    -- ^ Apply reporting the rules which were applied (as HTML)

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

-- | Get the 'OutputMode' if one is set, otherwise default to

-- 'WordsOnlyOutput'.

getOutputMode :: ApplicationMode -> OutputMode
getOutputMode :: ApplicationMode -> OutputMode
getOutputMode (ApplyRules HighlightMode
_ OutputMode
o String
_) = OutputMode
o
getOutputMode ApplicationMode
ReportRulesApplied = OutputMode
WordsOnlyOutput

-- | Mode for highlighting output words

data HighlightMode
    = NoHighlight
    | DifferentToLastRun
    | DifferentToInput
    -- ^ NB. now labeled ‘any rule applied’ in GUI

    deriving (Int -> HighlightMode -> ShowS
[HighlightMode] -> ShowS
HighlightMode -> String
(Int -> HighlightMode -> ShowS)
-> (HighlightMode -> String)
-> ([HighlightMode] -> ShowS)
-> Show HighlightMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HighlightMode -> ShowS
showsPrec :: Int -> HighlightMode -> ShowS
$cshow :: HighlightMode -> String
show :: HighlightMode -> String
$cshowList :: [HighlightMode] -> ShowS
showList :: [HighlightMode] -> ShowS
Show, HighlightMode -> HighlightMode -> Bool
(HighlightMode -> HighlightMode -> Bool)
-> (HighlightMode -> HighlightMode -> Bool) -> Eq HighlightMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HighlightMode -> HighlightMode -> Bool
== :: HighlightMode -> HighlightMode -> Bool
$c/= :: HighlightMode -> HighlightMode -> Bool
/= :: 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
_ = HighlightMode
forall a. HasCallStack => a
undefined

-- | Mode for reporting output words (and sometimes intermediate and

-- input words too)

data OutputMode
    = MDFOutput
    | WordsOnlyOutput
    | MDFOutputWithEtymons
    | WordsWithProtoOutput
    | WordsWithProtoOutputPreserve
    deriving (Int -> OutputMode -> ShowS
[OutputMode] -> ShowS
OutputMode -> String
(Int -> OutputMode -> ShowS)
-> (OutputMode -> String)
-> ([OutputMode] -> ShowS)
-> Show OutputMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputMode -> ShowS
showsPrec :: Int -> OutputMode -> ShowS
$cshow :: OutputMode -> String
show :: OutputMode -> String
$cshowList :: [OutputMode] -> ShowS
showList :: [OutputMode] -> ShowS
Show, OutputMode -> OutputMode -> Bool
(OutputMode -> OutputMode -> Bool)
-> (OutputMode -> OutputMode -> Bool) -> Eq OutputMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputMode -> OutputMode -> Bool
== :: OutputMode -> OutputMode -> Bool
$c/= :: OutputMode -> OutputMode -> Bool
/= :: 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
    fromEnum OutputMode
WordsWithProtoOutputPreserve = Int
4

    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
4 = OutputMode
WordsWithProtoOutputPreserve
    toEnum Int
_ = OutputMode
forall a. HasCallStack => a
undefined

-- | 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 [Log r]
    | ParseError (ParseErrorBundle String Void)
    deriving (Int -> ApplicationOutput a r -> ShowS
[ApplicationOutput a r] -> ShowS
ApplicationOutput a r -> String
(Int -> ApplicationOutput a r -> ShowS)
-> (ApplicationOutput a r -> String)
-> ([ApplicationOutput a r] -> ShowS)
-> Show (ApplicationOutput a r)
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
$cshowsPrec :: forall a r.
(Show a, Show r) =>
Int -> ApplicationOutput a r -> ShowS
showsPrec :: Int -> ApplicationOutput a r -> ShowS
$cshow :: forall a r. (Show a, Show r) => ApplicationOutput a r -> String
show :: ApplicationOutput a r -> String
$cshowList :: forall a r. (Show a, Show r) => [ApplicationOutput a r] -> ShowS
showList :: [ApplicationOutput a r] -> ShowS
Show, (forall x. ApplicationOutput a r -> Rep (ApplicationOutput a r) x)
-> (forall x.
    Rep (ApplicationOutput a r) x -> ApplicationOutput a r)
-> Generic (ApplicationOutput a r)
forall x. Rep (ApplicationOutput a r) x -> ApplicationOutput a r
forall x. ApplicationOutput a r -> Rep (ApplicationOutput a r) x
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
$cfrom :: forall a r x.
ApplicationOutput a r -> Rep (ApplicationOutput a r) x
from :: forall x. ApplicationOutput a r -> Rep (ApplicationOutput a r) x
$cto :: forall a r x.
Rep (ApplicationOutput a r) x -> ApplicationOutput a r
to :: forall x. Rep (ApplicationOutput a r) x -> ApplicationOutput a r
Generic, ApplicationOutput a r -> ()
(ApplicationOutput a r -> ()) -> NFData (ApplicationOutput a r)
forall a. (a -> ()) -> NFData a
forall a r. (NFData a, NFData r) => ApplicationOutput a r -> ()
$crnf :: forall a r. (NFData a, NFData r) => ApplicationOutput a r -> ()
rnf :: ApplicationOutput a r -> ()
NFData)

-- | For MDF input, the hierarchy used

data MDFHierarchy = Standard | Alternate
    deriving (Int -> MDFHierarchy -> ShowS
[MDFHierarchy] -> ShowS
MDFHierarchy -> String
(Int -> MDFHierarchy -> ShowS)
-> (MDFHierarchy -> String)
-> ([MDFHierarchy] -> ShowS)
-> Show MDFHierarchy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MDFHierarchy -> ShowS
showsPrec :: Int -> MDFHierarchy -> ShowS
$cshow :: MDFHierarchy -> String
show :: MDFHierarchy -> String
$cshowList :: [MDFHierarchy] -> ShowS
showList :: [MDFHierarchy] -> ShowS
Show, MDFHierarchy -> MDFHierarchy -> Bool
(MDFHierarchy -> MDFHierarchy -> Bool)
-> (MDFHierarchy -> MDFHierarchy -> Bool) -> Eq MDFHierarchy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MDFHierarchy -> MDFHierarchy -> Bool
== :: MDFHierarchy -> MDFHierarchy -> Bool
$c/= :: MDFHierarchy -> MDFHierarchy -> Bool
/= :: MDFHierarchy -> MDFHierarchy -> Bool
Eq)

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

data InputLexiconFormat = Raw | MDF MDFHierarchy
    deriving (Int -> InputLexiconFormat -> ShowS
[InputLexiconFormat] -> ShowS
InputLexiconFormat -> String
(Int -> InputLexiconFormat -> ShowS)
-> (InputLexiconFormat -> String)
-> ([InputLexiconFormat] -> ShowS)
-> Show InputLexiconFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputLexiconFormat -> ShowS
showsPrec :: Int -> InputLexiconFormat -> ShowS
$cshow :: InputLexiconFormat -> String
show :: InputLexiconFormat -> String
$cshowList :: [InputLexiconFormat] -> ShowS
showList :: [InputLexiconFormat] -> ShowS
Show, InputLexiconFormat -> InputLexiconFormat -> Bool
(InputLexiconFormat -> InputLexiconFormat -> Bool)
-> (InputLexiconFormat -> InputLexiconFormat -> Bool)
-> Eq InputLexiconFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputLexiconFormat -> InputLexiconFormat -> Bool
== :: InputLexiconFormat -> InputLexiconFormat -> Bool
$c/= :: InputLexiconFormat -> InputLexiconFormat -> Bool
/= :: 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 (MDF MDFHierarchy
Standard) = Int
1
    fromEnum (MDF MDFHierarchy
Alternate) = Int
2

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

-- | Either a list of 'Component's for a Brassica wordlist file, or a

-- list of 'SFM' fields for an MDF file

data ParseOutput a = ParsedRaw [Component a] | ParsedMDF SFM
    deriving (Int -> ParseOutput a -> ShowS
[ParseOutput a] -> ShowS
ParseOutput a -> String
(Int -> ParseOutput a -> ShowS)
-> (ParseOutput a -> String)
-> ([ParseOutput a] -> ShowS)
-> Show (ParseOutput a)
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
$cshowsPrec :: forall a. Show a => Int -> ParseOutput a -> ShowS
showsPrec :: Int -> ParseOutput a -> ShowS
$cshow :: forall a. Show a => ParseOutput a -> String
show :: ParseOutput a -> String
$cshowList :: forall a. Show a => [ParseOutput a] -> ShowS
showList :: [ParseOutput a] -> ShowS
Show, (forall a b. (a -> b) -> ParseOutput a -> ParseOutput b)
-> (forall a b. a -> ParseOutput b -> ParseOutput a)
-> Functor ParseOutput
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
$cfmap :: forall a b. (a -> b) -> ParseOutput a -> ParseOutput b
fmap :: forall a b. (a -> b) -> ParseOutput a -> ParseOutput b
$c<$ :: forall a b. a -> ParseOutput b -> ParseOutput a
<$ :: forall a b. a -> ParseOutput b -> ParseOutput a
Functor, (forall m. Monoid m => ParseOutput m -> m)
-> (forall m a. Monoid m => (a -> m) -> ParseOutput a -> m)
-> (forall m a. Monoid m => (a -> m) -> ParseOutput a -> m)
-> (forall a b. (a -> b -> b) -> b -> ParseOutput a -> b)
-> (forall a b. (a -> b -> b) -> b -> ParseOutput a -> b)
-> (forall b a. (b -> a -> b) -> b -> ParseOutput a -> b)
-> (forall b a. (b -> a -> b) -> b -> ParseOutput a -> b)
-> (forall a. (a -> a -> a) -> ParseOutput a -> a)
-> (forall a. (a -> a -> a) -> ParseOutput a -> a)
-> (forall a. ParseOutput a -> [a])
-> (forall a. ParseOutput a -> Bool)
-> (forall a. ParseOutput a -> Int)
-> (forall a. Eq a => a -> ParseOutput a -> Bool)
-> (forall a. Ord a => ParseOutput a -> a)
-> (forall a. Ord a => ParseOutput a -> a)
-> (forall a. Num a => ParseOutput a -> a)
-> (forall a. Num a => ParseOutput a -> a)
-> Foldable ParseOutput
forall a. Eq a => a -> ParseOutput a -> Bool
forall a. Num a => ParseOutput a -> a
forall a. Ord a => ParseOutput a -> a
forall m. Monoid m => ParseOutput m -> m
forall a. ParseOutput a -> Bool
forall a. ParseOutput a -> Int
forall a. ParseOutput a -> [a]
forall a. (a -> a -> a) -> ParseOutput a -> a
forall m a. Monoid m => (a -> m) -> ParseOutput a -> m
forall b a. (b -> a -> b) -> b -> ParseOutput a -> b
forall a b. (a -> b -> b) -> b -> ParseOutput a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ParseOutput m -> m
fold :: forall m. Monoid m => ParseOutput m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ParseOutput a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ParseOutput a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ParseOutput a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ParseOutput a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ParseOutput a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ParseOutput a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ParseOutput a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ParseOutput a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ParseOutput a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ParseOutput a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ParseOutput a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ParseOutput a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ParseOutput a -> a
foldr1 :: forall a. (a -> a -> a) -> ParseOutput a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ParseOutput a -> a
foldl1 :: forall a. (a -> a -> a) -> ParseOutput a -> a
$ctoList :: forall a. ParseOutput a -> [a]
toList :: forall a. ParseOutput a -> [a]
$cnull :: forall a. ParseOutput a -> Bool
null :: forall a. ParseOutput a -> Bool
$clength :: forall a. ParseOutput a -> Int
length :: forall a. ParseOutput a -> Int
$celem :: forall a. Eq a => a -> ParseOutput a -> Bool
elem :: forall a. Eq a => a -> ParseOutput a -> Bool
$cmaximum :: forall a. Ord a => ParseOutput a -> a
maximum :: forall a. Ord a => ParseOutput a -> a
$cminimum :: forall a. Ord a => ParseOutput a -> a
minimum :: forall a. Ord a => ParseOutput a -> a
$csum :: forall a. Num a => ParseOutput a -> a
sum :: forall a. Num a => ParseOutput a -> a
$cproduct :: forall a. Num a => ParseOutput a -> a
product :: forall a. Num a => ParseOutput a -> a
Foldable, Functor ParseOutput
Foldable ParseOutput
(Functor ParseOutput, Foldable ParseOutput) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ParseOutput a -> f (ParseOutput b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ParseOutput (f a) -> f (ParseOutput a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ParseOutput a -> m (ParseOutput b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ParseOutput (m a) -> m (ParseOutput a))
-> Traversable ParseOutput
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ParseOutput (m a) -> m (ParseOutput a)
forall (f :: * -> *) a.
Applicative f =>
ParseOutput (f a) -> f (ParseOutput a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ParseOutput a -> m (ParseOutput b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ParseOutput a -> f (ParseOutput b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ParseOutput a -> f (ParseOutput b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ParseOutput a -> f (ParseOutput b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ParseOutput (f a) -> f (ParseOutput a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ParseOutput (f a) -> f (ParseOutput a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ParseOutput a -> m (ParseOutput b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ParseOutput a -> m (ParseOutput b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ParseOutput (m a) -> m (ParseOutput a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ParseOutput (m a) -> m (ParseOutput a)
Traversable)

-- | Given the selected input and output modes, and the expanded sound

-- changes, tokenise the input according to the format which was selected

tokeniseAccordingToInputFormat
    :: InputLexiconFormat
    -> OutputMode
    -> SoundChanges Expanded GraphemeList
    -> String
    -> Either (ParseErrorBundle String Void) [Component PWord]
tokeniseAccordingToInputFormat :: InputLexiconFormat
-> OutputMode
-> SoundChanges Expanded GraphemeList
-> String
-> Either (ParseErrorBundle String Void) [Component PWord]
tokeniseAccordingToInputFormat InputLexiconFormat
Raw OutputMode
_ SoundChanges Expanded GraphemeList
cs =
    (PWord
 -> String
 -> Either (ParseErrorBundle String Void) [Component PWord])
-> SoundChanges Expanded GraphemeList
-> String
-> Either (ParseErrorBundle String Void) [Component PWord]
forall t (c :: LexemeType -> *).
(PWord -> t) -> SoundChanges c GraphemeList -> t
withFirstCategoriesDecl PWord
-> String
-> Either (ParseErrorBundle String Void) [Component PWord]
tokeniseWords SoundChanges Expanded GraphemeList
cs
tokeniseAccordingToInputFormat (MDF MDFHierarchy
h) OutputMode
MDFOutputWithEtymons SoundChanges Expanded GraphemeList
cs =
    let h' :: Hierarchy
h' = case MDFHierarchy
h of
            MDFHierarchy
Standard -> Hierarchy
mdfHierarchy
            MDFHierarchy
Alternate -> Hierarchy
mdfAlternateHierarchy
    in
        (PWord
 -> SFM -> Either (ParseErrorBundle String Void) [Component PWord])
-> SoundChanges Expanded GraphemeList
-> SFM
-> Either (ParseErrorBundle String Void) [Component PWord]
forall t (c :: LexemeType -> *).
(PWord -> t) -> SoundChanges c GraphemeList -> t
withFirstCategoriesDecl PWord
-> SFM -> Either (ParseErrorBundle String Void) [Component PWord]
tokeniseMDF SoundChanges Expanded GraphemeList
cs (SFM -> Either (ParseErrorBundle String Void) [Component PWord])
-> (String -> Either (ParseErrorBundle String Void) SFM)
-> String
-> Either (ParseErrorBundle String Void) [Component PWord]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=<
        (SFM -> SFM)
-> Either (ParseErrorBundle String Void) SFM
-> Either (ParseErrorBundle String Void) SFM
forall a b.
(a -> b)
-> Either (ParseErrorBundle String Void) a
-> Either (ParseErrorBundle String Void) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SFMTree -> SFM
fromTree (SFMTree -> SFM) -> (SFM -> SFMTree) -> SFM -> SFM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> SFMTree -> SFMTree
duplicateEtymologies (Char
'*'Char -> ShowS
forall a. a -> [a] -> [a]
:) (SFMTree -> SFMTree) -> (SFM -> SFMTree) -> SFM -> SFMTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hierarchy -> SFM -> SFMTree
toTree Hierarchy
h')
        (Either (ParseErrorBundle String Void) SFM
 -> Either (ParseErrorBundle String Void) SFM)
-> (String -> Either (ParseErrorBundle String Void) SFM)
-> String
-> Either (ParseErrorBundle String Void) SFM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Either (ParseErrorBundle String Void) SFM
parseSFM String
""
tokeniseAccordingToInputFormat (MDF MDFHierarchy
_) OutputMode
o SoundChanges Expanded GraphemeList
cs = \String
input -> do
    SFM
sfm <- String -> String -> Either (ParseErrorBundle String Void) SFM
parseSFM String
"" String
input
    [Component PWord]
ws <- (PWord
 -> SFM -> Either (ParseErrorBundle String Void) [Component PWord])
-> SoundChanges Expanded GraphemeList
-> SFM
-> Either (ParseErrorBundle String Void) [Component PWord]
forall t (c :: LexemeType -> *).
(PWord -> t) -> SoundChanges c GraphemeList -> t
withFirstCategoriesDecl PWord
-> SFM -> Either (ParseErrorBundle String Void) [Component PWord]
tokeniseMDF SoundChanges Expanded GraphemeList
cs SFM
sfm
    [Component PWord]
-> Either (ParseErrorBundle String Void) [Component PWord]
forall a. a -> Either (ParseErrorBundle String Void) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Component PWord]
 -> Either (ParseErrorBundle String Void) [Component PWord])
-> [Component PWord]
-> Either (ParseErrorBundle String Void) [Component PWord]
forall a b. (a -> b) -> a -> b
$ case OutputMode
o of
        OutputMode
MDFOutput -> [Component PWord]
ws
        OutputMode
_ ->
            -- need to extract words for other output modes

            -- also add separators to keep words apart visually

            Component PWord -> [Component PWord] -> [Component PWord]
forall a. a -> [a] -> [a]
intersperse (String -> Component PWord
forall a. String -> Component a
Separator String
"\n") ([Component PWord] -> [Component PWord])
-> [Component PWord] -> [Component PWord]
forall a b. (a -> b) -> a -> b
$ PWord -> Component PWord
forall a. a -> Component a
Word (PWord -> Component PWord) -> [PWord] -> [Component PWord]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Component PWord] -> [PWord]
forall a. [Component a] -> [a]
getWords [Component PWord]
ws

-- | 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
    :: (forall a b. (a -> b) -> [Component a] -> [Component b])  -- ^ mapping function to use (for parallelism)

    -> SoundChanges Expanded GraphemeList -- ^ changes

    -> String       -- ^ words

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

    -> ApplicationOutput PWord (Statement Expanded GraphemeList)
parseTokeniseAndApplyRules :: (forall a b. (a -> b) -> [Component a] -> [Component b])
-> SoundChanges Expanded GraphemeList
-> String
-> InputLexiconFormat
-> ApplicationMode
-> Maybe [Component PWord]
-> ApplicationOutput PWord (Statement Expanded GraphemeList)
parseTokeniseAndApplyRules forall a b. (a -> b) -> [Component a] -> [Component b]
parFmap SoundChanges Expanded GraphemeList
statements String
ws InputLexiconFormat
intype ApplicationMode
mode Maybe [Component PWord]
prev =
    case InputLexiconFormat
-> OutputMode
-> SoundChanges Expanded GraphemeList
-> String
-> Either (ParseErrorBundle String Void) [Component PWord]
tokeniseAccordingToInputFormat InputLexiconFormat
intype (ApplicationMode -> OutputMode
getOutputMode ApplicationMode
mode) SoundChanges Expanded GraphemeList
statements String
ws of
        Left ParseErrorBundle String Void
e -> ParseErrorBundle String Void
-> ApplicationOutput PWord (Statement Expanded GraphemeList)
forall a r. ParseErrorBundle String Void -> ApplicationOutput a r
ParseError ParseErrorBundle String Void
e
        Right [Component PWord]
toks -> case ApplicationMode
mode of
            ApplicationMode
ReportRulesApplied ->
                [Log (Statement Expanded GraphemeList)]
-> ApplicationOutput PWord (Statement Expanded GraphemeList)
forall a r. [Log r] -> ApplicationOutput a r
AppliedRulesTable ([Log (Statement Expanded GraphemeList)]
 -> ApplicationOutput PWord (Statement Expanded GraphemeList))
-> [Log (Statement Expanded GraphemeList)]
-> ApplicationOutput PWord (Statement Expanded GraphemeList)
forall a b. (a -> b) -> a -> b
$ [[Log (Statement Expanded GraphemeList)]]
-> [Log (Statement Expanded GraphemeList)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Log (Statement Expanded GraphemeList)]]
 -> [Log (Statement Expanded GraphemeList)])
-> [[Log (Statement Expanded GraphemeList)]]
-> [Log (Statement Expanded GraphemeList)]
forall a b. (a -> b) -> a -> b
$
                    [Component [Log (Statement Expanded GraphemeList)]]
-> [[Log (Statement Expanded GraphemeList)]]
forall a. [Component a] -> [a]
getWords ([Component [Log (Statement Expanded GraphemeList)]]
 -> [[Log (Statement Expanded GraphemeList)]])
-> [Component [Log (Statement Expanded GraphemeList)]]
-> [[Log (Statement Expanded GraphemeList)]]
forall a b. (a -> b) -> a -> b
$ (PWord -> [Log (Statement Expanded GraphemeList)])
-> [Component PWord]
-> [Component [Log (Statement Expanded GraphemeList)]]
forall a b. (a -> b) -> [Component a] -> [Component b]
parFmap (SoundChanges Expanded GraphemeList
-> PWord -> [Log (Statement Expanded GraphemeList)]
applyChanges SoundChanges Expanded GraphemeList
statements) [Component PWord]
toks
            ApplyRules HighlightMode
DifferentToLastRun OutputMode
mdfout String
sep ->
                let result :: [Component PWord]
result = (Component [PWord] -> [Component PWord])
-> [Component [PWord]] -> [Component PWord]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Component [PWord] -> [Component PWord]
forall a. String -> Component [a] -> [Component a]
splitMultipleResults String
sep) ([Component [PWord]] -> [Component PWord])
-> [Component [PWord]] -> [Component PWord]
forall a b. (a -> b) -> a -> b
$
                        OutputMode
-> [Component [Component [PWord]]] -> [Component [PWord]]
forall {a}.
OutputMode -> [Component [Component a]] -> [Component a]
joinComponents' OutputMode
mdfout ([Component [Component [PWord]]] -> [Component [PWord]])
-> [Component [Component [PWord]]] -> [Component [PWord]]
forall a b. (a -> b) -> a -> b
$ (PWord -> [Component [PWord]])
-> [Component PWord] -> [Component [Component [PWord]]]
forall a b. (a -> b) -> [Component a] -> [Component b]
parFmap (OutputMode
-> SoundChanges Expanded GraphemeList
-> PWord
-> [Component [PWord]]
doApply OutputMode
mdfout SoundChanges Expanded GraphemeList
statements) [Component PWord]
toks
                in [Component (PWord, Bool)]
-> ApplicationOutput PWord (Statement Expanded GraphemeList)
forall a r. [Component (a, Bool)] -> ApplicationOutput a r
HighlightedWords ([Component (PWord, Bool)]
 -> ApplicationOutput PWord (Statement Expanded GraphemeList))
-> [Component (PWord, Bool)]
-> ApplicationOutput PWord (Statement Expanded GraphemeList)
forall a b. (a -> b) -> a -> b
$
                    (PolyDiff (Component PWord) (Component PWord)
 -> Maybe (Component (PWord, Bool)))
-> [PolyDiff (Component PWord) (Component PWord)]
-> [Component (PWord, Bool)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PolyDiff (Component PWord) (Component PWord)
-> Maybe (Component (PWord, Bool))
forall a.
PolyDiff (Component a) (Component a) -> Maybe (Component (a, Bool))
polyDiffToHighlight ([PolyDiff (Component PWord) (Component PWord)]
 -> [Component (PWord, Bool)])
-> [PolyDiff (Component PWord) (Component PWord)]
-> [Component (PWord, Bool)]
forall a b. (a -> b) -> a -> b
$ [Component PWord]
-> [Component PWord]
-> [PolyDiff (Component PWord) (Component PWord)]
forall a. Eq a => [a] -> [a] -> [Diff a]
getDiff ([Component PWord] -> Maybe [Component PWord] -> [Component PWord]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Component PWord]
prev) [Component PWord]
result
                    -- zipWithComponents result (fromMaybe [] prev) [] $ \thisWord prevWord ->

                    --     (thisWord, thisWord /= prevWord)

            ApplyRules HighlightMode
DifferentToInput OutputMode
mdfout String
sep ->
                [Component (PWord, Bool)]
-> ApplicationOutput PWord (Statement Expanded GraphemeList)
forall a r. [Component (a, Bool)] -> ApplicationOutput a r
HighlightedWords ([Component (PWord, Bool)]
 -> ApplicationOutput PWord (Statement Expanded GraphemeList))
-> [Component (PWord, Bool)]
-> ApplicationOutput PWord (Statement Expanded GraphemeList)
forall a b. (a -> b) -> a -> b
$ (Component [(PWord, Bool)] -> [Component (PWord, Bool)])
-> [Component [(PWord, Bool)]] -> [Component (PWord, Bool)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Component [(PWord, Bool)] -> [Component (PWord, Bool)]
forall a. String -> Component [a] -> [Component a]
splitMultipleResults String
sep) ([Component [(PWord, Bool)]] -> [Component (PWord, Bool)])
-> [Component [(PWord, Bool)]] -> [Component (PWord, Bool)]
forall a b. (a -> b) -> a -> b
$
                        OutputMode
-> [Component [Component [(PWord, Bool)]]]
-> [Component [(PWord, Bool)]]
forall {a}.
OutputMode -> [Component [Component a]] -> [Component a]
joinComponents' OutputMode
mdfout ([Component [Component [(PWord, Bool)]]]
 -> [Component [(PWord, Bool)]])
-> [Component [Component [(PWord, Bool)]]]
-> [Component [(PWord, Bool)]]
forall a b. (a -> b) -> a -> b
$ (PWord -> [Component [(PWord, Bool)]])
-> [Component PWord] -> [Component [Component [(PWord, Bool)]]]
forall a b. (a -> b) -> [Component a] -> [Component b]
parFmap (OutputMode
-> SoundChanges Expanded GraphemeList
-> PWord
-> [Component [(PWord, Bool)]]
doApplyWithChanges OutputMode
mdfout SoundChanges Expanded GraphemeList
statements) [Component PWord]
toks
            ApplyRules HighlightMode
NoHighlight OutputMode
mdfout String
sep ->
                [Component (PWord, Bool)]
-> ApplicationOutput PWord (Statement Expanded GraphemeList)
forall a r. [Component (a, Bool)] -> ApplicationOutput a r
HighlightedWords ([Component (PWord, Bool)]
 -> ApplicationOutput PWord (Statement Expanded GraphemeList))
-> [Component (PWord, Bool)]
-> ApplicationOutput PWord (Statement Expanded GraphemeList)
forall a b. (a -> b) -> a -> b
$ ((Component PWord -> Component (PWord, Bool))
-> [Component PWord] -> [Component (PWord, Bool)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Component PWord -> Component (PWord, Bool))
 -> [Component PWord] -> [Component (PWord, Bool)])
-> ((PWord -> (PWord, Bool))
    -> Component PWord -> Component (PWord, Bool))
-> (PWord -> (PWord, Bool))
-> [Component PWord]
-> [Component (PWord, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PWord -> (PWord, Bool))
-> Component PWord -> Component (PWord, Bool)
forall a b. (a -> b) -> Component a -> Component b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (,Bool
False) ([Component PWord] -> [Component (PWord, Bool)])
-> [Component PWord] -> [Component (PWord, Bool)]
forall a b. (a -> b) -> a -> b
$ (Component [PWord] -> [Component PWord])
-> [Component [PWord]] -> [Component PWord]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Component [PWord] -> [Component PWord]
forall a. String -> Component [a] -> [Component a]
splitMultipleResults String
sep) ([Component [PWord]] -> [Component PWord])
-> [Component [PWord]] -> [Component PWord]
forall a b. (a -> b) -> a -> b
$
                    OutputMode
-> [Component [Component [PWord]]] -> [Component [PWord]]
forall {a}.
OutputMode -> [Component [Component a]] -> [Component a]
joinComponents' OutputMode
mdfout ([Component [Component [PWord]]] -> [Component [PWord]])
-> [Component [Component [PWord]]] -> [Component [PWord]]
forall a b. (a -> b) -> a -> b
$ (PWord -> [Component [PWord]])
-> [Component PWord] -> [Component [Component [PWord]]]
forall a b. (a -> b) -> [Component a] -> [Component b]
parFmap (OutputMode
-> SoundChanges Expanded GraphemeList
-> PWord
-> [Component [PWord]]
doApply OutputMode
mdfout SoundChanges Expanded GraphemeList
statements) [Component PWord]
toks
  where
    -- highlight words in 'Second' but not 'First'

    polyDiffToHighlight :: PolyDiff (Component a) (Component a) -> Maybe (Component (a, Bool))
    polyDiffToHighlight :: forall a.
PolyDiff (Component a) (Component a) -> Maybe (Component (a, Bool))
polyDiffToHighlight (First Component a
_) = Maybe (Component (a, Bool))
forall a. Maybe a
Nothing
    polyDiffToHighlight (Second (Word a
a)) = Component (a, Bool) -> Maybe (Component (a, Bool))
forall a. a -> Maybe a
Just (Component (a, Bool) -> Maybe (Component (a, Bool)))
-> Component (a, Bool) -> Maybe (Component (a, Bool))
forall a b. (a -> b) -> a -> b
$ (a, Bool) -> Component (a, Bool)
forall a. a -> Component a
Word (a
a, Bool
True)
    polyDiffToHighlight (Second Component a
c) = Component (a, Bool) -> Maybe (Component (a, Bool))
forall a. a -> Maybe a
Just (Component (a, Bool) -> Maybe (Component (a, Bool)))
-> Component (a, Bool) -> Maybe (Component (a, Bool))
forall a b. (a -> b) -> a -> b
$ Component a -> Component (a, Bool)
forall a b. Component a -> Component b
unsafeCastComponent Component a
c
    polyDiffToHighlight (Both Component a
_ (Word a
a)) = Component (a, Bool) -> Maybe (Component (a, Bool))
forall a. a -> Maybe a
Just (Component (a, Bool) -> Maybe (Component (a, Bool)))
-> Component (a, Bool) -> Maybe (Component (a, Bool))
forall a b. (a -> b) -> a -> b
$ (a, Bool) -> Component (a, Bool)
forall a. a -> Component a
Word (a
a, Bool
False)
    polyDiffToHighlight (Both Component a
_ Component a
c) = Component (a, Bool) -> Maybe (Component (a, Bool))
forall a. a -> Maybe a
Just (Component (a, Bool) -> Maybe (Component (a, Bool)))
-> Component (a, Bool) -> Maybe (Component (a, Bool))
forall a b. (a -> b) -> a -> b
$ Component a -> Component (a, Bool)
forall a b. Component a -> Component b
unsafeCastComponent Component a
c

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

    doApply :: OutputMode -> SoundChanges Expanded GraphemeList -> PWord -> [Component [PWord]]
    doApply :: OutputMode
-> SoundChanges Expanded GraphemeList
-> PWord
-> [Component [PWord]]
doApply OutputMode
WordsWithProtoOutput SoundChanges Expanded GraphemeList
scs PWord
w = SoundChanges Expanded GraphemeList -> PWord -> [Component [PWord]]
doApplyWithProto SoundChanges Expanded GraphemeList
scs PWord
w
    doApply OutputMode
WordsWithProtoOutputPreserve SoundChanges Expanded GraphemeList
scs PWord
w = SoundChanges Expanded GraphemeList -> PWord -> [Component [PWord]]
doApplyWithProto SoundChanges Expanded GraphemeList
scs PWord
w
    doApply OutputMode
_ SoundChanges Expanded GraphemeList
scs PWord
w = [[PWord] -> Component [PWord]
forall a. a -> Component a
Word ([PWord] -> Component [PWord]) -> [PWord] -> Component [PWord]
forall a b. (a -> b) -> a -> b
$ (Log (Statement Expanded GraphemeList) -> Maybe PWord)
-> [Log (Statement Expanded GraphemeList)] -> [PWord]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Log (Statement Expanded GraphemeList) -> Maybe PWord
forall r. Log r -> Maybe PWord
getOutput ([Log (Statement Expanded GraphemeList)] -> [PWord])
-> [Log (Statement Expanded GraphemeList)] -> [PWord]
forall a b. (a -> b) -> a -> b
$ SoundChanges Expanded GraphemeList
-> PWord -> [Log (Statement Expanded GraphemeList)]
applyChanges SoundChanges Expanded GraphemeList
scs PWord
w]

    doApplyWithProto :: SoundChanges Expanded GraphemeList -> PWord -> [Component [PWord]]
doApplyWithProto SoundChanges Expanded GraphemeList
scs PWord
w =
        let intermediates :: [[PWord]]
            intermediates :: [[PWord]]
intermediates = ([PWord] -> [PWord]) -> [[PWord]] -> [[PWord]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PWord] -> [PWord]
forall a. Ord a => [a] -> [a]
nubOrd ([[PWord]] -> [[PWord]]) -> [[PWord]] -> [[PWord]]
forall a b. (a -> b) -> a -> b
$ [[PWord]] -> [[PWord]]
forall a. [[a]] -> [[a]]
transpose ([[PWord]] -> [[PWord]]) -> [[PWord]] -> [[PWord]]
forall a b. (a -> b) -> a -> b
$ Log (Statement Expanded GraphemeList) -> [PWord]
forall r. Log r -> [PWord]
getReports (Log (Statement Expanded GraphemeList) -> [PWord])
-> [Log (Statement Expanded GraphemeList)] -> [[PWord]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SoundChanges Expanded GraphemeList
-> PWord -> [Log (Statement Expanded GraphemeList)]
applyChanges SoundChanges Expanded GraphemeList
scs PWord
w
        in Component [PWord] -> [Component [PWord]] -> [Component [PWord]]
forall a. a -> [a] -> [a]
intersperse (String -> Component [PWord]
forall a. String -> Component a
Separator String
" → ") (([PWord] -> Component [PWord]) -> [[PWord]] -> [Component [PWord]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PWord] -> Component [PWord]
forall a. a -> Component a
Word [[PWord]]
intermediates)

    doApplyWithChanges :: OutputMode -> SoundChanges Expanded GraphemeList -> PWord -> [Component [(PWord, Bool)]]
    doApplyWithChanges :: OutputMode
-> SoundChanges Expanded GraphemeList
-> PWord
-> [Component [(PWord, Bool)]]
doApplyWithChanges OutputMode
WordsWithProtoOutput SoundChanges Expanded GraphemeList
scs PWord
w = SoundChanges Expanded GraphemeList
-> PWord -> [Component [(PWord, Bool)]]
doApplyWithChangesWithProto SoundChanges Expanded GraphemeList
scs PWord
w
    doApplyWithChanges OutputMode
WordsWithProtoOutputPreserve SoundChanges Expanded GraphemeList
scs PWord
w = SoundChanges Expanded GraphemeList
-> PWord -> [Component [(PWord, Bool)]]
doApplyWithChangesWithProto SoundChanges Expanded GraphemeList
scs PWord
w
    doApplyWithChanges OutputMode
_ SoundChanges Expanded GraphemeList
scs PWord
w = [[(PWord, Bool)] -> Component [(PWord, Bool)]
forall a. a -> Component a
Word ([(PWord, Bool)] -> Component [(PWord, Bool)])
-> [(PWord, Bool)] -> Component [(PWord, Bool)]
forall a b. (a -> b) -> a -> b
$ (Log (Statement Expanded GraphemeList) -> Maybe (PWord, Bool))
-> [Log (Statement Expanded GraphemeList)] -> [(PWord, Bool)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Log (Statement Expanded GraphemeList) -> Maybe (PWord, Bool)
forall (c :: LexemeType -> *) d.
Log (Statement c d) -> Maybe (PWord, Bool)
getChangedOutputs ([Log (Statement Expanded GraphemeList)] -> [(PWord, Bool)])
-> [Log (Statement Expanded GraphemeList)] -> [(PWord, Bool)]
forall a b. (a -> b) -> a -> b
$ SoundChanges Expanded GraphemeList
-> PWord -> [Log (Statement Expanded GraphemeList)]
applyChanges SoundChanges Expanded GraphemeList
scs PWord
w]

    doApplyWithChangesWithProto :: SoundChanges Expanded GraphemeList
-> PWord -> [Component [(PWord, Bool)]]
doApplyWithChangesWithProto SoundChanges Expanded GraphemeList
scs PWord
w =
        let intermediates :: [[(PWord, Bool)]]
            intermediates :: [[(PWord, Bool)]]
intermediates = ([(PWord, Bool)] -> [(PWord, Bool)])
-> [[(PWord, Bool)]] -> [[(PWord, Bool)]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(PWord, Bool)] -> [(PWord, Bool)]
forall a. Ord a => [a] -> [a]
nubOrd ([[(PWord, Bool)]] -> [[(PWord, Bool)]])
-> [[(PWord, Bool)]] -> [[(PWord, Bool)]]
forall a b. (a -> b) -> a -> b
$ [[(PWord, Bool)]] -> [[(PWord, Bool)]]
forall a. [[a]] -> [[a]]
transpose ([[(PWord, Bool)]] -> [[(PWord, Bool)]])
-> [[(PWord, Bool)]] -> [[(PWord, Bool)]]
forall a b. (a -> b) -> a -> b
$ Log (Statement Expanded GraphemeList) -> [(PWord, Bool)]
forall (c :: LexemeType -> *) d.
Log (Statement c d) -> [(PWord, Bool)]
getChangedReports (Log (Statement Expanded GraphemeList) -> [(PWord, Bool)])
-> [Log (Statement Expanded GraphemeList)] -> [[(PWord, Bool)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SoundChanges Expanded GraphemeList
-> PWord -> [Log (Statement Expanded GraphemeList)]
applyChanges SoundChanges Expanded GraphemeList
scs PWord
w
        in Component [(PWord, Bool)]
-> [Component [(PWord, Bool)]] -> [Component [(PWord, Bool)]]
forall a. a -> [a] -> [a]
intersperse (String -> Component [(PWord, Bool)]
forall a. String -> Component a
Separator String
" → ") (([(PWord, Bool)] -> Component [(PWord, Bool)])
-> [[(PWord, Bool)]] -> [Component [(PWord, Bool)]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(PWord, Bool)] -> Component [(PWord, Bool)]
forall a. a -> Component a
Word [[(PWord, Bool)]]
intermediates)

    joinComponents' :: OutputMode -> [Component [Component a]] -> [Component a]
joinComponents' OutputMode
WordsWithProtoOutput =
        [Component [Component a]] -> [Component a]
forall a. [Component [Component a]] -> [Component a]
joinComponents ([Component [Component a]] -> [Component a])
-> ([Component [Component a]] -> [Component [Component a]])
-> [Component [Component a]]
-> [Component a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Component [Component a]
-> [Component [Component a]] -> [Component [Component a]]
forall a. a -> [a] -> [a]
intersperse (String -> Component [Component a]
forall a. String -> Component a
Separator String
"\n") ([Component [Component a]] -> [Component [Component a]])
-> ([Component [Component a]] -> [Component [Component a]])
-> [Component [Component a]]
-> [Component [Component a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Component [Component a] -> Bool)
-> [Component [Component a]] -> [Component [Component a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case Word [Component a]
_ -> Bool
True; Component [Component a]
_ -> Bool
False)
    joinComponents' OutputMode
WordsWithProtoOutputPreserve = [Component [Component a]] -> [Component a]
forall a. [Component [Component a]] -> [Component a]
joinComponents ([Component [Component a]] -> [Component a])
-> ([Component [Component a]] -> [Component [Component a]])
-> [Component [Component a]]
-> [Component a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Component [Component a]] -> [Component [Component a]]
forall a. [Component a] -> [Component a]
linespace
    joinComponents' OutputMode
_ = [Component [Component a]] -> [Component a]
forall a. [Component [Component a]] -> [Component a]
joinComponents

    -- Insert newlines as necessary to put each 'Word' on a separate line

    linespace :: [Component a] -> [Component a]
    linespace :: forall a. [Component a] -> [Component a]
linespace (Separator String
s:[Component a]
cs)
        | Char
'\n' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s = String -> Component a
forall a. String -> Component a
Separator String
s Component a -> [Component a] -> [Component a]
forall a. a -> [a] -> [a]
: [Component a] -> [Component a]
forall a. [Component a] -> [Component a]
linespace [Component a]
cs
        | Bool
otherwise = String -> Component a
forall a. String -> Component a
Separator (Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:String
s) Component a -> [Component a] -> [Component a]
forall a. a -> [a] -> [a]
: [Component a] -> [Component a]
forall a. [Component a] -> [Component a]
linespace [Component a]
cs
    linespace (Component a
c:cs :: [Component a]
cs@(Separator String
_:[Component a]
_)) = Component a
c Component a -> [Component a] -> [Component a]
forall a. a -> [a] -> [a]
: [Component a] -> [Component a]
forall a. [Component a] -> [Component a]
linespace [Component a]
cs
    linespace (Component a
c:[Component a]
cs) = Component a
c Component a -> [Component a] -> [Component a]
forall a. a -> [a] -> [a]
: String -> Component a
forall a. String -> Component a
Separator String
"\n" Component a -> [Component a] -> [Component a]
forall a. a -> [a] -> [a]
: [Component a] -> [Component a]
forall a. [Component a] -> [Component a]
linespace [Component a]
cs
    linespace [] = []