From 2479f89067408b8b9dc79abf09bbe6b1d3c0647d Mon Sep 17 00:00:00 2001
From: Volpeon <github@volpeon.ink>
Date: Sat, 24 Jun 2023 10:32:18 +0200
Subject: WIP: IRI compaction

---
 src/Data/JLD/Model/InverseContext.hs | 30 ++++++++++++++++++++++++++++--
 1 file changed, 28 insertions(+), 2 deletions(-)

(limited to 'src/Data/JLD/Model')

diff --git a/src/Data/JLD/Model/InverseContext.hs b/src/Data/JLD/Model/InverseContext.hs
index fe4b516..ee85ce9 100644
--- a/src/Data/JLD/Model/InverseContext.hs
+++ b/src/Data/JLD/Model/InverseContext.hs
@@ -1,5 +1,31 @@
-module Data.JLD.Model.InverseContext (InverseContext) where
+module Data.JLD.Model.InverseContext (InverseContext, hasKey3, insert, selectTerm) where
 
 import Data.JLD.Prelude
 
-type InverseContext = Map (Text, Text, Text, Text) Text
+import Data.JLD.Model.Keyword (Keyword)
+import Data.Map qualified as M
+import Data.Set qualified as S
+import Data.Vector (Vector, (!?))
+import Data.Vector qualified as V (catMaybes)
+
+type InverseContext = Map Text (Map Text (Map Keyword (Map Text Text)))
+
+hasKey3 :: Text -> Text -> Keyword -> InverseContext -> Bool
+hasKey3 var container type' inverseContext =
+    M.lookup var inverseContext >>= M.lookup container >>= M.lookup type' |> isJust
+
+lookup4 :: Text -> Text -> Keyword -> Text -> InverseContext -> Maybe Text
+lookup4 var container type' typeMapping inverseContext =
+    M.lookup var inverseContext >>= M.lookup container >>= M.lookup type' >>= M.lookup typeMapping
+
+insert :: Text -> Text -> Keyword -> Text -> Text -> InverseContext -> InverseContext
+insert var container type' typeMapping value =
+    M.alter (Just <. M.alter (Just <. M.alter (Just <. M.insert typeMapping value <. fromMaybe mempty) type' <. fromMaybe mempty) container <. fromMaybe mempty) var
+
+selectTerm :: Text -> Set Text -> Keyword -> Vector Text -> InverseContext -> Maybe Text
+selectTerm var containers typeLanguage preferredValues inverseContext =
+    containers
+        |> S.filter (\container -> hasKey3 var container typeLanguage inverseContext)
+        .> foldMap' (\container -> preferredValues <&> \item -> lookup4 var container typeLanguage item inverseContext)
+        .> V.catMaybes
+        .> (!? 0)
-- 
cgit v1.2.3-54-g00ecf