{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}

module Language.Lojban.Canonicalization.Internals
( StructuredSelbri
, StructuredTerm
, ExtraTerm
, StructuredBridi
, normalizeText
, canonicalizeText
, canonicalizeParsedText
, canonicalizeParsedBridi
, canonicalizeParsedTerm
, retrieveSimpleBridi
, extractSimpleBridi
, retrieveStructuredBridi
) where

import Language.Lojban.Core
import Language.Lojban.Parsing (parseText)
import Language.Lojban.Presentation (displayCanonicalBridi)
import Language.Lojban.Dictionaries (englishDictionary)
import Util (headOrDefault, isContiguousSequence, concatET, unwordsET)
import Control.Applicative (liftA2)
import Control.Exception (assert)
import Control.Monad (mplus)
import Data.List (partition, intersperse)
import qualified Data.Text as T
import qualified Data.Map as M
import qualified Language.Lojban.Parser.ZasniGerna as ZG

------------------------- ----------------------- Sentence canonicalizers
--TODO: check whether se/te/ve/xe are left-associative or right-associative
--ZasniGerna documentation: https://hackage.haskell.org/package/zasni-gerna-0.0.7/docs/Language-Lojban-Parser-ZasniGerna.html

---------- Types
type StructuredSelbri = ZG.Text
type StructuredTerm = ZG.Text
type ExtraTerm = ZG.Text
type StructuredBridi = (StructuredSelbri, [(Int, StructuredTerm)], [ExtraTerm])

---------- Handle place tags (fa/fe/fi/fo/fu)
handlePlaceTags :: StructuredBridi -> Either String StructuredBridi
handlePlaceTags :: StructuredBridi -> Either String StructuredBridi
handlePlaceTags (StructuredSelbri
selbri, [], [StructuredSelbri]
extraTerms) = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ (StructuredSelbri
selbri, [], [StructuredSelbri]
extraTerms)
handlePlaceTags (StructuredSelbri
selbri, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms) = Bool
-> Either String StructuredBridi -> Either String StructuredBridi
forall a. HasCallStack => Bool -> a -> a
assert ([Int] -> Bool
forall a. Integral a => [a] -> Bool
isContiguousSequence ([Int] -> Bool) -> [Int] -> Bool
forall a b. (a -> b) -> a -> b
$ ((Int, StructuredSelbri) -> Int)
-> [(Int, StructuredSelbri)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, StructuredSelbri) -> Int
forall a b. (a, b) -> a
fst [(Int, StructuredSelbri)]
terms) (Either String StructuredBridi -> Either String StructuredBridi)
-> Either String StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredSelbri
selbri, Int -> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
f Int
firstPosition [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms) where
    firstPosition :: Int
firstPosition = (Int, StructuredSelbri) -> Int
forall a b. (a, b) -> a
fst ((Int, StructuredSelbri) -> Int) -> (Int, StructuredSelbri) -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, StructuredSelbri)] -> (Int, StructuredSelbri)
forall a. HasCallStack => [a] -> a
head [(Int, StructuredSelbri)]
terms
    f :: Int -> [(Int, StructuredTerm)] -> [(Int, StructuredTerm)]
    f :: Int -> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
f Int
_ [] = []
    f Int
defaultPosition ((Int, StructuredSelbri)
h:[(Int, StructuredSelbri)]
t) = let (Maybe String
tag, StructuredSelbri
term) = StructuredSelbri -> (Maybe String, StructuredSelbri)
retrieveTag ((Int, StructuredSelbri) -> StructuredSelbri
forall a b. (a, b) -> b
snd (Int, StructuredSelbri)
h)
                                  position :: Int
position = case Maybe String
tag of Just String
x -> String -> Int
retrievePosition String
x; Maybe String
Nothing -> Int
defaultPosition
                              in (Int
position, StructuredSelbri
term) (Int, StructuredSelbri)
-> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
forall a. a -> [a] -> [a]
: Int -> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
f (Int
positionInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Int, StructuredSelbri)]
t
    retrievePosition :: String -> Int
    retrievePosition :: String -> Int
retrievePosition String
"fa" = Int
1
    retrievePosition String
"fe" = Int
2
    retrievePosition String
"fi" = Int
3
    retrievePosition String
"fo" = Int
4
    retrievePosition String
"fu" = Int
5
    retrieveTag :: ZG.Text -> (Maybe String, ZG.Text)
    retrieveTag :: StructuredSelbri -> (Maybe String, StructuredSelbri)
retrieveTag (ZG.Tag (ZG.FA String
x) StructuredSelbri
y) = (String -> Maybe String
forall a. a -> Maybe a
Just String
x, StructuredSelbri
y)
    retrieveTag StructuredSelbri
x = (Maybe String
forall a. Maybe a
Nothing, StructuredSelbri
x)

---------- Handle place permutations (se/te/ve/xe)
swapTerms :: Int -> Int -> [(Int, StructuredTerm)] -> [(Int, StructuredTerm)]
swapTerms :: Int
-> Int -> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
swapTerms Int
x Int
y [(Int, StructuredSelbri)]
terms = Bool -> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
forall a. HasCallStack => Bool -> a -> a
assert (Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
y) ([(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)])
-> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
forall a b. (a -> b) -> a -> b
$ ((Int, StructuredSelbri) -> (Int, StructuredSelbri))
-> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, StructuredSelbri) -> (Int, StructuredSelbri)
forall {b}. (Int, b) -> (Int, b)
f [(Int, StructuredSelbri)]
terms where
    f :: (Int, b) -> (Int, b)
f (Int
k, b
t) = (if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x then Int
y else if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y then Int
x else Int
k, b
t)
swapTerms2 :: String -> [(Int, StructuredTerm)] -> [(Int, StructuredTerm)]
swapTerms2 :: String -> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
swapTerms2 String
"se" = Int
-> Int -> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
swapTerms Int
1 Int
2
swapTerms2 String
"te" = Int
-> Int -> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
swapTerms Int
1 Int
3
swapTerms2 String
"ve" = Int
-> Int -> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
swapTerms Int
1 Int
4
swapTerms2 String
"xe" = Int
-> Int -> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
swapTerms Int
1 Int
5

