WIP: Compaction

1 files changed, 54 insertions, 0 deletions

diff --git a/src/Data/JLD/Compaction/InverseContext.hs b/src/Data/JLD/Compaction/InverseContext.hs
new file mode 100644
index 0000000..b351e34
--- /dev/null
+++ b/src/Data/JLD/Compaction/InverseContext.hs
@@ -0,0 +1,54 @@
+module Data.JLD.Compaction.InverseContext (buildInverseContext) where
+
+import Data.JLD.Prelude
+
+import Data.JLD.Model.ActiveContext (ActiveContext (..))
+import Data.JLD.Model.Direction (Direction (..))
+import Data.JLD.Model.InverseContext (InverseContext)
+import Data.JLD.Model.Keyword (Keyword (..))
+import Data.JLD.Model.Language (Language (Language))
+import Data.JLD.Model.TermDefinition (TermDefinition (..))
+
+import Data.Map qualified as M
+
+processTerm :: Text -> InverseContext -> Text -> TermDefinition -> InverseContext
+processTerm defaultLangDir out termName TermDefinition{..}
+    | Just variableName <- termDefinitionIriMapping =
+        out
+            |> M.insert (variableName, container, show KeywordAny, show KeywordNone) termName
+            .> if
+                    | termDefinitionReversePropertyFlag ->
+                        M.insert (variableName, container, show KeywordType, show KeywordReverse) termName
+                    | termDefinitionTypeMapping == Just (show KeywordNone) ->
+                        M.insert (variableName, container, show KeywordLanguage, show KeywordAny) termName
+                            .> M.insert (variableName, container, show KeywordType, show KeywordAny) termName
+                    | Just typeMapping <- termDefinitionTypeMapping ->
+                        M.insert (variableName, container, show KeywordType, typeMapping) termName
+                    | Just langDir <- maybeLangDir ->
+                        M.insert (variableName, container, show KeywordLanguage, langDir) termName
+                    | otherwise ->
+                        M.insert (variableName, container, show KeywordLanguage, defaultLangDir) termName
+                            .> M.insert (variableName, container, show KeywordLanguage, show KeywordNone) termName
+                            .> M.insert (variableName, container, show KeywordType, show KeywordNone) termName
+    | otherwise = out
+  where
+    container = if null termDefinitionContainerMapping then show KeywordNone else fold termDefinitionContainerMapping
+    maybeLangDir = case (termDefinitionLanguageMapping, termDefinitionDirectionMapping) of
+        (Just (Language language), Just LTR) -> Just <| language <> "_ltr"
+        (Just (Language language), Just RTL) -> Just <| language <> "_rtl"
+        (Just (Language language), _) -> Just <| language
+        (Just _, Just LTR) -> Just "_ltr"
+        (Just _, Just RTL) -> Just "_rtl"
+        (Just _, _) -> Just <| show KeywordNull
+        (Nothing, Just LTR) -> Just "_ltr"
+        (Nothing, Just RTL) -> Just "_rtl"
+        (Nothing, Just NoDirection) -> Just <| show KeywordNone
+        (Nothing, Nothing) -> Nothing
+
+buildInverseContext :: ActiveContext -> InverseContext
+buildInverseContext ActiveContext{..} = M.foldlWithKey (processTerm defaultLangDir) mempty activeContextTerms
+  where
+    defaultLangDir = case (activeContextDefaultBaseDirection, activeContextDefaultLanguage) of
+        (Just bd, Just (Language dl)) -> dl <> "_" <> show bd
+        (Just bd, _) -> "_" <> show bd
+        (_, _) -> show KeywordNone