Query.hs

module Sqel.Query where

import qualified Data.Map.Strict as Map
import Generics.SOP (NP (Nil))
import Sqel.Class.MatchView (MatchQuery)
import Sqel.Data.Codec (Encoder)
import Sqel.Data.Dd (
  Comp (Prod),
  CompInc (Nest),
  Dd (Dd),
  DdInc (DdNest),
  DdK (DdK),
  DdSort (DdProd),
  DdStruct (DdComp),
  DdType,
  ProdType (Reg),
  Struct (Comp, Prim),
  )
import Sqel.Data.FragType (FragType)
import Sqel.Data.Mods (pattern NoMods, NoMods)
import Sqel.Data.QuerySchema (QuerySchema (QuerySchema))
import Sqel.Data.Sel (MkTSel (mkTSel), Sel (SelSymbol), SelPrefix (DefaultPrefix), SelW (SelWSymbol), TSel (TSel))
import Sqel.Data.SelectExpr (
  SelectExpr (SelectExprAtom, SelectExprIgnore, SelectExprList, SelectExprNot, SelectExprSum),
  SelectFragment (SelectFragment),
  )
import Sqel.Data.Sql (Sql)
import Sqel.Prim (primAs)
import Sqel.ReifyCodec (ReifyCodec (reifyCodec))
import Sqel.SOP.Error (Quoted)
import Type.Errors (ErrorMessage)

import Sqel.Query.Fragments (ColumnPrefix (NoPrefix), joinFrag, joinSum)
import Sqel.Query.SelectExpr (ToSelectExpr (toSelectExpr))

class SelectExprUnlessError (check :: Maybe k) (s :: DdK) where
  selectExprUnlessError :: Dd s -> SelectExpr

instance ToSelectExpr s => SelectExprUnlessError 'Nothing s where
  selectExprUnlessError = toSelectExpr NoPrefix

class CheckedQuery (qs :: DdK) (ts :: DdK) where
  checkedQ :: Dd qs -> SelectExpr

-- TODO remove or move to MatchView
type CheckQueryStuck :: ErrorMessage
type CheckQueryStuck =
  "Could not validate query fields since there is not enough type information available." %
  "You are most likely missing a constraint for " <> Quoted "CheckedQuery" <> "."

instance (
    MatchQuery query table match,
    SelectExprUnlessError match query
  ) => CheckedQuery query table where
    checkedQ = selectExprUnlessError @_ @match

compileSelectExpr ::
  SelectExpr ->
  [SelectFragment]
compileSelectExpr expr =
  Map.elems (Map.mapWithKey SelectFragment (snd (spin 1 expr)))
  where
    spin :: Int -> SelectExpr -> (Int, Map FragType Sql)
    spin i = \case
      SelectExprAtom tpe code -> (i + 1, [(tpe, code i)])
      SelectExprList op sub -> second (Map.mapWithKey (joinFrag op)) (prod i sub)
      SelectExprSum sub -> second (Map.mapWithKey (joinSum i)) (prod (i + 1) sub)
      -- TODO
      SelectExprNot _ -> undefined
      SelectExprIgnore -> (i, mempty)
    prod i sub =
      second (Map.unionsWith (<>) . fmap (fmap pure)) (mapAccumL spin i sub)

querySchemaWith ::
  ∀ q query a .
  ReifyCodec Encoder query q =>
  Dd query ->
  SelectExpr ->
  QuerySchema q a
querySchemaWith query expr =
  QuerySchema (compileSelectExpr expr) (reifyCodec @Encoder query)

unsafeQuerySchema ::
  ∀ q query a .
  ToSelectExpr query =>
  ReifyCodec Encoder query q =>
  Dd query ->
  QuerySchema q a
unsafeQuerySchema query =
  querySchemaWith query (toSelectExpr NoPrefix query)

-- TODO CheckFields should be generated by classes with fundeps so that they can be built incrementally and provided
-- separately
-- try this out with QueryPending in bodhi
type CheckQuery :: DdK -> DdK -> Constraint
class CheckQuery query table where
  checkQuery ::
    Dd query ->
    Dd table ->
    QuerySchema (DdType query) (DdType table)

instance (
    CheckedQuery query table,
    ReifyCodec Encoder query (DdType query)
  ) => CheckQuery query table where
  checkQuery query _ =
    querySchemaWith query (checkedQ @query @table query)

type EmptyQuery =
  'DdK ('SelSymbol "") NoMods () ('Comp ('TSel 'DefaultPrefix "") ('Prod 'Reg) 'Nest '[])

emptyQuery :: Dd EmptyQuery
emptyQuery =
  Dd (SelWSymbol Proxy) NoMods (DdComp mkTSel DdProd DdNest Nil)

primIdQuery :: Dd ('DdK ('SelSymbol "id") NoMods a 'Prim)
primIdQuery =
  primAs @"id"