{-# 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
type StructuredSelbri = ZG.Text
type StructuredTerm = ZG.Text
type = ZG.Text
type StructuredBridi = (StructuredSelbri, [(Int, StructuredTerm)], [ExtraTerm])
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)
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
appendExtraTagToStructuredBridi :: ZG.Text -> StructuredBridi -> StructuredBridi
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
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
retrieveStructuredBridi :: ZG.Text -> Either String StructuredBridi
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
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)
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
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, [], [])
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, [], [])
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, [], [])
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
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)
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)
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
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
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))
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)
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
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]
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
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]
= (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
(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
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
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
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 "
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"
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)
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
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)