handlePlacePermutations :: StructuredBridi -> Either String StructuredBridi
handlePlacePermutations :: StructuredBridi -> Either String StructuredBridi
handlePlacePermutations (ZG.Tanru [StructuredSelbri]
brivlaList, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms) = (, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms) (StructuredSelbri -> StructuredBridi)
-> (String -> StructuredSelbri) -> String -> StructuredBridi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> StructuredSelbri
ZG.BRIVLA (String -> StructuredBridi)
-> (Text -> String) -> Text -> StructuredBridi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> String
T.unpack (Text -> StructuredBridi)
-> Either String Text -> Either String StructuredBridi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StructuredSelbri] -> Either String Text
retrieveTanruFromBrivlaList [StructuredSelbri]
brivlaList
handlePlacePermutations (ZG.BRIVLA String
brivla, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms) = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ (String -> StructuredSelbri
ZG.BRIVLA String
brivla, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms)
handlePlacePermutations (ZG.GOhA String
brivla, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms) = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ (String -> StructuredSelbri
ZG.GOhA String
brivla, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms)
handlePlacePermutations (ZG.Prefix (ZG.SE String
x) StructuredSelbri
y, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms) = do
    (StructuredSelbri
selbri, [(Int, StructuredSelbri)]
terms2, [StructuredSelbri]
extraTerms) <- StructuredBridi -> Either String StructuredBridi
handlePlacePermutations (StructuredSelbri
y, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms)
    StructuredBridi -> Either String StructuredBridi
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ (StructuredSelbri
selbri, String -> [(Int, StructuredSelbri)] -> [(Int, StructuredSelbri)]
swapTerms2 String
x [(Int, StructuredSelbri)]
terms2, [StructuredSelbri]
extraTerms)
handlePlacePermutations (ZG.Prefix (ZG.JAI String
x) StructuredSelbri
y, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms) = do
    (StructuredSelbri
selbri, [(Int, StructuredSelbri)]
terms2, [StructuredSelbri]
extraTerms) <- StructuredBridi -> Either String StructuredBridi
handlePlacePermutations (StructuredSelbri
y, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms)
    StructuredBridi -> Either String StructuredBridi
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ (String -> StructuredSelbri -> StructuredSelbri
insertPrefixIntoStructuredSelbri (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") StructuredSelbri
selbri, [(Int, StructuredSelbri)]
terms2, [StructuredSelbri]
extraTerms)
handlePlacePermutations StructuredBridi
x = String -> Either String StructuredBridi
forall a b. a -> Either a b
Left (String -> Either String StructuredBridi)
-> String -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ String
"unrecognized pattern in function handlePlacePermutations: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ StructuredBridi -> String
forall a. Show a => a -> String
show StructuredBridi
x

handleScalarNegation :: StructuredBridi -> Either String StructuredBridi
handleScalarNegation :: StructuredBridi -> Either String StructuredBridi
handleScalarNegation (ZG.Prefix (ZG.NAhE String
nahe) (ZG.BRIVLA String
brivla), [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms) = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ (String -> StructuredSelbri
ZG.BRIVLA (String -> StructuredSelbri) -> String -> StructuredSelbri
forall a b. (a -> b) -> a -> b
$ String
nahe String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
brivla, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms)
handleScalarNegation StructuredBridi
x = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ StructuredBridi
x

---------- Append extra tag to structured bridi
appendExtraTagToStructuredBridi :: ZG.Text -> StructuredBridi -> StructuredBridi
appendExtraTagToStructuredBridi :: StructuredSelbri -> StructuredBridi -> StructuredBridi
appendExtraTagToStructuredBridi StructuredSelbri
tag (StructuredSelbri
x, [(Int, StructuredSelbri)]
y, [StructuredSelbri]
z) = (StructuredSelbri
x, [(Int, StructuredSelbri)]
y, StructuredSelbri
tag StructuredSelbri -> [StructuredSelbri] -> [StructuredSelbri]
forall a. a -> [a] -> [a]
: [StructuredSelbri]
z)

insertPrefixIntoStructuredSelbri :: String -> ZG.Text -> ZG.Text
insertPrefixIntoStructuredSelbri :: String -> StructuredSelbri -> StructuredSelbri
insertPrefixIntoStructuredSelbri String
prefix (ZG.BRIVLA String
brivla) = String -> StructuredSelbri
ZG.BRIVLA (String -> StructuredSelbri) -> String -> StructuredSelbri
forall a b. (a -> b) -> a -> b
$ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
brivla
-- TODO: also handle TANRU, GOhA, etc.

---------- Construct structured bridi from terms
constructStructuredBridiFromTerms :: StructuredSelbri -> [StructuredTerm] -> StructuredBridi
constructStructuredBridiFromTerms :: StructuredSelbri -> [StructuredSelbri] -> StructuredBridi
constructStructuredBridiFromTerms StructuredSelbri
selbri [StructuredSelbri]
terms = (StructuredSelbri
selbri, ([Int] -> [StructuredSelbri] -> [(Int, StructuredSelbri)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [StructuredSelbri]
mainTerms), [StructuredSelbri]
extraTerms) where
    isExtraTerm :: ZG.Text -> Bool
    isExtraTerm :: StructuredSelbri -> Bool
isExtraTerm (ZG.TagKU (ZG.NA String
x) Terminator
_) = Bool
True
    isExtraTerm (ZG.TagKU (ZG.BAI String
x) Terminator
_) = Bool
True
    isExtraTerm (ZG.TagKU (ZG.FIhO Initiator
x StructuredSelbri
y Terminator
z) Terminator
_) = Bool
True
    isExtraTerm (ZG.TagKU (ZG.PrefixTag Prefix
x Tag
y) Terminator
a) = StructuredSelbri -> Bool
isExtraTerm (Tag -> Terminator -> StructuredSelbri
ZG.TagKU Tag
y Terminator
a)
    isExtraTerm (ZG.Tag (ZG.NA String
x) StructuredSelbri
_) = Bool
True
    isExtraTerm (ZG.Tag (ZG.BAI String
x) StructuredSelbri
_) = Bool
True
    isExtraTerm (ZG.Tag (ZG.FIhO Initiator
x StructuredSelbri
y Terminator
z) StructuredSelbri
_) = Bool
True
    isExtraTerm (ZG.Tag (ZG.PrefixTag Prefix
x Tag
y) StructuredSelbri
a) = StructuredSelbri -> Bool
isExtraTerm (Tag -> StructuredSelbri -> StructuredSelbri
ZG.Tag Tag
y StructuredSelbri
a)
    isExtraTerm StructuredSelbri
_ = Bool
False
    ([StructuredSelbri]
extraTerms, [StructuredSelbri]
mainTerms) = (StructuredSelbri -> Bool)
-> [StructuredSelbri] -> ([StructuredSelbri], [StructuredSelbri])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition StructuredSelbri -> Bool
isExtraTerm [StructuredSelbri]
terms

---------- Retrieve structured bridi
retrieveStructuredBridi :: ZG.Text -> Either String StructuredBridi
------- without x1
-- pu prami / pu se prami / pu ca ba prami / pu ca ba se prami (also pu go'i / pu se go'i / ...)
retrieveStructuredBridi :: StructuredSelbri -> Either String StructuredBridi
retrieveStructuredBridi (ZG.Tag Tag
x StructuredSelbri
y) = StructuredSelbri -> StructuredBridi -> StructuredBridi
appendExtraTagToStructuredBridi (Tag -> Terminator -> StructuredSelbri
ZG.TagKU Tag
x (String -> Terminator
ZG.Term String
"ku")) (StructuredBridi -> StructuredBridi)
-> Either String StructuredBridi -> Either String StructuredBridi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StructuredSelbri -> Either String StructuredBridi
retrieveStructuredBridi StructuredSelbri
y
-- pu prami do / pu se prami do / pu ca ba prami do / pu ca ba se prami do (also pu go'i do / pu se go'i do / ...)
retrieveStructuredBridi (ZG.BridiTail (ZG.Tag Tag
x StructuredSelbri
y) StructuredSelbri
z) = StructuredSelbri -> StructuredBridi -> StructuredBridi
appendExtraTagToStructuredBridi (Tag -> Terminator -> StructuredSelbri
ZG.TagKU Tag
x (String -> Terminator
ZG.Term String
"ku")) (StructuredBridi -> StructuredBridi)
-> Either String StructuredBridi -> Either String StructuredBridi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StructuredSelbri -> Either String StructuredBridi
retrieveStructuredBridi (StructuredSelbri -> StructuredSelbri -> StructuredSelbri
ZG.BridiTail StructuredSelbri
y StructuredSelbri
z)
-- mutce prami
retrieveStructuredBridi (ZG.Tanru [StructuredSelbri]
brivlaList) = (, [], []) (StructuredSelbri -> StructuredBridi)
-> (String -> StructuredSelbri) -> String -> StructuredBridi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> StructuredSelbri
ZG.BRIVLA (String -> StructuredBridi)
-> (Text -> String) -> Text -> StructuredBridi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> String
T.unpack (Text -> StructuredBridi)
-> Either String Text -> Either String StructuredBridi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StructuredSelbri] -> Either String Text
retrieveTanruFromBrivlaList [StructuredSelbri]
brivlaList
-- prami
retrieveStructuredBridi (ZG.BRIVLA String
brivla) = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ (String -> StructuredSelbri
ZG.BRIVLA String
brivla, [], [])
-- go'i
retrieveStructuredBridi (ZG.GOhA String
brivla) = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ (String -> StructuredSelbri
ZG.GOhA String
brivla, [], [])
-- se prami / se go'i
retrieveStructuredBridi (ZG.Prefix Prefix
x StructuredSelbri
y) = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ (Prefix -> StructuredSelbri -> StructuredSelbri
ZG.Prefix Prefix
x StructuredSelbri
y, [], [])
-- prami do / se prami do (also go'i do / se go'i do) / cmene lo mlatu gau mi
retrieveStructuredBridi (ZG.BridiTail StructuredSelbri
selbri (ZG.Terms [StructuredSelbri]
terms Terminator
_)) = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ (StructuredSelbri
selbri, [Int] -> [StructuredSelbri] -> [(Int, StructuredSelbri)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
2..] [StructuredSelbri]
regularTerms, [StructuredSelbri]
specialTerms) where
    regularTerms :: [StructuredSelbri]
regularTerms = (StructuredSelbri -> Bool)
-> [StructuredSelbri] -> [StructuredSelbri]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (StructuredSelbri -> Bool) -> StructuredSelbri -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredSelbri -> Bool
isSpecialTerm) [StructuredSelbri]
terms
    specialTerms :: [StructuredSelbri]
specialTerms = (StructuredSelbri -> Bool)
-> [StructuredSelbri] -> [StructuredSelbri]
forall a. (a -> Bool) -> [a] -> [a]
filter StructuredSelbri -> Bool
isSpecialTerm [StructuredSelbri]
terms
    isSpecialTerm :: StructuredSelbri -> Bool
isSpecialTerm StructuredSelbri
term = case StructuredSelbri
term of
        ZG.Tag Tag
x StructuredSelbri
y -> Bool
True
        ZG.TagKU Tag
x Terminator
y -> Bool
True
        StructuredSelbri
_ -> Bool
False
-- gau mi cmene lo mlatu
retrieveStructuredBridi (ZG.Bridi (ZG.Terms ((ZG.Tag Tag
x StructuredSelbri
y):[StructuredSelbri]
more_terms) Terminator
terms_terminator) StructuredSelbri
z) = StructuredSelbri -> StructuredBridi -> StructuredBridi
appendExtraTagToStructuredBridi (Tag -> StructuredSelbri -> StructuredSelbri
ZG.Tag Tag
x StructuredSelbri
y) (StructuredBridi -> StructuredBridi)
-> Either String StructuredBridi -> Either String StructuredBridi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StructuredSelbri -> Either String StructuredBridi
retrieveStructuredBridi (StructuredSelbri -> StructuredSelbri -> StructuredSelbri
ZG.Bridi ([StructuredSelbri] -> Terminator -> StructuredSelbri
ZG.Terms [StructuredSelbri]
more_terms Terminator
terms_terminator) StructuredSelbri
z)
retrieveStructuredBridi (ZG.Bridi (ZG.Terms [] Terminator
ZG.NT) (ZG.BridiTail StructuredSelbri
x StructuredSelbri
y)) = StructuredSelbri -> Either String StructuredBridi
retrieveStructuredBridi (StructuredSelbri -> StructuredSelbri -> StructuredSelbri
ZG.BridiTail StructuredSelbri
x StructuredSelbri
y)
------- with x1
-- mi prami / mi pu ku ca ku prami
retrieveStructuredBridi (ZG.Bridi (ZG.Terms [StructuredSelbri]
terms Terminator
_) (ZG.Tanru [StructuredSelbri]
brivlaList)) = StructuredSelbri -> [StructuredSelbri] -> StructuredBridi
constructStructuredBridiFromTerms (StructuredSelbri -> [StructuredSelbri] -> StructuredBridi)
-> Either String StructuredSelbri
-> Either String ([StructuredSelbri] -> StructuredBridi)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> StructuredSelbri
ZG.BRIVLA (String -> StructuredSelbri)
-> (Text -> String) -> Text -> StructuredSelbri
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> String
T.unpack (Text -> StructuredSelbri)
-> Either String Text -> Either String StructuredSelbri
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StructuredSelbri] -> Either String Text
retrieveTanruFromBrivlaList [StructuredSelbri]
brivlaList) Either String ([StructuredSelbri] -> StructuredBridi)
-> Either String [StructuredSelbri]
-> Either String StructuredBridi
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([StructuredSelbri] -> Either String [StructuredSelbri]
forall a b. b -> Either a b
Right ([StructuredSelbri] -> Either String [StructuredSelbri])
-> [StructuredSelbri] -> Either String [StructuredSelbri]
forall a b. (a -> b) -> a -> b
$ [StructuredSelbri]
terms)
retrieveStructuredBridi (ZG.Bridi (ZG.Terms [StructuredSelbri]
terms Terminator
_) (ZG.BRIVLA String
brivla)) = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ StructuredSelbri -> [StructuredSelbri] -> StructuredBridi
constructStructuredBridiFromTerms (String -> StructuredSelbri
ZG.BRIVLA String
brivla) [StructuredSelbri]
terms
retrieveStructuredBridi (ZG.Bridi (ZG.Terms [StructuredSelbri]
terms Terminator
terms_t) (ZG.Tag Tag
x StructuredSelbri
y)) = StructuredSelbri -> StructuredBridi -> StructuredBridi
appendExtraTagToStructuredBridi (Tag -> Terminator -> StructuredSelbri
ZG.TagKU Tag
x (String -> Terminator
ZG.Term String
"ku")) (StructuredBridi -> StructuredBridi)
-> Either String StructuredBridi -> Either String StructuredBridi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StructuredSelbri -> Either String StructuredBridi
retrieveStructuredBridi (StructuredSelbri -> StructuredSelbri -> StructuredSelbri
ZG.Bridi ([StructuredSelbri] -> Terminator -> StructuredSelbri
ZG.Terms [StructuredSelbri]
terms Terminator
terms_t) StructuredSelbri
y)
-- mi go'i / mi pu ku ca ku go'i
retrieveStructuredBridi (ZG.Bridi (ZG.Terms [StructuredSelbri]
terms Terminator
_) (ZG.GOhA String
brivla)) = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ StructuredSelbri -> [StructuredSelbri] -> StructuredBridi
constructStructuredBridiFromTerms (String -> StructuredSelbri
ZG.GOhA String
brivla) [StructuredSelbri]
terms
-- mi se prami / mi pu ku ca ku se prami
retrieveStructuredBridi (ZG.Bridi (ZG.Terms [StructuredSelbri]
terms Terminator
_) (ZG.Prefix Prefix
x StructuredSelbri
y)) = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ StructuredSelbri -> [StructuredSelbri] -> StructuredBridi
constructStructuredBridiFromTerms (Prefix -> StructuredSelbri -> StructuredSelbri
ZG.Prefix Prefix
x StructuredSelbri
y) [StructuredSelbri]
terms
-- mi pu ku ca ku prami do / mi pu ku ca ku se prami do
retrieveStructuredBridi (ZG.Bridi (ZG.Terms [StructuredSelbri]
terms1 Terminator
terms1_t) (ZG.BridiTail (ZG.Tag Tag
x StructuredSelbri
y) StructuredSelbri
z)) = StructuredSelbri -> StructuredBridi -> StructuredBridi
appendExtraTagToStructuredBridi (Tag -> Terminator -> StructuredSelbri
ZG.TagKU Tag
x (String -> Terminator
ZG.Term String
"ku")) (StructuredBridi -> StructuredBridi)
-> Either String StructuredBridi -> Either String StructuredBridi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StructuredSelbri -> Either String StructuredBridi
retrieveStructuredBridi (StructuredSelbri -> StructuredSelbri -> StructuredSelbri
ZG.Bridi ([StructuredSelbri] -> Terminator -> StructuredSelbri
ZG.Terms [StructuredSelbri]
terms1 Terminator
terms1_t) (StructuredSelbri -> StructuredSelbri -> StructuredSelbri
ZG.BridiTail StructuredSelbri
y StructuredSelbri
z))
-- mi prami do / mi se prami do 
retrieveStructuredBridi (ZG.Bridi (ZG.Terms [StructuredSelbri]
terms1 Terminator
_) (ZG.BridiTail StructuredSelbri
selbri (ZG.Terms [StructuredSelbri]
terms2 Terminator
_))) = StructuredBridi -> Either String StructuredBridi
forall a b. b -> Either a b
Right (StructuredBridi -> Either String StructuredBridi)
-> StructuredBridi -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ StructuredSelbri -> [StructuredSelbri] -> StructuredBridi
constructStructuredBridiFromTerms StructuredSelbri
selbri ([StructuredSelbri]
terms1 [StructuredSelbri] -> [StructuredSelbri] -> [StructuredSelbri]
forall a. [a] -> [a] -> [a]
++ [StructuredSelbri]
terms2)
------- invalid
retrieveStructuredBridi StructuredSelbri
x = String -> Either String StructuredBridi
forall a b. a -> Either a b
Left (String -> Either String StructuredBridi)
-> String -> Either String StructuredBridi
forall a b. (a -> b) -> a -> b
$ String
"unrecognized pattern in function retrieveStructuredBridi: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ StructuredSelbri -> String
forall a. Show a => a -> String
show StructuredSelbri
x

