diff options
Diffstat (limited to 'src/Store/Query/Printer.hs')
-rw-r--r-- | src/Store/Query/Printer.hs | 157 |
1 files changed, 111 insertions, 46 deletions
diff --git a/src/Store/Query/Printer.hs b/src/Store/Query/Printer.hs index 7861bc9..26f4e8b 100644 --- a/src/Store/Query/Printer.hs +++ b/src/Store/Query/Printer.hs @@ -2,56 +2,121 @@ module Store.Query.Printer () where +import Data.Aeson qualified as J +import Data.Aeson.Key qualified as JK +import Data.Aeson.KeyMap qualified as JM import Data.List (intercalate) import Data.Maybe (catMaybes, mapMaybe) +import Data.Text qualified as T +import Data.Vector qualified as V import Store.Query.Field import Store.Query.Type instance Show Query where + show (Delete c w) = + intercalate " " . catMaybes $ + [ Just "DELETE FROM ", + Just (showCollection c), + showWhereClause w + ] + show (Insert vs c) = + intercalate " " . catMaybes $ + [ Just "INSERT", + showValues vs, + Just "INTO", + Just (showCollection c) + ] show (Select fs c js es w) = - intercalate " " $ - catMaybes $ - [ Just "SELECT", - Just (showFieldSelector fs), - Just "FROM", - Just (showCollection c), - showJoinClauses js, - showEmbedClauses es, - showWhereClause w - ] - where - showFieldSelector = error "showFieldSelector" - showField = Store.Query.Field.toString - showCollection c = c - showJoinClauses js = case map showJoinClause js of - [] -> Nothing - xs -> Just (intercalate " " xs) - showJoinClause (JoinClause t c w) = - intercalate " " $ - catMaybes $ - [ Just (showJoinType t), - Just (showCollection c), - Just "ON", - showWhereClause w - ] - 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 - showWhereClauseWith wrap (Just (And ws)) = Just (wrap (intercalate "AND" (mapMaybe (showWhereClause' . Just) ws))) - showWhereClauseWith wrap (Just (Or ws)) = Just (wrap (intercalate "OR" (mapMaybe (showWhereClause' . Just) ws))) - showWhereClauseWith _ (Just (Where p)) = Just (showComparison p) - showComparison (Eq a b) = intercalate " " [showField a, "==", showField b] + intercalate " " . catMaybes $ + [ Just "SELECT", + Just (showFieldSelector fs), + Just "FROM", + Just (showCollection c), + showJoinClauses js, + showEmbedClauses es, + showWhereClause w + ] + show (Update c v w) = + intercalate " " . catMaybes $ + [ Just "UPDATE", + Just (showCollection c), + Just "SET", + Just (showValue v), + showWhereClause w + ] + +showFieldSelector :: FieldSelector -> String +showFieldSelector = error "showFieldSelector" + +showField :: Field -> String +showField = Store.Query.Field.toString + +showCollection :: Collection -> String +showCollection c = c + +showJoinClauses :: [JoinClause String] -> Maybe String +showJoinClauses js = case map showJoinClause js of + [] -> Nothing + xs -> Just (intercalate " " xs) + +showJoinClause :: JoinClause String -> String +showJoinClause (JoinClause t c w) = + intercalate " " $ + catMaybes $ + [ Just (showJoinType t), + Just (showCollection c), + Just "ON", + showWhereClause w + ] + +showJoinType :: JoinType -> String +showJoinType JoinLeft = "LEFT JOIN" +showJoinType JoinRight = "RIGHT JOIN" +showJoinType JoinFull = "FULL JOIN" + +showEmbedClauses :: [EmbedClause String] -> Maybe String +showEmbedClauses js = case map showEmbedClause js of + [] -> Nothing + xs -> Just (intercalate " " xs) + +showEmbedClause :: EmbedClause String -> String +showEmbedClause (EmbedClause c w) = + intercalate " " $ + catMaybes $ + [ Just "EMBED", + Just (showCollection c), + Just "ON", + showWhereClause w + ] + +showWhereClause :: Maybe WhereClause -> Maybe String +showWhereClause = showWhereClauseWith id + +showWhereClause' :: Maybe WhereClause -> Maybe String +showWhereClause' = showWhereClauseWith (\x -> "(" <> x <> ")") + +showWhereClauseWith :: (String -> String) -> Maybe WhereClause -> Maybe String +showWhereClauseWith _ Nothing = Nothing +showWhereClauseWith wrap (Just (And ws)) = Just (wrap (intercalate "AND" (mapMaybe (showWhereClause' . Just) ws))) +showWhereClauseWith wrap (Just (Or ws)) = Just (wrap (intercalate "OR" (mapMaybe (showWhereClause' . Just) ws))) +showWhereClauseWith _ (Just (Where p)) = Just (showComparison p) + +showComparison :: Comparison -> String +showComparison (Eq a b) = intercalate " " [showField a, "==", showField b] + +showValues :: [J.Value] -> Maybe String +showValues [] = Nothing +showValues vs = Just (intercalate ", " (map showValue vs)) + +showValue :: J.Value -> String +showValue (J.Object kvs) = + intercalate + ",\n" + (map (\(k, v) -> "\"" <> JK.toString k <> "\" : " <> showValue v) (JM.toList kvs)) +showValue (J.Array (V.toList -> vs)) = + "[" <> intercalate ", " (map showValue vs) <> "]" +showValue (J.String c) = "\"" <> T.unpack c <> "\"" +showValue (J.Number c) = show c +showValue (J.Bool True) = "true" +showValue (J.Bool False) = "false" +showValue J.Null = "null" |