aboutsummaryrefslogtreecommitdiffstats
path: root/src/Store/Query/Printer.hs
blob: 5692ba8defcf688f922a76a3af96309b8af7e97f (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
{-# 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]