module Sqel.Query.Fragments where

import Data.Composition ((.:))
import qualified Exon
import Exon (exon)

import Sqel.Data.Codec (ColumnName (ColumnName))
import Sqel.Data.Dd (QOp (QAnd, QOr))
import Sqel.Data.FragType (FragType (Where))
import Sqel.Data.Sel (Sel (SelAuto, SelSymbol, SelUnused), SelW (SelWSymbol))
import Sqel.Data.Sql (Sql, sql)
import Sqel.Names (ddName)
import Sqel.Sql.Prepared (dollar)
import Sqel.Text.DbIdentifier (quotedDbId)

parens :: Sql -> Sql
parens :: Sql -> Sql
parens Sql
s =
  [sql|(#{s})|]

joinOp :: QOp -> [Sql] -> Sql
joinOp :: QOp -> [Sql] -> Sql
joinOp =
  Sql -> Sql
parens forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall a (t :: * -> *). (Monoid a, Foldable t) => a -> t a -> a
Exon.intercalate forall b c a. (b -> c) -> (a -> b) -> a -> c
. QOp -> Sql
sep
  where
    sep :: QOp -> Sql
sep = \case
      QOp
QAnd -> Sql
" and "
      QOp
QOr -> Sql
" or "

joinFrag :: QOp -> FragType -> [Sql] -> Sql
joinFrag :: QOp -> FragType -> [Sql] -> Sql
joinFrag QOp
op = \case
  FragType
Where ->
    QOp -> [Sql] -> Sql
joinOp QOp
op
  FragType
_ ->
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
head

guardCon :: Int -> Int -> Sql -> Sql
guardCon :: Int -> Int -> Sql -> Sql
guardCon Int
index Int
con Sql
code =
  [exon|(#{dollar index} = #{show con} and #{code})|]

joinSum :: Int -> FragType -> [Sql] -> Sql
joinSum :: Int -> FragType -> [Sql] -> Sql
joinSum Int
index FragType
Where =
  QOp -> [Sql] -> Sql
joinOp QOp
QOr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Int -> Sql -> Sql
guardCon Int
index)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]
joinSum Int
_  FragType
_ =
  forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
head

data ColumnPrefix =
  NoPrefix
  |
  BasePrefix Text
  |
  TypePrefix Text
  deriving stock (ColumnPrefix -> ColumnPrefix -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnPrefix -> ColumnPrefix -> Bool
$c/= :: ColumnPrefix -> ColumnPrefix -> Bool
== :: ColumnPrefix -> ColumnPrefix -> Bool
$c== :: ColumnPrefix -> ColumnPrefix -> Bool
Eq, Int -> ColumnPrefix -> ShowS
[ColumnPrefix] -> ShowS
ColumnPrefix -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnPrefix] -> ShowS
$cshowList :: [ColumnPrefix] -> ShowS
show :: ColumnPrefix -> String
$cshow :: ColumnPrefix -> String
showsPrec :: Int -> ColumnPrefix -> ShowS
$cshowsPrec :: Int -> ColumnPrefix -> ShowS
Show)

-- TODO this quotes the segments that seem to work fine, while the ones in PgTable don't.
addPrefix ::
  ColumnName ->
  ColumnPrefix ->
  ColumnPrefix
addPrefix :: ColumnName -> ColumnPrefix -> ColumnPrefix
addPrefix (ColumnName Text
segment) = \case
  ColumnPrefix
NoPrefix -> Text -> ColumnPrefix
BasePrefix (Text -> Text
quotedDbId Text
segment)
  BasePrefix Text
name -> Text -> ColumnPrefix
TypePrefix [exon|(#{name}).#{quotedDbId segment}|]
  TypePrefix Text
prefix -> Text -> ColumnPrefix
TypePrefix [exon|#{prefix}.#{quotedDbId segment}|]

prefixed :: Text -> ColumnPrefix -> Text
prefixed :: Text -> ColumnPrefix -> Text
prefixed Text
name = \case
  ColumnPrefix
NoPrefix -> Text -> Text
quotedDbId Text
name
  BasePrefix Text
prefix -> [exon|(#{prefix}).#{quotedDbId name}|]
  TypePrefix Text
prefix -> [exon|#{prefix}.#{quotedDbId name}|]

class QFragmentPrefix sel where
  qfragmentPrefix :: SelW sel -> ColumnPrefix -> ColumnPrefix

instance QFragmentPrefix ('SelSymbol n) where
  qfragmentPrefix :: SelW ('SelSymbol n) -> ColumnPrefix -> ColumnPrefix
qfragmentPrefix (SelWSymbol Proxy name
_) = ColumnName -> ColumnPrefix -> ColumnPrefix
addPrefix (forall (n :: Symbol). KnownSymbol n => ColumnName
ddName @n)

instance QFragmentPrefix 'SelAuto where
  qfragmentPrefix :: SelW 'SelAuto -> ColumnPrefix -> ColumnPrefix
qfragmentPrefix SelW 'SelAuto
_ = forall a. a -> a
id

instance QFragmentPrefix 'SelUnused where
  qfragmentPrefix :: SelW 'SelUnused -> ColumnPrefix -> ColumnPrefix
qfragmentPrefix SelW 'SelUnused
_ = forall a. a -> a
id