aboutsummaryrefslogtreecommitdiffstats
path: root/src/Store/Query/Printer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Store/Query/Printer.hs')
-rw-r--r--src/Store/Query/Printer.hs157
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"