module Sqel.Query.SelectExpr where

import Generics.SOP (All, K (K), NP ((:*)), hcmap, hcollapse)

import Sqel.Class.Mods (GetMod (getMod), MaybeMod (maybeMod))
import Sqel.Data.Dd (
  Comp (Prod, Sum),
  CompInc (Merge, Nest),
  Dd (Dd),
  DdInc (DdMerge, DdNest),
  DdK (DdK),
  DdSort (DdSum),
  DdStruct (DdComp, DdPrim),
  QOp (QAnd),
  Struct (Comp, Prim),
  )
import Sqel.Data.FragType (FragType (Where))
import Sqel.Data.Mods (Ignore (Ignore))
import Sqel.Data.Sel (Sel (SelSymbol, SelUnused), SelW (SelWAuto))
import Sqel.Data.SelectExpr (
  SelectAtom (SelectAtom),
  SelectExpr (SelectExprAtom, SelectExprIgnore, SelectExprList, SelectExprSum),
  )
import Sqel.Data.Selector (Selector (Selector))
import Sqel.Data.Sql (Sql (Sql), sql)
import Sqel.Prim (IndexColumn)
import Sqel.Query.Combinators (whereEq)
import Sqel.Query.Fragments (ColumnPrefix, QFragmentPrefix (qfragmentPrefix), prefixed)
import Sqel.Sql.Prepared (dollar)
import Sqel.Text.DbIdentifier (dbSymbol)

guardSum :: SelectExpr -> SelectExpr
guardSum :: SelectExpr -> SelectExpr
guardSum = \case
  SelectExprAtom FragType
