aboutsummaryrefslogtreecommitdiffstats
path: root/src/Data/JLD/Model
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/JLD/Model')
-rw-r--r--src/Data/JLD/Model/InverseContext.hs30
1 files changed, 28 insertions, 2 deletions
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 @@
1module Data.JLD.Model.InverseContext (InverseContext) where 1module Data.JLD.Model.InverseContext (InverseContext, hasKey3, insert, selectTerm) where
2 2
3import Data.JLD.Prelude 3import Data.JLD.Prelude
4 4
5type InverseContext = Map (Text, Text, Text, Text) Text 5import Data.JLD.Model.Keyword (Keyword)
6import Data.Map qualified as M
7import Data.Set qualified as S
8import Data.Vector (Vector, (!?))
9import Data.Vector qualified as V (catMaybes)
10
11type InverseContext = Map Text (Map Text (Map Keyword (Map Text Text)))
12
13hasKey3 :: Text -> Text -> Keyword -> InverseContext -> Bool
14hasKey3 var container type' inverseContext =
15 M.lookup var inverseContext >>= M.lookup container >>= M.lookup type' |> isJust
16
17lookup4 :: Text -> Text -> Keyword -> Text -> InverseContext -> Maybe Text
18lookup4 var container type' typeMapping inverseContext =
19 M.lookup var inverseContext >>= M.lookup container >>= M.lookup type' >>= M.lookup typeMapping
20
21insert :: Text -> Text -> Keyword -> Text -> Text -> InverseContext -> InverseContext
22insert var container type' typeMapping value =
23 M.alter (Just <. M.alter (Just <. M.alter (Just <. M.insert typeMapping value <. fromMaybe mempty) type' <. fromMaybe mempty) container <. fromMaybe mempty) var
24
25selectTerm :: Text -> Set Text -> Keyword -> Vector Text -> InverseContext -> Maybe Text
26selectTerm var containers typeLanguage preferredValues inverseContext =
27 containers
28 |> S.filter (\container -> hasKey3 var container typeLanguage inverseContext)
29 .> foldMap' (\container -> preferredValues <&> \item -> lookup4 var container typeLanguage item inverseContext)
30 .> V.catMaybes
31 .> (!? 0)