From 33faca6f99dc207e81497297c205a1ff29ae2f33 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Mon, 12 Feb 2024 05:39:19 +0100
Subject: dissolve `unique`

---
 app/Main.hs   | 15 +--------------
 app/Record.hs | 18 ++++++++++--------
 2 files changed, 11 insertions(+), 22 deletions(-)

(limited to 'app')

diff --git a/app/Main.hs b/app/Main.hs
index 4eedc97..e7d62bf 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -374,20 +374,7 @@ satisfies :: Maybe WhereClause -> R.Records J.Value -> Bool
 satisfies Nothing _ = True
 satisfies (Just (And ws)) vs = all (\w -> satisfies (Just w) vs) ws
 satisfies (Just (Or ws)) vs = any (\w -> satisfies (Just w) vs) ws
-satisfies (Just (Where p)) vs = satisfy p vs
-
-satisfy :: Comparison -> R.Records J.Value -> Bool
-satisfy (Eq f g) vs = unique f vs == unique g vs
-
-data DuplicateField' = DuplicateField'
-  deriving (Show)
-
-instance Exception DuplicateField'
-
-unique :: F.Field -> R.Records J.Value -> J.Value
-unique f as = case mapMaybe (R.lookup f) as of
-  [v] -> v
-  (_ : _) -> throw DuplicateField'
+satisfies (Just (Where (Eq f g))) vs = R.lookups f vs == R.lookups g vs
 
 query' :: Query -> IO ()
 query' q = mapM_ (LB.putStrLn . J.encode) =<< query q
diff --git a/app/Record.hs b/app/Record.hs
index d23d289..30e98ec 100644
--- a/app/Record.hs
+++ b/app/Record.hs
@@ -4,6 +4,7 @@ module Record
     toValue,
     lookup,
     Records,
+    lookups,
     select,
     disjointUnion,
     disjointUnions,
@@ -16,7 +17,7 @@ import Data.Aeson.Key qualified as JK
 import Data.Aeson.KeyMap qualified as JM
 import Data.List (foldl')
 import Data.List.NonEmpty qualified as N
-import Data.Maybe (mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Text qualified as T
 import Exception (DuplicateField (DuplicateField))
 import Field qualified as F
@@ -48,18 +49,19 @@ lookup' (k : ks) (J.Object kvs) =
 
 type Records a = [Record a]
 
+lookups :: F.Field -> Records J.Value -> Maybe J.Value
+lookups f rs =
+  case mapMaybe (lookup f) rs of
+    [] -> Nothing
+    [v] -> Just v
+    (_ : _) -> throw (DuplicateField (F.toString f))
+
 select :: [F.Field] -> Records J.Value -> J.Value
 select fs rs =
   foldl'
     union
     (J.Object JM.empty)
-    (map (\f -> F.prefix f (select' rs f)) fs)
-
-select' :: Records J.Value -> F.Field -> J.Value
-select' rs f = case mapMaybe (lookup f) rs of
-  [] -> J.Null
-  [v] -> v
-  (_ : _) -> throw (DuplicateField (F.toString f))
+    (map (\f -> F.prefix f ((fromMaybe J.Null (lookups f rs)))) fs)
 
 union :: J.Value -> J.Value -> J.Value
 union (J.Object r) (J.Object s) = J.Object (JM.unionWith union r s)
-- 
cgit v1.2.3