{-# LANGUAGE OverloadedStrings #-}

module Language.Lojban.Refinement
( simplifyTerminatorsInSentence
, simplifyTerminatorsInBridiDisplayer
) where

import Language.Lojban.Core
import Language.Lojban.Canonicalization (basicSentenceCanonicalizer)
import Control.Arrow ((***))
import System.Random (StdGen)
import Util (compose2)
import qualified Data.Text as T

-- * Terminator simplification
-- | Simplifies sentences by replacing terminators with "cu" whenever possible.
--
-- Example: "lo mlatu ku pinxe lo ladru ku" -> "lo mlatu cu pinxe lo ladru ku".
replaceElidableTerminatorsInSentence :: T.Text -> T.Text
replaceElidableTerminatorsInSentence :: Text -> Text
replaceElidableTerminatorsInSentence Text
t = [Text] -> [Text] -> Text
f [] (Text -> [Text]
T.words Text
t) where
    originalCanonicalization :: Either String Text
originalCanonicalization = SentenceCanonicalizer
basicSentenceCanonicalizer Text
t
    f :: [T.Text] -> [T.Text] -> T.Text
    f :: [Text] -> [Text] -> Text
f [Text]
x [] = [Text] -> Text
T.unwords [Text]
x
    f [Text]
x (Text
y:[Text]
ys) = if SentenceCanonicalizer
basicSentenceCanonicalizer ([Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
x[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++(Text
"cu"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ys)) Either String Text -> Either String Text -> Bool
forall a. Eq a => a -> a -> Bool
== Either String Text
originalCanonicalization then [Text] -> [Text] -> Text
f ([Text]
x[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Text
"cu"]) [Text]
ys else [Text] -> [Text] -> Text
f ([Text]
x[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Text
y]) [Text]
ys

-- | Simplifies sentences by removing redundant elidable terminators ("ku", "kei", etc.).
--
-- Example: "lo mlatu ku pinxe lo ladru ku" -> "lo mlatu ku pinxe lo ladru".
removeElidableTerminatorsInSentence :: T.Text -> T.Text
removeElidableTerminatorsInSentence :: Text -> Text
removeElidableTerminatorsInSentence Text
t = [Text] -> [Text] -> Text
f [] (Text -> [Text]
T.words Text
t) where
    originalCanonicalization :: Either String Text
originalCanonicalization = SentenceCanonicalizer
basicSentenceCanonicalizer Text
t
    f :: [T.Text] -> [T.Text] -> T.Text
    f :: [Text] -> [Text] -> Text
f [Text]
x [] = [Text] -> Text
T.unwords [Text]
x
    f [Text]
x (Text
y:[Text]
ys) = if SentenceCanonicalizer
basicSentenceCanonicalizer ([Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
x[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Text]
ys) Either String Text -> Either String Text -> Bool
forall a. Eq a => a -> a -> Bool
== Either String Text
originalCanonicalization then [Text] -> [Text] -> Text
f [Text]
x [Text]
ys else [Text] -> [Text] -> Text
f ([Text]
x[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Text
y]) [Text]
ys

-- | Simplifies sentences by removing elidable terminators and/or replacing them with "cu".
--
-- Example: "lo mlatu ku pinxe lo ladru ku" -> "lo mlatu cu pinxe lo ladru".
simplifyTerminatorsInSentence :: T.Text -> T.Text
simplifyTerminatorsInSentence :: Text -> Text
simplifyTerminatorsInSentence = Text -> Text
removeElidableTerminatorsInSentence (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
replaceElidableTerminatorsInSentence

-- | Decorates the displayer so that the resulting bridi is simplified using 'simplifyTerminatorsInSentence'.
simplifyTerminatorsInBridiDisplayer :: SimpleBridiDisplayer -> SimpleBridiDisplayer
simplifyTerminatorsInBridiDisplayer :: SimpleBridiDisplayer -> SimpleBridiDisplayer
simplifyTerminatorsInBridiDisplayer SimpleBridiDisplayer
bridiDisplayer = (Text, StdGen) -> (Text, StdGen)
simplifySentence ((Text, StdGen) -> (Text, StdGen))
-> SimpleBridiDisplayer -> SimpleBridiDisplayer
forall t1 t2 t3 t4.
(t1 -> t2) -> (t3 -> t4 -> t1) -> t3 -> t4 -> t2
`compose2` SimpleBridiDisplayer
bridiDisplayer where
    simplifySentence :: (T.Text, StdGen) -> (T.Text, StdGen)
    simplifySentence :: (Text, StdGen) -> (Text, StdGen)
simplifySentence = Text -> Text
simplifyTerminatorsInSentence (Text -> Text)
-> (StdGen -> StdGen) -> (Text, StdGen) -> (Text, StdGen)
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')
*** StdGen -> StdGen
forall a. a -> a
id