1 files changed, 65 insertions, 68 deletions

diff --git a/app/Query.hs b/app/Query.hs
index 8f0eda6..140d0f1 100644
--- a/app/Query.hs
+++ b/app/Query.hs
@@ -8,7 +8,7 @@ import Control.Exception (throw)
 import Data.Aeson qualified as J
 import Data.Aeson.Key qualified as JK
 import Data.Aeson.KeyMap qualified as JM
-import Data.List (isSuffixOf)
+import Data.List (foldl', isSuffixOf)
 import Data.List.NonEmpty qualified as N
 import Data.Maybe (fromMaybe)
 import Data.Vector qualified as V
@@ -38,86 +38,83 @@ query (Select fs c js es w) = do
             =<< ls c
       )
       es
-  pure $ map (Query.select fs) $ where_ w $ embed es' $ join c' js'
+  pure $ map (Query.select fs) $ where_ w $ embeds es' $ joins js' c'
   where
     ls c =
       filter (not . (isSuffixOf "/"))
         <$> S.withStore "." "HEAD" do
           S.listDirectory c
 
--- TODO use fold
-embed ::
+embeds ::
   EmbedClauses (Record [J.Value]) ->
   [Records J.Value] ->
   [Records J.Value]
-embed es vss = embed' vss es
-  where
-    embed' vss [] = vss
-    embed' vss (EmbedClause (Record c es) w : ess) =
-      embed'
-        ( map
-            ( \vs ->
-                let es' :: [J.Value]
-                    es' = filter (\e -> satisfies w (vs ++ [Record c e])) es
-                 in vs
-                      ++ [ Record
-                             c
-                             ( J.Object
-                                 ( JM.singleton
-                                     (JK.fromString c)
-                                     (J.Array (V.fromList es'))
-                                 )
+embeds = flip (foldl' embed)
+
+embed ::
+  [Records J.Value] ->
+  EmbedClause (Record [J.Value]) ->
+  [Records J.Value]
+embed vss (EmbedClause (Record c es) w) =
+  map
+    ( \vs ->
+        vs
+          ++ [ fromValue
+                 c
+                 ( J.Object
+                     ( JM.singleton
+                         (JK.fromString c)
+                         ( J.Array
+                             ( V.fromList
+                                 [ e
+                                   | e <- es,
+                                     satisfies w (vs ++ [Record c e])
+                                 ]
                              )
-                         ]
-            )
-            vss
-        )
-        ess
+                         )
+                     )
+                 )
+             ]
+    )
+    vss
 
--- TODO use fold
-join ::
-  Records J.Value ->
+joins ::
   JoinClauses (Records J.Value) ->
+  [Record J.Value] ->
   [Records J.Value]
-join vs js = join' (map (: []) vs) js
-  where
-    join' vss [] = vss
-    join' vss (JoinClause JoinLeft js w : jss) =
-      join'
-        ( concatMap
-            ( \vs -> case filter (satisfies w) $ map (\j -> vs ++ [j]) js of
-                [] -> [vs]
-                vs' -> vs'
-            )
-            vss
-        )
-        jss
-    join' vss (JoinClause JoinRight js w : jss) =
-      join'
-        ( concatMap
-            ( \j -> case filter (satisfies w) $ map (\vs -> vs ++ [j]) vss of
-                [] -> [[j]]
-                vs' -> vs'
-            )
-            js
-        )
-        jss
-    join' vss (JoinClause JoinFull js w : jss) =
-      join'
-        ( concatMap
-            ( \vs -> case filter (satisfies w) $ map (\j -> vs ++ [j]) js of
-                [] -> [vs]
-                vs' -> vs'
-            )
-            vss
-            ++ concatMap
-              ( \j -> case filter (satisfies w) $ map (\vs -> vs ++ [j]) vss of
-                  [] -> [[j]]
-                  _ -> []
-              )
-              js
-        )
-        jss
+joins js (map (: []) -> vss) = foldl' join vss js
+
+join ::
+  [Records J.Value] ->
+  JoinClause (Records J.Value) ->
+  [Records J.Value]
+join vss (JoinClause JoinLeft js w) =
+  concatMap
+    ( \vs -> case filter (satisfies w) $ map (\j -> vs ++ [j]) js of
+        [] -> [vs]
+        vs' -> vs'
+    )
+    vss
+join vss (JoinClause JoinRight js w) =
+  concatMap
+    ( \j -> case filter (satisfies w) $ map (\vs -> vs ++ [j]) vss of
+        [] -> [[j]]
+        vs' -> vs'
+    )
+    js
+join vss (JoinClause JoinFull js w) =
+  concatMap
+    ( \vs -> case filter (satisfies w) $ map (\j -> vs ++ [j]) js of
+        [] -> [vs]
+        vs' -> vs'
+    )
+    vss
+    ++ concatMap
+      ( \j -> case filter (satisfies w) $ map (\vs -> vs ++ [j]) vss of
+          [] -> [[j]]
+          _ -> []
+      )
+      js
 
 select :: FieldSelector -> Records J.Value -> J.Value
 select All vs = disjointUnions (map toValue vs)