diff options
| -rw-r--r-- | app/Main.hs | 75 | ||||
| -rw-r--r-- | json2sql.cabal | 3 |
2 files changed, 72 insertions, 6 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 diff --git a/json2sql.cabal b/json2sql.cabal index fdd0aac..3a39f88 100644 --- a/json2sql.cabal +++ b/json2sql.cabal @@ -38,6 +38,7 @@ executable json2sql unliftio, unliftio-core, unordered-containers, - utf8-string + utf8-string, + vector hs-source-dirs: app default-language: GHC2021 |