{-# LANGUAGE OverloadedStrings #-}

-- | This module provides utilities for manipulating translations.
module Study.Framework.Lojban.TranslationUtils
( simplifyTerminatorsInTranslation
, simplifyTerminatorsInTranslationGenerator
, expandSentence
, expandSentences
, expandTranslation
, expandTranslationGenerator
, narrowTranslation
, narrowTranslationGenerator
, narrowTranslationGeneratorByExpression
) where

import Core
import Language.Lojban.Refinement (simplifyTerminatorsInSentence)
import Control.Monad (join)
import Control.Arrow ((***), second)
import qualified Data.Text as T

-- | Simplifies a 'Translation' by removing elidable terminators and/or replacing them with "cu" (see 'simplifyTerminatorsInSentence').
simplifyTerminatorsInTranslation :: Translation -> Translation
simplifyTerminatorsInTranslation :: Translation -> Translation
simplifyTerminatorsInTranslation ([Text]
lojbanSentences, [Text]
englishSentences) = ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
simplifyTerminatorsInSentence [Text]
lojbanSentences, [Text]
englishSentences)

-- | Simplifies a 'TranslationGenerator' by removing elidable terminators and/or replacing them with "cu" (see 'simplifyTerminatorsInSentence').
simplifyTerminatorsInTranslationGenerator :: TranslationGenerator -> TranslationGenerator
simplifyTerminatorsInTranslationGenerator :: TranslationGenerator -> TranslationGenerator
simplifyTerminatorsInTranslationGenerator TranslationGenerator
translationGenerator StdGen
r0 = (Translation -> Translation
simplifyTerminatorsInTranslation Translation
translation, StdGen
r1) where
    (Translation
translation, StdGen
r1) = TranslationGenerator
translationGenerator StdGen
r0

-- | Expands a list of sentences into a potentially larger list using syntax such as (x|y|z) or {x|y|z} (see 'expandSentence').
expandSentences :: [T.Text] -> [T.Text]
expandSentences :: [Text] -> [Text]
expandSentences = [[Text]] -> [Text]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Text]] -> [Text]) -> ([Text] -> [[Text]]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Text]
expandSentence

-- | Expands a sentence into multiple sentences using syntax such as (x|y|z) or {x|y|z}.
--
-- Examples:
--
-- * "lo mlatu poi {ke'a} pinxe cu melbi" -> ["lo mlatu poi pinxe cu melbi", "lo mlatu poi ke'a pinxe cu melbi"]
-- * "lo ctuca (be|pe) mi" -> ["lo ctuca be mi", "lo ctuca pe mi"]
expandSentence :: T.Text -> [T.Text]
expandSentence :: Text -> [Text]
expandSentence Text
sentence = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Text
T.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words) (Text -> [Text]
expandSentence' Text
sentence) where
    expandSentence' :: T.Text -> [T.Text]
    expandSentence' :: Text -> [Text]
expandSentence' Text
sentence
        | (Text -> Bool
T.null Text
sentence) =
            [ Text
"" ]
        | (HasCallStack => Text -> Char
Text -> Char
T.head Text
sentence) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' = do
            let (Text
expression, Text
sentence') = ((Int -> Text -> Text
T.drop Int
1) (Text -> Text) -> (Text -> Text) -> (Text, Text) -> (Text, Text)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Int -> Text -> Text
T.drop Int
1)) ((Text, Text) -> (Text, Text)) -> (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
")" Text
sentence
            Text
expandedExpression <- Text -> [Text]
expandExpression Text
expression
            Text
expandedSentence' <- Text -> [Text]
expandSentence' Text
sentence'
            Text -> [Text]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
expandedExpression Text -> Text -> Text
`T.append` Text
expandedSentence'
        | (HasCallStack => Text -> Char
Text -> Char
T.head Text
sentence) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{' = do
            let (Text
expression, Text
sentence') = ((Int -> Text -> Text
T.drop Int
1) (Text -> Text) -> (Text -> Text) -> (Text, Text) -> (Text, Text)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Int -> Text -> Text
T.drop Int
1)) ((Text, Text) -> (Text, Text)) -> (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"}" Text
sentence
            Text
expandedExpression <- Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> [Text]
expandExpression Text
expression)
            Text
