refactor library

1 files changed, 60 insertions, 0 deletions

diff --git a/src/Store/Query/Printer.hs b/src/Store/Query/Printer.hs
new file mode 100644
index 0000000..5692ba8
--- /dev/null
+++ b/src/Store/Query/Printer.hs
@@ -0,0 +1,60 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Store.Query.Printer () where
+
+import Data.List (intercalate)
+import Data.List.NonEmpty qualified as N
+import Data.Maybe (catMaybes, mapMaybe)
+import Store.Query.Field
+import Store.Query.Type
+
+instance Show Query where
+  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 All = "*"
+      showFieldSelector (Only (N.toList -> fs)) =
+        intercalate ", " (map showField fs)
+      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]