---------- Convert structured bridi to simple bridi
-- The structured bridi must already have correct place structure (no place tags, no place reordering)
convertStructuredBridi :: Bool -> StructuredBridi -> Either String SimpleBridi
convertStructuredBridi :: Bool -> StructuredBridi -> Either String SimpleBridi
convertStructuredBridi Bool
xu (StructuredSelbri
selbri, [(Int, StructuredSelbri)]
terms, [StructuredSelbri]
extraTerms) = do
    Text
selbri2 <- StructuredSelbri -> Either String Text
convertStructuredSelbri StructuredSelbri
selbri
    [Text]
terms2 <- [(Int, StructuredSelbri)] -> Either String [Text]
convertStructuredTerms [(Int, StructuredSelbri)]
terms
    [Text]
extraTerms2 <- [StructuredSelbri] -> Either String [Text]
convertExtraTerms [StructuredSelbri]
extraTerms
    SimpleBridi -> Either String SimpleBridi
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleBridi -> Either String SimpleBridi)
-> SimpleBridi -> Either String SimpleBridi
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [Text] -> [Text] -> SimpleBridi
SimpleBridi Bool
xu Text
selbri2 [Text]
terms2 [Text]
extraTerms2

convertStructuredSelbri :: StructuredSelbri -> Either String T.Text
convertStructuredSelbri :: StructuredSelbri -> Either String Text
convertStructuredSelbri (ZG.BRIVLA String
brivla) = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
brivla
convertStructuredSelbri (ZG.GOhA String
brivla) = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
brivla
convertStructuredSelbri (ZG.Prefix (ZG.SE String
x) StructuredSelbri
y) = [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", StructuredSelbri -> Either String Text
convertStructuredSelbri StructuredSelbri
y]
convertStructuredSelbri StructuredSelbri
x = String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized pattern for structured selbri: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ StructuredSelbri -> String
forall a. Show a => a -> String
show StructuredSelbri
x

