diff options
Diffstat (limited to 'src/Data/JLD/Model')
-rw-r--r-- | src/Data/JLD/Model/InverseContext.hs | 30 |
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 @@ | |||
1 | module Data.JLD.Model.InverseContext (InverseContext) where | 1 | module Data.JLD.Model.InverseContext (InverseContext, hasKey3, insert, selectTerm) where |
2 | 2 | ||
3 | import Data.JLD.Prelude | 3 | import Data.JLD.Prelude |
4 | 4 | ||
5 | type InverseContext = Map (Text, Text, Text, Text) Text | 5 | import Data.JLD.Model.Keyword (Keyword) |
6 | import Data.Map qualified as M | ||
7 | import Data.Set qualified as S | ||
8 | import Data.Vector (Vector, (!?)) | ||
9 | import Data.Vector qualified as V (catMaybes) | ||
10 | |||
11 | type InverseContext = Map Text (Map Text (Map Keyword (Map Text Text))) | ||
12 | |||
13 | hasKey3 :: Text -> Text -> Keyword -> InverseContext -> Bool | ||
14 | hasKey3 var container type' inverseContext = | ||
15 | M.lookup var inverseContext >>= M.lookup container >>= M.lookup type' |> isJust | ||
16 | |||
17 | lookup4 :: Text -> Text -> Keyword -> Text -> InverseContext -> Maybe Text | ||
18 | lookup4 var container type' typeMapping inverseContext = | ||
19 | M.lookup var inverseContext >>= M.lookup container >>= M.lookup type' >>= M.lookup typeMapping | ||
20 | |||
21 | insert :: Text -> Text -> Keyword -> Text -> Text -> InverseContext -> InverseContext | ||
22 | insert 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 | |||
25 | selectTerm :: Text -> Set Text -> Keyword -> Vector Text -> InverseContext -> Maybe Text | ||
26 | selectTerm 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) | ||