diff options
| -rw-r--r-- | src/Store/Query.hs | 41 |
1 files changed, 20 insertions, 21 deletions
diff --git a/src/Store/Query.hs b/src/Store/Query.hs index 49fa4fb..2b86c82 100644 --- a/src/Store/Query.hs +++ b/src/Store/Query.hs @@ -26,7 +26,7 @@ import System.FilePath ((</>)) query :: Query -> S.StoreM [J.Value] query (Delete c w) = do c' <- - mapM (\fn -> fmap ((fn,) . fromValue c) . decodeFile $ fn) + mapM (\fn -> fmap ((fn,) . fromValue c) . decodeFile c $ fn) . map (c </>) =<< S.listFiles c let fps = map fst $ whereBy snd w (map (second (: [])) c') @@ -35,29 +35,24 @@ query (Delete c w) = do S.commit pure [] query (Insert vs c) = do - let vs' = map (\v -> (fileName v, v)) vs + let vs' = map (\v -> ((c, fileName v), v)) vs fileName v@(J.Object kvs) = case JM.lookup "$fileName" kvs of Just (J.String fileName) -> c </> T.unpack fileName _ -> throw (MissingFileName v) - mapM_ (\(fp, v) -> encodeFile fp v) vs' + mapM_ (\((c, fn), v) -> encodeFile c fn v) vs' S.commit pure [] query (Select fs c js es w) = do c' <- - mapM - ( \fn -> - fromValue c - . union (J.Object (JM.singleton "$fileName" (J.String (T.pack fn)))) - <$> decodeFile (c </> fn) - ) + mapM (\fn -> fromValue c <$> decodeFile c fn) =<< S.listFiles c js' <- mapM ( \(JoinClause t c w) -> fmap (\j' -> JoinClause t (map (fromValue c) j') w) - . mapM (decodeFile . (c </>)) + . mapM (decodeFile c) =<< S.listFiles c ) js @@ -65,20 +60,19 @@ query (Select fs c js es w) = do mapM ( \(EmbedClause c w) -> fmap (\e' -> EmbedClause (fromValue c e') w) - . mapM (decodeFile . (c </>)) + . mapM (decodeFile c) =<< S.listFiles c ) es pure $ map (Store.Query.select fs) $ where_ w $ embeds es' $ joins js' c' query (Update c v w) = do c' <- - mapM (\fn -> fmap ((fn,) . fromValue c) . decodeFile $ fn) - . map (c </>) + mapM (\fn -> fmap (((c, fn),) . fromValue c) . decodeFile c $ fn) =<< S.listFiles c let c'' = whereBy snd w (map (second (: [])) c') mapM_ - ( \(fp, v') -> - encodeFile fp (foldl1' union (map toValue v') `union` v) + ( \((c, fn), v') -> + encodeFile c fn (foldl1' union (map toValue v') `union` v) ) c'' S.commit @@ -171,10 +165,15 @@ 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 = either Just (flip lookups vs) f == either Just (flip lookups vs) g -decodeFile :: (J.FromJSON a) => Collection -> S.StoreM a -decodeFile fp = - fromMaybe (throw DecodeException) . J.decode <$> S.readFile fp +decodeFile :: String -> String -> S.StoreM J.Value +decodeFile c fn = do + let fp = c </> fn + union (J.Object (JM.singleton "$fileName" (J.String (T.pack fn)))) + . fromMaybe (throw DecodeException) + . J.decode + <$> S.readFile fp -encodeFile :: Collection -> J.Value -> S.StoreM () -encodeFile fp v = - S.writeFile fp (J.encode v) +encodeFile :: String -> String -> J.Value -> S.StoreM () +encodeFile c fn (J.Object kvs) = do + let fp = c </> fn + S.writeFile fp (J.encode (J.Object (JM.filterWithKey (\k _ -> k /= "$fileName") kvs))) |