{-# LANGUAGE OverloadedStrings #-}
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
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)
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
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
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
"|"
expandTranslation :: Translation -> Translation
expandTranslation :: Translation -> Translation
expandTranslation ([Text]
lojban_sentences, [Text]
english_sentences) = ([Text] -> [Text]
expandSentences [Text]
lojban_sentences, [Text]
english_sentences)
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
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)
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
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)