From 97c299fc60c7bde52b69014f0c85a5c4c73a4889 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Wed, 5 Jun 2024 09:48:57 +0200 Subject: support comparing `$fileName` against literals --- src/Store/Query.hs | 11 ++++++++--- src/Store/Query/Parser.hs | 4 ++-- src/Store/Query/Printer.hs | 4 +++- src/Store/Query/Type.hs | 2 +- 4 files changed, 14 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/src/Store/Query.hs b/src/Store/Query.hs index ccca93f..49fa4fb 100644 --- a/src/Store/Query.hs +++ b/src/Store/Query.hs @@ -46,7 +46,12 @@ query (Insert vs c) = do pure [] query (Select fs c js es w) = do c' <- - mapM (fmap (fromValue c) . decodeFile . (c )) + mapM + ( \fn -> + fromValue c + . union (J.Object (JM.singleton "$fileName" (J.String (T.pack fn)))) + <$> decodeFile (c fn) + ) =<< S.listFiles c js' <- mapM @@ -164,9 +169,9 @@ satisfies :: Maybe WhereClause -> 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 (Eq f g))) vs = lookups f vs == lookups g vs +satisfies (Just (Where (Eq f g))) vs = either Just (flip lookups vs) f == either Just (flip lookups vs) g -decodeFile :: J.FromJSON a => Collection -> S.StoreM a +decodeFile :: (J.FromJSON a) => Collection -> S.StoreM a decodeFile fp = fromMaybe (throw DecodeException) . J.decode <$> S.readFile fp diff --git a/src/Store/Query/Parser.hs b/src/Store/Query/Parser.hs index e16c926..99ddc79 100644 --- a/src/Store/Query/Parser.hs +++ b/src/Store/Query/Parser.hs @@ -114,9 +114,9 @@ instance IsString Query where ] comparison = do - a <- field + a <- P.choice [Left <$> value, Right <$> field] eq - b <- field + b <- P.choice [Left <$> value, Right <$> field] pure $ Eq a b fieldSelector = diff --git a/src/Store/Query/Printer.hs b/src/Store/Query/Printer.hs index 26f4e8b..cff543f 100644 --- a/src/Store/Query/Printer.hs +++ b/src/Store/Query/Printer.hs @@ -102,7 +102,9 @@ showWhereClauseWith wrap (Just (Or ws)) = Just (wrap (intercalate "OR" (mapMaybe showWhereClauseWith _ (Just (Where p)) = Just (showComparison p) showComparison :: Comparison -> String -showComparison (Eq a b) = intercalate " " [showField a, "==", showField b] +showComparison (Eq a b) = intercalate " " [showArg a, "==", showArg b] + where + showArg = either showValue showField showValues :: [J.Value] -> Maybe String showValues [] = Nothing diff --git a/src/Store/Query/Type.hs b/src/Store/Query/Type.hs index 7065267..912d020 100644 --- a/src/Store/Query/Type.hs +++ b/src/Store/Query/Type.hs @@ -62,5 +62,5 @@ data WhereClause deriving (Show) data Comparison - = Eq Field Field + = Eq (Either J.Value Field) (Either J.Value Field) deriving (Show) -- cgit v1.2.3