expandedSentence' <- Text -> [Text]
expandSentence' Text
sentence'
            Text -> [Text]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
expandedExpression Text -> Text -> Text
`T.append` Text
expandedSentence'
        | Bool
otherwise = do
            let (Text
expression, Text
sentence') = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'(', Char
'{']) Text
sentence
            Text
expandedSentence' <- Text -> [Text]
expandSentence' Text
sentence'
            Text -> [Text]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
expression Text -> Text -> Text
`T.append` Text
expandedSentence'
    expandExpression :: T.Text -> [T.Text]
    expandExpression :: Text -> [Text]
expandExpression = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"|"

-- | Expands the Lojban sentences in a 'Translation' using syntax such as (x|y|z) or {x|y|z} (see 'expandSentence').
expandTranslation :: Translation -> Translation
expandTranslation :: Translation -> Translation
expandTranslation ([Text]
lojban_sentences, [Text]
english_sentences) = ([Text] -> [Text]
expandSentences [Text]
lojban_sentences, [Text]
english_sentences)

-- | Expands the Lojban sentences in a 'TranslationGenerator' using syntax such as (x|y|z) or {x|y|z} (see 'expandSentence').
expandTranslationGenerator :: TranslationGenerator -> TranslationGenerator
expandTranslationGenerator :: TranslationGenerator -> TranslationGenerator
expandTranslationGenerator TranslationGenerator
translationGenerator StdGen
r0 = (Translation -> Translation
expandTranslation Translation
translation, StdGen
r1) where
    (Translation
translation, StdGen
r1) = TranslationGenerator
translationGenerator StdGen
r0

-- | Returns a 'Translation' containing only the first (i.e., canonical) Lojban sentence.
--
-- This function discards all Lojban sentences except for the first one.
-- Useful if you have a 'Translation' that you would like to display to the user, but some of its
-- sentences in Lojban use grammatical constructs that have not yet been taught (perhaps you added them
-- to ensure that translations made by more advanced users are still accepted by the validator).
-- By convention, the first translation is always expected to be suitable for presentation to the user.
narrowTranslation :: Translation -> Translation
narrowTranslation :: Translation -> Translation
narrowTranslation ([Text]
lojban_sentences, [Text]
english_sentences) = ([[Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
lojban_sentences], [Text]
english_sentences)

-- | Decorates a TranslationGenerator so that the resulting translation contains only the first (canonical) Lojban sentence (see 'narrowTranslation').
narrowTranslationGenerator :: TranslationGenerator -> TranslationGenerator
narrowTranslationGenerator :: TranslationGenerator -> TranslationGenerator
narrowTranslationGenerator TranslationGenerator
translationGenerator = TranslationGenerator
translationGenerator' where
    translationGenerator' :: TranslationGenerator
    translationGenerator' :: TranslationGenerator
translationGenerator' StdGen
r0 = (Translation -> Translation
narrowTranslation Translation
originalTranslation, StdGen
r1) where
        (Translation
originalTranslation, StdGen
r1) = TranslationGenerator
translationGenerator StdGen
r0

-- | Decorates a TranslationGeneratorByExpression so that the resulting translation contains only the first (canonical) Lojban sentence (see 'narrowTranslation').
narrowTranslationGeneratorByExpression :: TranslationGeneratorByExpression -> TranslationGeneratorByExpression
narrowTranslationGeneratorByExpression :: TranslationGeneratorByExpression
-> TranslationGeneratorByExpression
narrowTranslationGeneratorByExpression = ((Text, TranslationGenerator) -> (Text, TranslationGenerator))
-> TranslationGeneratorByExpression
-> TranslationGeneratorByExpression
forall a b. (a -> b) -> [a] -> [b]
map ((TranslationGenerator -> TranslationGenerator)
-> (Text, TranslationGenerator) -> (Text, TranslationGenerator)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second TranslationGenerator -> TranslationGenerator
narrowTranslationGenerator)