convertStructuredTerms :: [(Int, StructuredTerm)] -> Either String [T.Text]
convertStructuredTerms :: [(Int, StructuredSelbri)] -> Either String [Text]
convertStructuredTerms [(Int, StructuredSelbri)]
terms = do
    let terms2 :: [(Int, Either String Text)]
terms2 = ((Int, StructuredSelbri) -> (Int, Either String Text))
-> [(Int, StructuredSelbri)] -> [(Int, Either String Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((StructuredSelbri -> Either String Text)
-> (Int, StructuredSelbri) -> (Int, Either String Text)
forall a b. (a -> b) -> (Int, a) -> (Int, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StructuredSelbri -> Either String Text
convertStructuredTerm) [(Int, StructuredSelbri)]
terms :: [(Int, Either String T.Text)]
    let terms3 :: [Either String (Int, Text)]
terms3 = ((Int, Either String Text) -> Either String (Int, Text))
-> [(Int, Either String Text)] -> [Either String (Int, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, Either String Text
v) -> (Int
i,) (Text -> (Int, Text))
-> Either String Text -> Either String (Int, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String Text
v) [(Int, Either String Text)]
terms2 :: [Either String (Int, T.Text)]
    [(Int, Text)]
terms4 <- (Either String (Int, Text)
 -> Either String [(Int, Text)] -> Either String [(Int, Text)])
-> Either String [(Int, Text)]
-> [Either String (Int, Text)]
-> Either String [(Int, Text)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((Int, Text) -> [(Int, Text)] -> [(Int, Text)])
-> Either String (Int, Text)
-> Either String [(Int, Text)]
-> Either String [(Int, Text)]
forall a b c.
(a -> b -> c)
-> Either String a -> Either String b -> Either String c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:)) ([(Int, Text)] -> Either String [(Int, Text)]
forall a b. b -> Either a b
Right []) [Either String (Int, Text)]
terms3 :: Either String [(Int, T.Text)]
    let terms5 :: [(Int, Text)]
terms5 = ((Int, Text) -> Bool) -> [(Int, Text)] -> [(Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"zo'e") (Text -> Bool) -> ((Int, Text) -> Text) -> (Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Text
forall a b. (a, b) -> b
snd) [(Int, Text)]
terms4 :: [(Int, T.Text)]
    let lastTermNumber :: Int
lastTermNumber = if [(Int, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Text)]
terms5 then Int
0 else [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Text) -> Int) -> [(Int, Text)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text) -> Int
forall a b. (a, b) -> a
fst [(Int, Text)]
terms5)
    let retrieveTerm :: Int -> Text
retrieveTerm Int
i = Text -> [Text] -> Text
forall a. a -> [a] -> a
headOrDefault (String -> Text
T.pack String
"") ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Int, Text) -> Text) -> [(Int, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text) -> Text
forall a b. (a, b) -> b
snd ([(Int, Text)] -> [Text]) -> [(Int, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Int, Text) -> Bool) -> [(Int, Text)] -> [(Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i) (Int -> Bool) -> ((Int, Text) -> Int) -> (Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Int
forall a b. (a, b) -> a
fst) [(Int, Text)]
terms5
    [Text] -> Either String [Text]
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Either String [Text]) -> [Text] -> Either String [Text]
forall a b. (a -> b) -> a -> b
$ (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
retrieveTerm [Int
1..Int
lastTermNumber]

convertLinkargs :: ZG.Linkargs -> Either String T.Text
convertLinkargs :: Linkargs -> Either String Text
convertLinkargs (ZG.BE (ZG.Init String
x) StructuredSelbri
y Terminator
_) = [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
y, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" be'o"]
convertLinkargs (ZG.BEI (ZG.Init String
x) StructuredSelbri
y [(Separator, StructuredSelbri)]
z Terminator
_) = [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
y, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", [Either String Text] -> Either String Text
unwordsET [Either String Text]
beiArguments, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" be'o"] where
    beiArguments :: [Either String T.Text]
    beiArguments :: [Either String Text]
beiArguments = ((Separator, StructuredSelbri) -> Either String Text)
-> [(Separator, StructuredSelbri)] -> [Either String Text]
forall a b. (a -> b) -> [a] -> [b]
map (Separator, StructuredSelbri) -> Either String Text
convertArgument [(Separator, StructuredSelbri)]
z
    convertArgument :: (ZG.Separator, ZG.Text) -> Either String T.Text
    convertArgument :: (Separator, StructuredSelbri) -> Either String Text
convertArgument (ZG.Sep String
x, StructuredSelbri
y) = [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
y]
-- TODO: handle InitF

convertInitiator :: ZG.Initiator -> Either String T.Text
convertInitiator :: Initiator -> Either String Text
convertInitiator (ZG.Init String
x) = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x
-- TODO: InitF, BInit, BInitF

convertRelative :: ZG.Relative -> Either String T.Text
convertRelative :: Relative -> Either String Text
convertRelative (ZG.NOI Initiator
x StructuredSelbri
y Terminator
_) = [Either String Text] -> Either String Text
concatET [Initiator -> Either String Text
convertInitiator Initiator
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", StructuredSelbri -> Either String Text
convertBridi StructuredSelbri
y, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ Text
" ku'o"]
convertRelative (ZG.GOI Initiator
x StructuredSelbri
y Terminator
_) = [Either String Text] -> Either String Text
concatET [Initiator -> Either String Text
convertInitiator Initiator
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", StructuredSelbri -> Either String Text
convertTerm StructuredSelbri
y, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ Text
" ge'u"]
convertRelative Relative
x = String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized pattern for convertRelative: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Relative -> String
forall a. Show a => a -> String
show Relative
x

convertStructuredTerm :: StructuredTerm -> Either String T.Text
convertStructuredTerm :: StructuredSelbri -> Either String Text
convertStructuredTerm (ZG.KOhA String
x) = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x
convertStructuredTerm (ZG.Link StructuredSelbri
x Linkargs
y) = [Either String Text] -> Either String Text
concatET [StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", Linkargs -> Either String Text
convertLinkargs Linkargs
y]
convertStructuredTerm (ZG.BRIVLA String
x) = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x
convertStructuredTerm (ZG.Tag (ZG.NA String
x) StructuredSelbri
y) = StructuredSelbri -> Either String Text
convertStructuredTerm (Tag -> StructuredSelbri -> StructuredSelbri
ZG.Tag ([Tag] -> Tag
ZG.TTags [String -> Tag
ZG.NA String
x]) StructuredSelbri
y)
convertStructuredTerm (ZG.Tag (ZG.BAI String
x) StructuredSelbri
y) = StructuredSelbri -> Either String Text
convertStructuredTerm (Tag -> StructuredSelbri -> StructuredSelbri
ZG.Tag ([Tag] -> Tag
ZG.TTags [String -> Tag
ZG.BAI String
x]) StructuredSelbri
y)
convertStructuredTerm (ZG.Tag (ZG.TTags [Tag]
tagsList) StructuredSelbri
y) = [Either String Text] -> Either String Text
concatET ([Either String Text] -> Either String Text)
-> [Either String Text] -> Either String Text
forall a b. (a -> b) -> a -> b
$ [Either String Text]
extractedTags [Either String Text]
-> [Either String Text] -> [Either String Text]
forall a. [a] -> [a] -> [a]
++ [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
y] where
    extractedTags :: [Either String T.Text]
    extractedTags :: [Either String Text]
extractedTags = Either String Text -> [Either String Text] -> [Either String Text]
forall a. a -> [a] -> [a]
intersperse (Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ") ([Either String Text] -> [Either String Text])
-> [Either String Text] -> [Either String Text]
forall a b. (a -> b) -> a -> b
$ (Tag -> Either String Text) -> [Tag] -> [Either String Text]
forall a b. (a -> b) -> [a] -> [b]
map Tag -> Either String Text
extractTag [Tag]
tagsList
    extractTag :: ZG.Tag -> Either String T.Text
    extractTag :: Tag -> Either String Text
extractTag (ZG.NA String
x) = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x
    extractTag (ZG.BAI String
x) = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ case String -> Maybe String
expandBai String
x of
        Just String
x' -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"fi'o " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" fe'u"
        Maybe String
Nothing -> String -> Text
T.pack String
x
    extractTag Tag
x = String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized pattern for extractTag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tag -> String
forall a. Show a => a -> String
show Tag
x
convertStructuredTerm (ZG.Rel StructuredSelbri
x Relative
y) = [Either String Text] -> Either String Text
concatET [StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", Relative -> Either String Text
convertRelative Relative
y]
convertStructuredTerm (ZG.GOhA String
x) = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x
convertStructuredTerm (ZG.Prefix (ZG.NAhE String
x) (ZG.BRIVLA String
y)) = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y)
convertStructuredTerm (ZG.Prefix (ZG.SE String
x) StructuredSelbri
y) = Text -> Text
insertPrefix (Text -> Text) -> Either String Text -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
y where
    insertPrefix :: Text -> Text
insertPrefix = ((String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") Text -> Text -> Text
`T.append`)
convertStructuredTerm (ZG.NU (ZG.Init String
x) StructuredSelbri
y Terminator
w) = StructuredSelbri -> Either String Text
convertStructuredTerm (Initiator -> StructuredSelbri -> Terminator -> StructuredSelbri
ZG.NU (String -> Free -> Initiator
ZG.InitF String
x Free
ZG.NF) StructuredSelbri
y Terminator
w)
convertStructuredTerm (ZG.NU (ZG.InitF String
x Free
y) StructuredSelbri
w Terminator
z) = Text -> Text
insertPrefix (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
insertSuffix (Text -> Text) -> Either String Text -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Free, StructuredSelbri, Terminator) -> Either String Text
canonicalizeParsedBridi (Free
y, StructuredSelbri
w, Terminator
z) where
    insertPrefix :: Text -> Text
insertPrefix = ((String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") Text -> Text -> Text
`T.append`)
    insertSuffix :: Text -> Text
insertSuffix = (Text -> Text -> Text
`T.append` Text
" kei")
convertStructuredTerm (ZG.LE (ZG.Init String
x) Relative
ZG.NR Mex
number (ZG.Rel StructuredSelbri
y Relative
z) Terminator
t) = StructuredSelbri -> Either String Text
convertStructuredTerm (StructuredSelbri -> Either String Text)
-> StructuredSelbri -> Either String Text
forall a b. (a -> b) -> a -> b
$ StructuredSelbri -> Relative -> StructuredSelbri
ZG.Rel (Initiator
-> Relative
-> Mex
-> StructuredSelbri
-> Terminator
-> StructuredSelbri
ZG.LE (String -> Initiator
ZG.Init String
x) Relative
ZG.NR Mex
number StructuredSelbri
y Terminator
t) Relative
z
convertStructuredTerm (ZG.LE (ZG.Init String
x) Relative
ZG.NR Mex
number StructuredSelbri
y Terminator
_) = Text -> Text
insertPrefix (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
insertSuffix (Text -> Text) -> Either String Text -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String (Text -> Text)
insertNumber Either String (Text -> Text)
-> Either String Text -> Either String Text
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
y) where
    insertNumber :: Either String (Text -> Text)
insertNumber = Mex -> Either String Text
canonicalizeNumber Mex
number Either String Text
-> (Text -> Either String (Text -> Text))
-> Either String (Text -> Text)
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Text
"" -> (Text -> Text) -> Either String (Text -> Text)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Text -> Text
forall a. a -> a
id
        Text
x -> (Text -> Text) -> Either String (Text -> Text)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text
x Text -> Text -> Text
`T.append` Text
" ") Text -> Text -> Text
`T.append`)
    insertPrefix :: Text -> Text
insertPrefix = ((String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") Text -> Text -> Text
`T.append`)
    insertSuffix :: Text -> Text
insertSuffix = (Text -> Text -> Text
`T.append` Text
" ku")
convertStructuredTerm (ZG.LE (ZG.Init String
x) (ZG.RelSumti StructuredSelbri
y) Mex
ZG.NQ StructuredSelbri
z Terminator
_) = [Either String Text] -> Either String Text
unwordsET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, StructuredSelbri -> Either String Text
convertBridi StructuredSelbri
z, Text -> Either String Text
forall a b. b -> Either a b
Right Text
"ku pe", StructuredSelbri -> Either String Text
convertTerm StructuredSelbri
y, Text -> Either String Text
forall a b. b -> Either a b
Right Text
"ge'u"]
convertStructuredTerm (ZG.Tanru [StructuredSelbri]
xs) = [Either String Text] -> Either String Text
unwordsET ((StructuredSelbri -> Either String Text)
-> [StructuredSelbri] -> [Either String Text]
forall a b. (a -> b) -> [a] -> [b]
map StructuredSelbri -> Either String Text
convertStructuredTerm [StructuredSelbri]
xs)
convertStructuredTerm (ZG.Clause (ZG.ZO String
x)) = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"lo'u", String -> Text
T.pack String
x, Text
"le'u"]
convertStructuredTerm (ZG.Clause (ZG.LOhU [String]
x)) = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"lo'u",  [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
x, Text
"le'u"]
convertStructuredTerm (ZG.LU (ZG.Init String
x) StructuredSelbri
y Terminator
term) = [Either String Text] -> Either String Text
unwordsET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, StructuredSelbri -> Either String Text
convertText StructuredSelbri
y , Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ Text
"li'u"]
convertStructuredTerm (ZG.Con StructuredSelbri
x [(Connective, StructuredSelbri)]
connectives) = [Either String Text] -> Either String Text
unwordsET ([Either String Text] -> Either String Text)
-> [Either String Text] -> Either String Text
forall a b. (a -> b) -> a -> b
$ StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
x Either String Text -> [Either String Text] -> [Either String Text]
forall a. a -> [a] -> [a]
: (((Connective, StructuredSelbri) -> Either String Text)
-> [(Connective, StructuredSelbri)] -> [Either String Text]
forall a b. (a -> b) -> [a] -> [b]
map (Connective, StructuredSelbri) -> Either String Text
convertConnective [(Connective, StructuredSelbri)]
connectives) where
    convertConnective :: (ZG.Connective, ZG.Text) -> Either String T.Text
    convertConnective :: (Connective, StructuredSelbri) -> Either String Text