Where Int -> Sql
code -> FragType -> (Int -> Sql) -> SelectExpr
SelectExprAtom FragType
Where \ Int
i -> [sql|(#{dollar i} is null or #{code i})|]
  SelectExprList QOp
op [SelectExpr]
sub -> QOp -> [SelectExpr] -> SelectExpr
SelectExprList QOp
op (SelectExpr -> SelectExpr
guardSum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SelectExpr]
sub)
  SelectExpr
expr -> SelectExpr
expr

class ToSelectExpr query where
  toSelectExpr :: ColumnPrefix -> Dd query -> SelectExpr

-- TODO this creates an invalid fragment, but it seems not to be used
instance (
    GetMod () SelectAtom ps,
    MaybeMod Ignore ps
  ) => ToSelectExpr ('DdK 'SelUnused ps q 'Prim) where
  toSelectExpr :: ColumnPrefix -> Dd ('DdK 'SelUnused ps q 'Prim) -> SelectExpr
toSelectExpr ColumnPrefix
_ (Dd SelW sel
_ Mods mods
p DdStruct s1
DdPrim) =
    case forall p (ps :: [*]). MaybeMod p ps => Mods ps -> Maybe p
maybeMod Mods mods
p of
      Just Ignore
Ignore -> SelectExpr
SelectExprIgnore
      Maybe Ignore
Nothing -> FragType -> (Int -> Sql) -> SelectExpr
SelectExprAtom FragType
type_ (Selector -> Int -> Sql
code Selector
"")
    where
      SelectAtom FragType
type_ Selector -> Int -> Sql
code = forall (c :: Constraint) p (ps :: [*]).
GetMod c p ps =>
(c => p) -> Mods ps -> p
getMod @() SelectAtom
whereEq Mods mods
p

instance (
    KnownSymbol n,
    GetMod () SelectAtom ps
  ) => ToSelectExpr ('DdK ('SelSymbol n) ps q 'Prim) where
  toSelectExpr :: ColumnPrefix -> Dd ('DdK ('SelSymbol n) ps q 'Prim) -> SelectExpr
toSelectExpr ColumnPrefix
pre (Dd SelW sel
_ Mods mods
p DdStruct s1
DdPrim) =
    FragType -> (Int -> Sql) -> SelectExpr
SelectExprAtom FragType
type_ (Selector -> Int -> Sql
code (Sql -> Selector
Selector (Text -> Sql
Sql (Text -> ColumnPrefix -> Text
prefixed (forall (name :: Symbol). KnownSymbol name => Text
dbSymbol @n) ColumnPrefix
pre))))
    where
      SelectAtom FragType
type_ Selector -> Int -> Sql
code = forall (c :: Constraint) p (ps :: [*]).
GetMod c p ps =>
(c => p) -> Mods ps -> p
getMod @() SelectAtom
whereEq Mods mods
p

prodSelectExpr ::
  ∀ sel s .
  All ToSelectExpr s =>
  QFragmentPrefix sel =>
  SelW sel ->
  ColumnPrefix ->
  QOp ->
  NP Dd s ->
  SelectExpr
prodSelectExpr :: forall (sel :: Sel) (s :: [DdK]).
(All ToSelectExpr s, QFragmentPrefix sel) =>
SelW sel -> ColumnPrefix -> QOp -> NP Dd s -> SelectExpr
prodSelectExpr SelW sel
sel ColumnPrefix
pre QOp
op =
  QOp -> [SelectExpr] -> SelectExpr
SelectExprList QOp
op forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy t
Proxy @ToSelectExpr) (forall k a (b :: k). a -> K a b
K forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (query :: DdK).
ToSelectExpr query =>
ColumnPrefix -> Dd query -> SelectExpr
toSelectExpr (forall (sel :: Sel).
QFragmentPrefix sel =>
SelW sel -> ColumnPrefix -> ColumnPrefix
qfragmentPrefix SelW sel
sel ColumnPrefix
pre))

sumSelectExpr ::
  ∀ sel s .
  All ToSelectExpr s =>
  QFragmentPrefix sel =>
  SelW sel ->
  ColumnPrefix ->
  NP Dd s ->
  SelectExpr
sumSelectExpr :: forall (sel :: Sel) (s :: [DdK]).
(All ToSelectExpr s, QFragmentPrefix sel) =>
SelW sel -> ColumnPrefix -> NP Dd s -> SelectExpr
sumSelectExpr SelW sel
sel ColumnPrefix
pre =
  [SelectExpr] -> SelectExpr
SelectExprSum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy t
Proxy @ToSelectExpr) (forall k a (b :: k). a -> K a b
K forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (query :: DdK).
ToSelectExpr query =>
ColumnPrefix -> Dd query -> SelectExpr
toSelectExpr (forall (sel :: Sel).
QFragmentPrefix sel =>
SelW sel -> ColumnPrefix -> ColumnPrefix
qfragmentPrefix SelW sel
sel ColumnPrefix
pre))

-- TODO add QOp param lookup
instance (
    All ToSelectExpr sub,
    QFragmentPrefix sel
  ) => ToSelectExpr ('DdK sel p q ('Comp tsel ('Prod con) 'Nest sub)) where
  toSelectExpr :: ColumnPrefix
-> Dd ('DdK sel p q ('Comp tsel ('Prod con) 'Nest sub))
-> SelectExpr
toSelectExpr ColumnPrefix
pre = \case
    Dd SelW sel
sel Mods mods
_ (DdComp TSelW sel
_ DdSort c
_ DdInc i
DdNest NP Dd sub
sub) ->
      forall (sel :: Sel) (s :: [DdK]).
(All ToSelectExpr s, QFragmentPrefix sel) =>
SelW sel -> ColumnPrefix -> QOp -> NP Dd s -> SelectExpr
prodSelectExpr SelW sel
sel ColumnPrefix
pre QOp
QAnd NP Dd sub
sub

instance (
    All ToSelectExpr sub
  ) => ToSelectExpr ('DdK sel p q ('Comp tsel ('Prod con) 'Merge sub)) where
  toSelectExpr :: ColumnPrefix
-> Dd ('DdK sel p q ('Comp tsel ('Prod con) 'Merge sub))
-> SelectExpr
toSelectExpr ColumnPrefix
pre = \case
    Dd SelW sel
_ Mods mods
_ (DdComp TSelW sel
_ DdSort c
_ DdInc i
DdMerge NP Dd sub
sub) ->
      forall (sel :: Sel) (s :: [DdK]).
(All ToSelectExpr s, QFragmentPrefix sel) =>
SelW sel -> ColumnPrefix -> QOp -> NP Dd s -> SelectExpr
prodSelectExpr SelW 'SelAuto
SelWAuto ColumnPrefix
pre QOp
QAnd NP Dd sub
sub

instance (
    All ToSelectExpr sub,
    QFragmentPrefix sel
  ) => ToSelectExpr ('DdK sel p q ('Comp tsel 'Sum 'Nest (IndexColumn name : sub))) where
  toSelectExpr :: ColumnPrefix
-> Dd
     ('DdK sel p q ('Comp tsel 'Sum 'Nest (IndexColumn name : sub)))
-> SelectExpr
toSelectExpr ColumnPrefix
pre = \case
    Dd SelW sel
sel Mods mods
_ (DdComp TSelW sel
_ DdSort c
DdSum DdInc i
DdNest (Dd x
_ :* NP Dd xs
sub)) ->
      SelectExpr -> SelectExpr
guardSum (forall (sel :: Sel) (s :: [DdK]).
(All ToSelectExpr s, QFragmentPrefix sel) =>
SelW sel -> ColumnPrefix -> NP Dd s -> SelectExpr
sumSelectExpr SelW sel
sel ColumnPrefix
pre NP Dd xs
sub)