aboutsummaryrefslogtreecommitdiffstats
path: root/src/Store/Query/Printer.hs
blob: ecde378f0d13bbf3571337f68cb5974f5ad10be4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
{-# OPTIONS_GHC -fno-warn-orphans #-}

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 l o) =
    intercalate " " . catMaybes $
      [ Just "SELECT",
        Just (showFieldSelector fs),
        Just "FROM",
        Just (showCollection c),
        showJoinClauses js,
        showEmbedClauses es,
        showWhereClause w,
        showLimitClause l,
        showOffsetClause o
      ]
  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 " " [showArg a, "==", showArg b]
  where
    showArg = either showValue showField

showOffsetClause :: Maybe OffsetClause -> Maybe String
showOffsetClause (Just (Offset n)) = Just (" OFFSET %d" <> show n)
showOffsetClause Nothing = Nothing

showLimitClause :: Maybe LimitClause -> Maybe String
showLimitClause (Just (Limit n)) = Just (" LIMIT %d" <> show n)
showLimitClause Nothing = Nothing

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"