convertConnective (ZG.JOI String
x, StructuredSelbri
y) = [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right Text
".", Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, Text -> Either String Text
forall a b. b -> Either a b
Right Text
" ", StructuredSelbri -> Either String Text
convertTerm StructuredSelbri
y]
convertStructuredTerm (ZG.LAhE (ZG.Init String
x) Relative
ZG.NR StructuredSelbri
y Terminator
ZG.NT) = [Either String Text] -> Either String Text
unwordsET ([Either String Text] -> Either String Text)
-> [Either String Text] -> Either String Text
forall a b. (a -> b) -> a -> b
$ [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
y]
convertStructuredTerm StructuredSelbri
x = String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized pattern for structured term: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ StructuredSelbri -> String
forall a. Show a => a -> String
show StructuredSelbri
x

convertExtraTerms :: [ExtraTerm] -> Either String [T.Text]
convertExtraTerms :: [StructuredSelbri] -> Either String [Text]
convertExtraTerms = (StructuredSelbri -> Either String Text)
-> [StructuredSelbri] -> Either String [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM StructuredSelbri -> Either String Text
convertExtraTerm ([StructuredSelbri] -> Either String [Text])
-> ([StructuredSelbri] -> [StructuredSelbri])
-> [StructuredSelbri]
-> Either String [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StructuredSelbri] -> [StructuredSelbri]
expandExtraTerms

expandExtraTerms :: [ExtraTerm] -> [ExtraTerm]
expandExtraTerms :: [StructuredSelbri] -> [StructuredSelbri]
expandExtraTerms = (StructuredSelbri -> [StructuredSelbri])
-> [StructuredSelbri] -> [StructuredSelbri]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap StructuredSelbri -> [StructuredSelbri]
expandTerm where
    expandTerm :: ExtraTerm -> [ExtraTerm]
    expandTerm :: StructuredSelbri -> [StructuredSelbri]
expandTerm (ZG.TagKU (ZG.TTags [Tag]
tags) Terminator
term) = (Tag -> StructuredSelbri) -> [Tag] -> [StructuredSelbri]
forall a b. (a -> b) -> [a] -> [b]
map (Tag -> Terminator -> StructuredSelbri
`ZG.TagKU` Terminator
term) [Tag]
tags
    expandTerm StructuredSelbri
x = [StructuredSelbri
x]

convertExtraTerm :: ExtraTerm -> Either String T.Text
convertExtraTerm :: StructuredSelbri -> Either String Text
convertExtraTerm (ZG.TagKU (ZG.NA String
x) Terminator
_) = [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ku"]
convertExtraTerm (ZG.TagKU (ZG.FIhO (ZG.Init String
_) StructuredSelbri
y Terminator
_) Terminator
_) = [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"fi'o ", StructuredSelbri -> Either String Text
convertStructuredSelbri StructuredSelbri
y, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" fe'u ku"]
convertExtraTerm (ZG.Tag (ZG.NA String
x) StructuredSelbri
text) = [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
text, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ku"]
convertExtraTerm (ZG.Tag (ZG.FIhO (ZG.Init String
_) StructuredSelbri
y Terminator
_) StructuredSelbri
text) = [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"fi'o ", StructuredSelbri -> Either String Text
convertStructuredSelbri StructuredSelbri
y, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" fe'u ", StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
text]
convertExtraTerm (ZG.TagKU (ZG.PrefixTag (ZG.SE String
x) (ZG.BAI String
y)) Terminator
z) = case String -> Maybe String
expandBai String
y of
    Just String
y' -> StructuredSelbri -> Either String Text
convertExtraTerm (StructuredSelbri -> Either String Text)
-> StructuredSelbri -> Either String Text
forall a b. (a -> b) -> a -> b
$ Tag -> Terminator -> StructuredSelbri
ZG.TagKU (Initiator -> StructuredSelbri -> Terminator -> Tag
ZG.FIhO (String -> Initiator
ZG.Init String
"fi'o") (Prefix -> StructuredSelbri -> StructuredSelbri
ZG.Prefix (String -> Prefix
ZG.SE String
x) (String -> StructuredSelbri
ZG.BRIVLA String
y')) (String -> Terminator
ZG.Term String
"fe'u")) Terminator
z
    Maybe String
Nothing -> [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", StructuredSelbri -> Either String Text
convertExtraTerm (Tag -> Terminator -> StructuredSelbri
ZG.TagKU (String -> Tag
ZG.BAI String
y) Terminator
z)]
convertExtraTerm (ZG.Tag (ZG.PrefixTag (ZG.SE String
x) (ZG.BAI String
y)) StructuredSelbri
z) = case String -> Maybe String
expandBai String
y of
    Just String
y' -> StructuredSelbri -> Either String Text
convertExtraTerm (StructuredSelbri -> Either String Text)
-> StructuredSelbri -> Either String Text
forall a b. (a -> b) -> a -> b
$ Tag -> StructuredSelbri -> StructuredSelbri
ZG.Tag (Initiator -> StructuredSelbri -> Terminator -> Tag
ZG.FIhO (String -> Initiator
ZG.Init String
"fi'o") (Prefix -> StructuredSelbri -> StructuredSelbri
ZG.Prefix (String -> Prefix
ZG.SE String
x) (String -> StructuredSelbri
ZG.BRIVLA String
y')) (String -> Terminator
ZG.Term String
"fe'u")) StructuredSelbri
z
    Maybe String
Nothing -> [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", StructuredSelbri -> Either String Text
convertExtraTerm (Tag -> StructuredSelbri -> StructuredSelbri
ZG.Tag (String -> Tag
ZG.BAI String
y) StructuredSelbri
z)]
convertExtraTerm (ZG.TagKU (ZG.BAI String
x) Terminator
y) = case String -> Maybe String
expandBai String
x of
    Just String
x' -> StructuredSelbri -> Either String Text
convertExtraTerm (StructuredSelbri -> Either String Text)
-> StructuredSelbri -> Either String Text
forall a b. (a -> b) -> a -> b
$ Tag -> Terminator -> StructuredSelbri
ZG.TagKU (Initiator -> StructuredSelbri -> Terminator -> Tag
ZG.FIhO (String -> Initiator
ZG.Init String
"fi'o") (String -> StructuredSelbri
ZG.BRIVLA String
x') (String -> Terminator
ZG.Term String
"fe'u")) Terminator
y
    Maybe String
Nothing -> [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ku"]
convertExtraTerm (ZG.Tag (ZG.BAI String
x) StructuredSelbri
text) = case String -> Maybe String
expandBai String
x of
    Just String
x' -> StructuredSelbri -> Either String Text
convertExtraTerm (StructuredSelbri -> Either String Text)
-> StructuredSelbri -> Either String Text
forall a b. (a -> b) -> a -> b
$ Tag -> StructuredSelbri -> StructuredSelbri
ZG.Tag (Initiator -> StructuredSelbri -> Terminator -> Tag
ZG.FIhO (String -> Initiator
ZG.Init String
"fi'o") (String -> StructuredSelbri
ZG.BRIVLA String
x') (String -> Terminator
ZG.Term String
"fe'u")) StructuredSelbri
text
    Maybe String
Nothing -> [Either String Text] -> Either String Text
concatET [Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ", StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
text]
convertExtraTerm StructuredSelbri
x = String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized pattern for convertExtraTerm: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ StructuredSelbri -> String
forall a. Show a => a -> String
show StructuredSelbri
x

canonicalizeNumber :: ZG.Mex -> Either String T.Text
canonicalizeNumber :: Mex -> Either String Text
canonicalizeNumber Mex
ZG.NQ = Text -> Either String Text
forall a b. b -> Either a b
Right Text
""
canonicalizeNumber (ZG.P1 String
digit) = Mex -> Either String Text
canonicalizeNumber ([Mex] -> Terminator -> Mex
ZG.Ms [(String -> Mex
ZG.P1 String
digit)] Terminator
ZG.NT)
canonicalizeNumber (ZG.Ms [Mex]
digits Terminator
ZG.NT) = [Either String Text] -> Either String Text
concatET ([Either String Text] -> Either String Text)
-> [Either String Text] -> Either String Text
forall a b. (a -> b) -> a -> b
$ (Mex -> Either String Text) -> [Mex] -> [Either String Text]
forall a b. (a -> b) -> [a] -> [b]
map Mex -> Either String Text
convertDigit [Mex]
digits where
    convertDigit :: ZG.Mex -> Either String T.Text
    convertDigit :: Mex -> Either String Text
convertDigit (ZG.P1 String
x) = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x
    convertDigit Mex
x = String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized pattern for convertDigit: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Mex -> String
forall a. Show a => a -> String
show Mex
x
canonicalizeNumber Mex
x = String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized pattern for canonicalizeNumber: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Mex -> String
forall a. Show a => a -> String
show Mex
x

-- TODO: add all BAI
compressedBai :: M.Map String String
compressedBai :: Map String String
compressedBai = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (String
"pi'o", String
"pilno")
    , (String
"zu'e", String
"zukte")
    , (String
"mu'i", String
"mukti")
    , (String
"gau", String
"gasnu")
    ]

expandBai :: String -> Maybe String
expandBai :: String -> Maybe String
expandBai = (String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map String String
compressedBai)

retrieveTanruFromBrivlaList :: [ZG.Text] -> Either String T.Text
retrieveTanruFromBrivlaList :: [StructuredSelbri] -> Either String Text
retrieveTanruFromBrivlaList [StructuredSelbri]
brivlaList = [Either String Text] -> Either String Text
unwordsET ([Either String Text] -> Either String Text)
-> [Either String Text] -> Either String Text
forall a b. (a -> b) -> a -> b
$ StructuredSelbri -> Either String Text
convertStructuredSelbri (StructuredSelbri -> Either String Text)
-> [StructuredSelbri] -> [Either String Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StructuredSelbri]
brivlaList

---------- Canonicalization
--TODO: canonicalize "do xu ciska" -> "xu do ciska"
canonicalizeText :: SentenceCanonicalizer
canonicalizeText :: Text -> Either String Text
canonicalizeText Text
sentence = Text -> Either String (Free, StructuredSelbri, Terminator)
parseText (Text -> Text
normalizeText Text
sentence) Either String (Free, StructuredSelbri, Terminator)
-> ((Free, StructuredSelbri, Terminator) -> Either String Text)
-> Either String Text
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Free, StructuredSelbri, Terminator) -> Either String Text
canonicalizeParsedText

-- | Normalizes the text prior to parsing.
--
-- Useful for performing dirty hacks, such as blindly replacing "be fi" with "be zo'e bei, until
-- canonicalization of the corresponding construct is properly implement using the parse tree.
normalizeText :: T.Text -> T.Text
normalizeText :: Text -> Text
normalizeText = Text -> Text
normalizeWords (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
applyHacks (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
normalizeApostrophes where
    normalizeApostrophes :: T.Text -> T.Text
    normalizeApostrophes :: Text -> Text
normalizeApostrophes = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"’" Text
"'"
    applyHacks :: T.Text -> T.Text
    applyHacks :: Text -> Text
applyHacks = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" be fi " Text
" be zo'e bei " (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" befi " Text
" be zo'e bei " (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" befilo " Text
" be zo'e bei lo "

-- | Normalizes individual words in the sentence.
--
-- For example, normalizes words starting with well-known rafsi: "seldunda" and "seldu'a" become "se dunda".
normalizeWords :: T.Text -> T.Text
normalizeWords :: Text -> Text
normalizeWords = [Text] -> Text
T.unwords ([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
normalizeWord ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words where
    normalizeWord :: T.Text -> T.Text
    normalizeWord :: Text -> Text
normalizeWord = Text -> Text
normalizeSimpleRafsi
    normalizeSimpleRafsi :: T.Text -> T.Text
    normalizeSimpleRafsi :: Text -> Text
normalizeSimpleRafsi = Text -> Text -> Text -> Text
normalizePositionalRafsi Text
"sel" Text
"se" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
normalizePositionalRafsi Text
"ter" Text
"te" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
normalizePositionalRafsi Text
"vel" Text
"ve" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
normalizePositionalRafsi Text
"xel" Text
"xe"
    -- | Normalizes single words starting with the given positional rafsi (sel, ter, vel or xel).
    normalizePositionalRafsi :: T.Text -> T.Text -> T.Text -> T.Text
    normalizePositionalRafsi :: Text -> Text -> Text -> Text
normalizePositionalRafsi Text
positionalRafsiText Text
positionalCmavoText Text
word =
        case Text -> Text -> Maybe Text
T.stripPrefix Text
positionalRafsiText Text
word of
            Maybe Text
Nothing -> Text
word
            Just Text
wordWithStrippedRafsi -> Text
positionalCmavoText Text -> Text -> Text
`T.append` Text
" " Text -> Text -> Text
`T.append` (Text -> Text
normalizeSingleRafsiWord Text
wordWithStrippedRafsi)
    -- | If the word is a single rafsi mapping to a gismu, then converts it into the full gismu. Otherwise does nothing.
    --
    -- For example, "du'a" becomes "dunda", but "predu'a" remains the same.
    normalizeSingleRafsiWord :: T.Text -> T.Text
    normalizeSingleRafsiWord :: Text -> Text
normalizeSingleRafsiWord Text
word = case Text -> Map Text Gismu -> Maybe Gismu
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
word (Dictionary -> Map Text Gismu
dictRafsi Dictionary
englishDictionary) of
        Maybe Gismu
Nothing -> Text
word
        Just Gismu
gismu -> Gismu -> Text
gismuText Gismu
gismu

canonicalizeParsedText :: (ZG.Free, ZG.Text, ZG.Terminator) -> Either String T.Text
canonicalizeParsedText :: (Free, StructuredSelbri, Terminator) -> Either String Text
canonicalizeParsedText (Free, StructuredSelbri, Terminator)
parsedText = ((Free, StructuredSelbri, Terminator) -> Either String Text
canonicalizeParsedTerm (Free, StructuredSelbri, Terminator)
parsedText) Either String Text -> Either String Text -> Either String Text
forall a. Either String a -> Either String a -> Either String a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ((Free, StructuredSelbri, Terminator) -> Either String Text
canonicalizeParsedBridi (Free, StructuredSelbri, Terminator)
parsedText)

canonicalizeParsedBridi :: (ZG.Free, ZG.Text, ZG.Terminator) -> Either String T.Text
canonicalizeParsedBridi :: (Free, StructuredSelbri, Terminator) -> Either String Text
canonicalizeParsedBridi (Free, StructuredSelbri, Terminator)
parsedBridi = SimpleBridi -> Text
displayCanonicalBridi (SimpleBridi -> Text)
-> Either String SimpleBridi -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Free, StructuredSelbri, Terminator) -> Either String SimpleBridi
retrieveSimpleBridi (Free, StructuredSelbri, Terminator)
parsedBridi)

extractSimpleBridi :: T.Text -> Either String SimpleBridi
extractSimpleBridi :: Text -> Either String SimpleBridi
extractSimpleBridi Text
text = Text -> Either String (Free, StructuredSelbri, Terminator)
parseText Text
text Either String (Free, StructuredSelbri, Terminator)
-> ((Free, StructuredSelbri, Terminator)
    -> Either String SimpleBridi)
-> Either String SimpleBridi
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Free, StructuredSelbri, Terminator) -> Either String SimpleBridi
retrieveSimpleBridi

retrieveSimpleBridi :: (ZG.Free, ZG.Text, ZG.Terminator) -> Either String SimpleBridi
retrieveSimpleBridi :: (Free, StructuredSelbri, Terminator) -> Either String SimpleBridi
retrieveSimpleBridi (Free
free, StructuredSelbri
text, Terminator
terminator) = StructuredSelbri -> Either String StructuredBridi
retrieveStructuredBridi StructuredSelbri
text Either String StructuredBridi
-> (StructuredBridi -> Either String StructuredBridi)
-> Either String StructuredBridi
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StructuredBridi -> Either String StructuredBridi
handleScalarNegation Either String StructuredBridi
-> (StructuredBridi -> Either String StructuredBridi)
-> Either String StructuredBridi
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StructuredBridi -> Either String StructuredBridi
handlePlaceTags Either String StructuredBridi
-> (StructuredBridi -> Either String StructuredBridi)
-> Either String StructuredBridi
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StructuredBridi -> Either String StructuredBridi
handlePlacePermutations Either String StructuredBridi
-> (StructuredBridi -> Either String SimpleBridi)
-> Either String SimpleBridi
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> StructuredBridi -> Either String SimpleBridi
convertStructuredBridi Bool
xu where
    xu :: Bool
xu = Free -> Bool
hasXu Free
free

canonicalizeParsedTerm :: (ZG.Free, ZG.Text, ZG.Terminator) -> Either String T.Text
canonicalizeParsedTerm :: (Free, StructuredSelbri, Terminator) -> Either String Text
canonicalizeParsedTerm (Free
free, ZG.Terms [StructuredSelbri
term] Terminator
_, Terminator
terminator) = StructuredSelbri -> Either String Text
convertStructuredTerm StructuredSelbri
term
canonicalizeParsedTerm (Free, StructuredSelbri, Terminator)
x = String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized pattern for canonicalizeParsedTerm: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Free, StructuredSelbri, Terminator) -> String
forall a. Show a => a -> String
show (Free, StructuredSelbri, Terminator)
x

hasXu :: ZG.Free -> Bool
hasXu :: Free -> Bool
hasXu (ZG.UI String
x) = String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"xu"
hasXu (ZG.UIF String
x Free
y) = (String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"xu") Bool -> Bool -> Bool
|| Free -> Bool
hasXu Free
y
hasXu (ZG.BUIF [String]
x String
y Free
z) = Free -> Bool
hasXu Free
z
hasXu (ZG.DOIF String
x Free
y) = Free -> Bool
hasXu Free
y
hasXu (ZG.BDOIF [String]
x String
y Free
z) = Free -> Bool
hasXu Free
z
hasXu (ZG.COIF String
x Free
y) = Free -> Bool
hasXu Free
y
hasXu (ZG.BCOIF [String]
x String
y Free
z) = Free -> Bool
hasXu Free
z
hasXu (ZG.COIs [Free]
xs Terminator
y) = (Free -> Bool) -> [Free] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Free -> Bool
hasXu [Free]
xs
hasXu (ZG.Vocative [Free]
xs StructuredSelbri
y Terminator
z) = (Free -> Bool) -> [Free] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Free -> Bool
hasXu [Free]
xs
hasXu Free
_ = Bool
False

convertText :: ZG.Text -> Either String T.Text
convertText :: StructuredSelbri -> Either String Text
convertText StructuredSelbri
text = (Free, StructuredSelbri, Terminator) -> Either String Text
canonicalizeParsedText (Free
ZG.NF, StructuredSelbri
text, Terminator
ZG.NT)

convertBridi :: ZG.Text -> Either String T.Text
convertBridi :: StructuredSelbri -> Either String Text
convertBridi StructuredSelbri
text = (Free, StructuredSelbri, Terminator) -> Either String Text
canonicalizeParsedBridi (Free
ZG.NF, StructuredSelbri
text, Terminator
ZG.NT)

convertTerm :: ZG.Text -> Either String T.Text
convertTerm :: StructuredSelbri -> Either String Text
convertTerm StructuredSelbri
term = (Free, StructuredSelbri, Terminator) -> Either String Text
canonicalizeParsedTerm (Free
ZG.NF, [StructuredSelbri] -> Terminator -> StructuredSelbri
ZG.Terms [StructuredSelbri
term] Terminator
ZG.NT, Terminator
ZG.NT)