SelectExpr.hs

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 = \case
  SelectExprAtom Where code -> SelectExprAtom Where \ i -> [sql|(#{dollar i} is null or #{code i})|]
  SelectExprList op sub -> SelectExprList op (guardSum <$> sub)
  expr -> 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 _ (Dd _ p DdPrim) =
    case maybeMod p of
      Just Ignore -> SelectExprIgnore
      Nothing -> SelectExprAtom type_ (code "")
    where
      SelectAtom type_ code = getMod @() whereEq p

instance (
    KnownSymbol n,
    GetMod () SelectAtom ps
  ) => ToSelectExpr ('DdK ('SelSymbol n) ps q 'Prim) where
  toSelectExpr pre (Dd _ p DdPrim) =
    SelectExprAtom type_ (code (Selector (Sql (prefixed (dbSymbol @n) pre))))
    where
      SelectAtom type_ code = getMod @() whereEq p

prodSelectExpr ::
  ∀ sel s .
  All ToSelectExpr s =>
  QFragmentPrefix sel =>
  SelW sel ->
  ColumnPrefix ->
  QOp ->
  NP Dd s ->
  SelectExpr
prodSelectExpr sel pre op =
  SelectExprList op . hcollapse . hcmap (Proxy @ToSelectExpr) (K . toSelectExpr (qfragmentPrefix sel pre))

sumSelectExpr ::
  ∀ sel s .
  All ToSelectExpr s =>
  QFragmentPrefix sel =>
  SelW sel ->
  ColumnPrefix ->
  NP Dd s ->
  SelectExpr
sumSelectExpr sel pre =
  SelectExprSum . hcollapse . hcmap (Proxy @ToSelectExpr) (K . toSelectExpr (qfragmentPrefix sel 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 pre = \case
    Dd sel _ (DdComp _ _ DdNest sub) ->
      prodSelectExpr sel pre QAnd sub

instance (
    All ToSelectExpr sub
  ) => ToSelectExpr ('DdK sel p q ('Comp tsel ('Prod con) 'Merge sub)) where
  toSelectExpr pre = \case
    Dd _ _ (DdComp _ _ DdMerge sub) ->
      prodSelectExpr SelWAuto pre QAnd sub

instance (
    All ToSelectExpr sub,
    QFragmentPrefix sel
  ) => ToSelectExpr ('DdK sel p q ('Comp tsel 'Sum 'Nest (IndexColumn name : sub))) where
  toSelectExpr pre = \case
    Dd sel _ (DdComp _ DdSum DdNest (_ :* sub)) ->
      guardSum (sumSelectExpr sel pre sub)