1 files changed, 70 insertions, 5 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 342162e..23f2c9e 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -16,6 +16,7 @@ import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
 import Data.Set qualified as S
 import Data.String (IsString (fromString))
 import Data.Text qualified as T
+import Data.Vector qualified as V
 import Data.Void (Void)
 import Store qualified as S
 import System.Directory (setCurrentDirectory)
@@ -38,7 +39,8 @@ main = do
       "SELECT * FROM j",
       "SELECT c.id, j.id, is_j FROM c LEFT JOIN j ON j.id == c.j_id",
       "SELECT c.id, j.id FROM c RIGHT JOIN j ON j.id == c.j_id",
-      "SELECT c.id, j.id FROM c FULL JOIN j ON j.id == c.j_id"
+      "SELECT c.id, j.id FROM c FULL JOIN j ON j.id == c.j_id",
+      "SELECT c.id, j FROM c EMBED j ON j.id == c.j_id"
     ]
 
 data Query
@@ -46,10 +48,11 @@ data Query
       FieldSelector
       Collection
       (JoinClauses FilePath)
+      (EmbedClauses FilePath)
       (Maybe WhereClause)
 
 instance Show Query where
-  show (Select fs c js w) =
+  show (Select fs c js es w) =
     intercalate " " $
       catMaybes $
         [ Just "SELECT",
@@ -57,6 +60,7 @@ instance Show Query where
           Just "FROM",
           Just (showCollection c),
           showJoinClauses js,
+          showEmbedClauses es,
           showWhereClause w
         ]
     where
@@ -79,6 +83,17 @@ instance Show Query where
       showJoinType JoinLeft = "LEFT JOIN"
       showJoinType JoinRight = "RIGHT JOIN"
       showJoinType JoinFull = "FULL JOIN"
+      showEmbedClauses js = case map showEmbedClause js of
+        [] -> Nothing
+        xs -> Just (intercalate " " xs)
+      showEmbedClause (EmbedClause c w) =
+        intercalate " " $
+          catMaybes $
+            [ Just "EMBED",
+              Just (showCollection c),
+              Just "ON",
+              showWhereClause w
+            ]
       showWhereClause = showWhereClauseWith id
       showWhereClause' = showWhereClauseWith (\x -> "(" <> x <> ")")
       showWhereClauseWith _ Nothing = Nothing
@@ -111,6 +126,12 @@ data JoinType
   | JoinFull
   deriving (Show)
 
+type EmbedClauses a = [EmbedClause a]
+
+data EmbedClause a
+  = EmbedClause a (Maybe WhereClause)
+  deriving (Show)
+
 data WhereClause
   = And [WhereClause]
   | Or [WhereClause]
@@ -142,17 +163,19 @@ instance IsString Query where
         from
         c <- collection
         js <- joinClauses
+        es <- embedClauses
         w <- P.optional do
           where_
           whereClause
         P.eof
-        pure $ Select fs c js w
+        pure $ Select fs c js es w
 
       lexeme :: P.Parsec Void String a -> P.Parsec Void String a
       lexeme = P.lexeme $ void $ P.takeWhileP Nothing isSpace
 
       and = void $ lexeme (P.string "AND")
       comma = void $ lexeme (P.string ",")
+      embed = void $ lexeme (P.string "EMBED")
       eq = void $ lexeme (P.string "==")
       from = void $ lexeme (P.string "FROM")
       on = void $ lexeme (P.string "ON")
@@ -172,6 +195,16 @@ instance IsString Query where
           whereClause
         pure $ JoinClause t c w
 
+      embedClauses = P.many embedClause
+
+      embedClause = do
+        embed
+        c <- collection
+        w <- P.optional do
+          on
+          whereClause
+        pure $ EmbedClause c w
+
       whereClause =
         P.choice
           [ P.try (And . map Where <$> P.sepBy1 comparison and),
@@ -224,7 +257,7 @@ instance IsString Query where
           ]
 
 query :: Query -> IO [J.Value]
-query (Select fs c js w) = do
+query (Select fs c js es w) = do
   c' <-
     mapM (fmap (Record c) . decodeFile . (c </>)) =<< ls c
   js' <-
@@ -234,13 +267,45 @@ query (Select fs c js w) = do
             =<< ls c
       )
       js
-  pure $ map (select fs) $ where_ w $ combine c' js'
+  es' <-
+    mapM
+      ( \(EmbedClause c w) ->
+          fmap (\e' -> EmbedClause (Record c e') w) . mapM (decodeFile . (c </>))
+            =<< ls c
+      )
+      es
+  pure $ map (select fs) $ where_ w $ embed es' $ combine c' js'
   where
     ls c =
       filter (not . (isSuffixOf "/"))
         <$> S.withStore "." "HEAD" do
           S.listDirectory c
 
+embed :: EmbedClauses (Record [J.Value]) -> [[Record J.Value]] -> [[Record 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'))
+                                 )
+                             )
+                         ]
+            )
+            vss
+        )
+        ess
+
 combine :: [Record J.Value] -> JoinClauses [Record J.Value] -> [[Record J.Value]]
 combine vs js = combine' (map (: []) vs) js
   where