{-# LANGUAGE OverloadedStrings #-}

module Language.Lojban.Presentation
( displayCanonicalBridi
, displayStandardSimpleBridi
, displayVariantSimpleBridi
, displayReorderedStandardSimpleBridi
) where

import Language.Lojban.Core
import Control.Arrow ((***))
import Control.Exception (assert)
import Util (replace, stripRight, chooseItemUniformly)
import qualified Data.Text as T
import System.Random (StdGen, mkStdGen)

-- The following function keeps trailing empty places, if present
swapSimpleBridiArguments :: String -> SimpleBridi -> SimpleBridi
swapSimpleBridiArguments :: String -> SimpleBridi -> SimpleBridi
swapSimpleBridiArguments String
particle (SimpleBridi Bool
xu Text
selbri [Text]
sumti [Text]
extraSumti) = Bool -> Text -> [Text] -> [Text] -> SimpleBridi
SimpleBridi Bool
xu Text
selbri [Text]
sumti''' [Text]
extraSumti where
    sumti' :: [Text]
sumti' = [Text]
sumti [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate Int
5 (String -> Text
T.pack String
"///")
    sumti'' :: [Text]
sumti'' = String -> [Text] -> [Text]
swapArguments String
particle [Text]
sumti'
    sumti''' :: [Text]
sumti''' = Text -> Text -> [Text] -> [Text]
forall a. Eq a => a -> a -> [a] -> [a]
replace (String -> Text
T.pack String
"///") (String -> Text
T.pack String
"") ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
stripRight Text
"///" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
sumti''

swapArguments :: String -> [T.Text] -> [T.Text]
swapArguments :: String -> [Text] -> [Text]
swapArguments String
"se" (Text
a:Text
b:[Text]
cs) = (Text
bText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
aText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
cs)
swapArguments String
"te" (Text
a:Text
b:Text
c:[Text]
ds) = (Text
cText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
bText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
aText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ds)
swapArguments String
"ve" (Text
a:Text
b:Text
c:Text
d:[Text]
es) = (Text
dText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
bText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
cText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
aText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
es)
swapArguments String
"xe" (Text
a:Text
b:Text
c:Text
d:Text
e:[Text]
fs) = (Text
eText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
bText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
cText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
dText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
aText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
fs)

------------------------- ------------------------ Sentence displayers
-- TODO: use fa/fe/fi/fo/fu if convenient

prependXu :: Bool -> ([T.Text], StdGen) -> ([T.Text], StdGen)
prependXu :: Bool -> ([Text], StdGen) -> ([Text], StdGen)
prependXu Bool
True = (Text
"xu"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([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
prependXu Bool
False = ([Text], StdGen) -> ([Text], StdGen)
forall a. a -> a
id

buildSentenceDisplayer :: (StdGen -> SimpleBridi -> ([T.Text], StdGen)) -> SimpleBridiDisplayer
buildSentenceDisplayer :: (StdGen -> SimpleBridi -> ([Text], StdGen)) -> SimpleBridiDisplayer
buildSentenceDisplayer StdGen -> SimpleBridi -> ([Text], StdGen)
sentenceDisplayer StdGen
r0 SimpleBridi
simpleBridi = ([Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text] -> [Text]
forall a. Eq a => a -> a -> [a] -> [a]
replace Text
"" Text
"zo'e" [Text]
sentence, StdGen
r1) where
    ([Text]
sentence, StdGen
r1) = StdGen -> SimpleBridi -> ([Text], StdGen)
sentenceDisplayer StdGen
r0 SimpleBridi
simpleBridi

-- | Displays bridi in canonical form.
--
-- The main motivation for this function lies in determining bridi equivalence.
-- Essentially, two bridi are syntactically equivalent if and only if they yield the same representation after canonicalization.
displayCanonicalBridi :: SimpleBridi -> T.Text
displayCanonicalBridi :: SimpleBridi -> Text
displayCanonicalBridi = (Text, StdGen) -> Text
forall a b. (a, b) -> a
fst ((Text, StdGen) -> Text)
-> (SimpleBridi -> (Text, StdGen)) -> SimpleBridi -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleBridiDisplayer
displayStandardSimpleBridi (Int -> StdGen
mkStdGen Int
42)

-- | Displays bridi in standard form: [x1] selbri x2 x3 x4 x5 (...) xn.
--
-- * Ellisis occurs in the first place and in the last places.
-- * All other missing places are filled with "zo'e".
displayStandardSimpleBridi :: StdGen -> SimpleBridi -> (T.Text, StdGen)
displayStandardSimpleBridi :: SimpleBridiDisplayer
displayStandardSimpleBridi = (StdGen -> SimpleBridi -> ([Text], StdGen)) -> SimpleBridiDisplayer
buildSentenceDisplayer ((StdGen -> SimpleBridi -> ([Text], StdGen))
 -> SimpleBridiDisplayer)
-> (StdGen -> SimpleBridi -> ([Text], StdGen))
-> SimpleBridiDisplayer
forall a b. (a -> b) -> a -> b
$ \StdGen
r0 (SimpleBridi Bool
xu Text
selbri [Text]
sumti [Text]
extraSumti) ->
    let
        ([Text]
sumtiHead, [Text]
sumtiTail) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 (if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
sumti then [Text
""] else [Text]
sumti)
        sentence :: [Text]
sentence = (if [Text]
sumtiHead [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text
""] then [] else [Text]
sumtiHead) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
selbri] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
stripRight Text
"" [Text]
sumtiTail)
    in
        Bool -> ([Text], StdGen) -> ([Text], StdGen)
prependXu Bool
xu (([Text], StdGen) -> ([Text], StdGen))
-> ([Text], StdGen) -> ([Text], StdGen)
forall a b. (a -> b) -> a -> b
$
        ([Text]
extraSumti [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sentence, StdGen
r0)

-- | Displays bridi with a random number of places before the selbri.
--
-- * Special case: if the first place is empty, then this function falls back to 'displayStandardSimpleBridi'.
-- * Ellisis occurs in the last places.
-- * All other missing places are filled with "zo'e".
--
-- Possible outputs are:
--
-- * selbri x1 x2 x3 x4 x5 (...) xn;
-- * x1 selbri x2 x3 x4 x5 (...) xn;
-- * x1 x2 selbri x3 x4 x5 (...) xn; and so on.
displayVariantSimpleBridi :: StdGen -> SimpleBridi -> (T.Text, StdGen)
displayVariantSimpleBridi :: SimpleBridiDisplayer
displayVariantSimpleBridi = (StdGen -> SimpleBridi -> ([Text], StdGen)) -> SimpleBridiDisplayer
buildSentenceDisplayer ((StdGen -> SimpleBridi -> ([Text], StdGen))
 -> SimpleBridiDisplayer)
-> (StdGen -> SimpleBridi -> ([Text], StdGen))
-> SimpleBridiDisplayer
forall a b. (a -> b) -> a -> b
$ \StdGen
r0 (SimpleBridi Bool
xu Text
selbri [Text]
sumti [Text]
extraSumti) ->
    let
        ([Text]
sumtiHead, [Text]
sumtiTail) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 (if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
sumti then [Text
""] else [Text]
sumti)
    in
        Bool -> ([Text], StdGen) -> ([Text], StdGen)
prependXu Bool
xu (([Text], StdGen) -> ([Text], StdGen))
-> ([Text], StdGen) -> ([Text], StdGen)
forall a b. (a -> b) -> a -> b
$
        if [Text]
sumtiHead [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text
""] then
            (Text
selbri Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
stripRight Text
"" [Text]
sumtiTail), StdGen
r0)
        else
            let
                (Int
beforeCount, StdGen
r1) = StdGen -> [Int] -> (Int, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r0 [Int
1..[Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sumti]
                ([Text]
sumtiBefore, [Text]
sumtiAfter) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
beforeCount [Text]
sumti
            in
                ([Text]
extraSumti [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sumtiBefore [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
selbri] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sumtiAfter, StdGen
r1)

-- The bridi is displayed as in 'displayStandardSimpleBridi', but if the x1 is missing then its position is used to hold the last place
--   * Exception: if there are more than five sumti places, then "displayStandardSimpleBridi" is used after all
displayPossiblyReorderedStandardSimpleBridi :: StdGen -> SimpleBridi -> (T.Text, StdGen)
displayPossiblyReorderedStandardSimpleBridi :: SimpleBridiDisplayer
displayPossiblyReorderedStandardSimpleBridi StdGen
r0 SimpleBridi
bridi
    | [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sumti Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = SimpleBridiDisplayer
displayStandardSimpleBridi StdGen
r0 SimpleBridi
bridi
    | [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sumti Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
6 = SimpleBridiDisplayer
displayStandardSimpleBridi StdGen
r0 SimpleBridi
bridi
    | [Text] -> Text
forall a. (?callStack::CallStack) => [a] -> a
head [Text]
sumti Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""  = SimpleBridiDisplayer
displayPossiblyReorderedStandardSimpleBridi' StdGen
r0 SimpleBridi
bridi
    | Bool
otherwise         = SimpleBridiDisplayer
displayStandardSimpleBridi StdGen
r0 SimpleBridi
bridi
    where sumti :: [Text]
sumti = Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
stripRight Text
"" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ SimpleBridi -> [Text]
simpleBridiSumti SimpleBridi
bridi

displayPossiblyReorderedStandardSimpleBridi' :: StdGen -> SimpleBridi -> (T.Text, StdGen)
displayPossiblyReorderedStandardSimpleBridi' :: SimpleBridiDisplayer
displayPossiblyReorderedStandardSimpleBridi' = (StdGen -> SimpleBridi -> ([Text], StdGen)) -> SimpleBridiDisplayer
buildSentenceDisplayer ((StdGen -> SimpleBridi -> ([Text], StdGen))
 -> SimpleBridiDisplayer)
-> (StdGen -> SimpleBridi -> ([Text], StdGen))
-> SimpleBridiDisplayer
forall a b. (a -> b) -> a -> b
$ \StdGen
r0 (SimpleBridi Bool
xu Text
selbri [Text]
sumti [Text]
extraSumti) ->
    let
        particle :: String
particle = [String
"se", String
"te", String
"ve", String
"xe"] [String] -> Int -> String
forall a. (?callStack::CallStack) => [a] -> Int -> a
!! ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sumti Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
        sumti' :: [Text]
sumti' = Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
stripRight Text
"" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> [Text]
swapArguments String
particle [Text]
sumti
        sentence :: [Text]
sentence = [Text] -> Text
forall a. (?callStack::CallStack) => [a] -> a
head [Text]
sumti' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (String -> Text
T.pack String
particle) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
selbri Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ([Text] -> [Text]
forall a. (?callStack::CallStack) => [a] -> [a]
tail [Text]
sumti')
    in
        Bool -> ([Text], StdGen) -> ([Text], StdGen)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sumti Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sumti Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
5 Bool -> Bool -> Bool
&& [Text] -> Text
forall a. (?callStack::CallStack) => [a] -> a
head [Text]
sumti Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" Bool -> Bool -> Bool
&& [Text] -> Text
forall a. (?callStack::CallStack) => [a] -> a
last [Text]
sumti Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") (([Text], StdGen) -> ([Text], StdGen))
-> ([Text], StdGen) -> ([Text], StdGen)
forall a b. (a -> b) -> a -> b
$
        Bool -> ([Text], StdGen) -> ([Text], StdGen)
prependXu Bool
xu (([Text], StdGen) -> ([Text], StdGen))
-> ([Text], StdGen) -> ([Text], StdGen)
forall a b. (a -> b) -> a -> b
$
        ([Text]
extraSumti [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sentence, StdGen
r0)

-- The bridi is displayed with a single place swap
--   * Exception: if the first place is empty or there are fewer than two places, then this function behaves as 'displayStandardSimpleBridi'
displayReorderedStandardSimpleBridi :: StdGen -> SimpleBridi -> (T.Text, StdGen)
displayReorderedStandardSimpleBridi :: SimpleBridiDisplayer
displayReorderedStandardSimpleBridi StdGen
r0 SimpleBridi
bridi
    | [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sumti Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = SimpleBridiDisplayer
displayStandardSimpleBridi StdGen
r0 SimpleBridi
bridi
    | [Text] -> Text
forall a. (?callStack::CallStack) => [a] -> a
head [Text]
sumti Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""  = SimpleBridiDisplayer
displayPossiblyReorderedStandardSimpleBridi StdGen
r0 SimpleBridi
bridi
    | Bool
otherwise         = SimpleBridiDisplayer
displayReorderedStandardSimpleBridi' StdGen
r0 SimpleBridi
bridi
    where sumti :: [Text]
sumti = Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
stripRight Text
"" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ SimpleBridi -> [Text]
simpleBridiSumti SimpleBridi
bridi

displayReorderedStandardSimpleBridi' :: StdGen -> SimpleBridi -> (T.Text, StdGen)
displayReorderedStandardSimpleBridi' :: SimpleBridiDisplayer
displayReorderedStandardSimpleBridi' = (StdGen -> SimpleBridi -> ([Text], StdGen)) -> SimpleBridiDisplayer
buildSentenceDisplayer ((StdGen -> SimpleBridi -> ([Text], StdGen))
 -> SimpleBridiDisplayer)
-> (StdGen -> SimpleBridi -> ([Text], StdGen))
-> SimpleBridiDisplayer
forall a b. (a -> b) -> a -> b
$ \StdGen
r0 (SimpleBridi Bool
xu Text
selbri [Text]
sumti [Text]
extraSumti) ->
    let
        particles :: [String]
particles = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sumti Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [String
"se", String
"te", String
"ve", String
"xe"]
        (String
particle, StdGen
r1) = StdGen -> [String] -> (String, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r0 [String]
particles
        sumti' :: [Text]
sumti' = String -> [Text] -> [Text]
swapArguments String
particle [Text]
sumti
        sentence :: [Text]
sentence = [Text] -> Text
forall a. (?callStack::CallStack) => [a] -> a
head [Text]
sumti' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (String -> Text
T.pack String
particle) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
selbri Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
forall a. (?callStack::CallStack) => [a] -> [a]
tail [Text]
sumti'
    in
        Bool -> ([Text], StdGen) -> ([Text], StdGen)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sumti Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& [Text] -> Text
forall a. (?callStack::CallStack) => [a] -> a
head [Text]
sumti Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" Bool -> Bool -> Bool
&& [Text] -> Text
forall a. (?callStack::CallStack) => [a] -> a
last [Text]
sumti Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") (([Text], StdGen) -> ([Text], StdGen))
-> ([Text], StdGen) -> ([Text], StdGen)
forall a b. (a -> b) -> a -> b
$
        Bool -> ([Text], StdGen) -> ([Text], StdGen)
prependXu Bool
xu (([Text], StdGen) -> ([Text], StdGen))
-> ([Text], StdGen) -> ([Text], StdGen)
forall a b. (a -> b) -> a -> b
$
        ([Text]
extraSumti [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sentence, StdGen
r1)