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 :: Dd s -> SelectExpr
selectExprUnlessError = forall (query :: DdK).
ToSelectExpr query =>
ColumnPrefix -> Dd query -> SelectExpr
toSelectExpr ColumnPrefix
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 :: Dd query -> SelectExpr
checkedQ = forall k (check :: Maybe k) (s :: DdK).
SelectExprUnlessError check s =>
Dd s -> SelectExpr
selectExprUnlessError @_ @match

compileSelectExpr ::
  SelectExpr ->
  [SelectFragment]
compileSelectExpr :: SelectExpr -> [SelectFragment]
compileSelectExpr SelectExpr
expr =
  forall k a. Map k a -> [a]
Map.elems (forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey FragType -> Sql -> SelectFragment
SelectFragment (forall a b. (a, b) -> b
snd (Int -> SelectExpr -> (Int, Map FragType Sql)
spin Int
1 SelectExpr
expr)))
  where
    spin :: Int -> SelectExpr -> (Int, Map FragType Sql)
    spin :: Int -> SelectExpr -> (Int, Map FragType Sql)
spin Int
i = \case
      SelectExprAtom FragType
tpe Int -> Sql
code -> (Int
i forall a. Num a => a -> a -> a
+ Int
1, [(FragType
tpe, Int -> Sql
code Int
i)])
      SelectExprList QOp
op [SelectExpr]
sub -> forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (QOp -> FragType -> [Sql] -> Sql
joinFrag QOp
op)) (forall {f :: * -> *} {f :: * -> *}.
(Semigroup (f Sql), Applicative f, Traversable f) =>
Int -> f SelectExpr -> (Int, Map FragType (f Sql))
prod Int
i [SelectExpr]
sub)
      SelectExprSum [SelectExpr]
sub -> forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (Int -> FragType -> [Sql] -> Sql
joinSum Int
i)) (forall {f :: * -> *} {f :: * -> *}.
(Semigroup (f Sql), Applicative f, Traversable f) =>
Int -> f SelectExpr -> (Int, Map FragType (f Sql))
prod (Int
i forall a. Num a => a -> a -> a
+ Int
1) [SelectExpr]
sub)
      -- TODO
      SelectExprNot SelectExpr
_ -> forall a. HasCallStack => a
undefined
      SelectExpr
SelectExprIgnore -> (Int
i, forall a. Monoid a => a
mempty)
    prod :: Int -> f SelectExpr -> (Int, Map FragType (f Sql))
prod Int
i f SelectExpr
sub =
      forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure)) (forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Int -> SelectExpr -> (Int, Map FragType Sql)
spin Int
i f SelectExpr
sub)

querySchemaWith ::
  ∀ q query a .
  ReifyCodec Encoder query q =>
  Dd query ->
  SelectExpr ->
  QuerySchema q a
querySchemaWith :: forall {k} q (query :: DdK) (a :: k).
ReifyCodec Encoder query q =>
Dd query -> SelectExpr -> QuerySchema q a
querySchemaWith Dd query
query SelectExpr
expr =
  forall {k} q (a :: k).
[SelectFragment] -> Encoder q -> QuerySchema q a
QuerySchema (SelectExpr -> [SelectFragment]
compileSelectExpr SelectExpr
expr) (forall (b :: * -> *) (s :: DdK) a. ReifyCodec b s a => Dd s -> b a
reifyCodec @Encoder Dd query
query)

unsafeQuerySchema ::
  ∀ q query a .
  ToSelectExpr query =>
  ReifyCodec Encoder query q =>
  Dd query ->
  QuerySchema q a
unsafeQuerySchema :: forall {k} q (query :: DdK) (a :: k).
(ToSelectExpr query, ReifyCodec Encoder query q) =>
Dd query -> QuerySchema q a
unsafeQuerySchema Dd query
query =
  forall {k} q (query :: DdK) (a :: k).
ReifyCodec Encoder query q =>
Dd query -> SelectExpr -> QuerySchema q a
querySchemaWith Dd query
query (forall (query :: DdK).
ToSelectExpr query =>
ColumnPrefix -> Dd query -> SelectExpr
toSelectExpr ColumnPrefix
NoPrefix Dd query
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 :: Dd query -> Dd table -> QuerySchema (DdType query) (DdType table)
checkQuery Dd query
query Dd table
_ =
    forall {k} q (query :: DdK) (a :: k).
ReifyCodec Encoder query q =>
Dd query -> SelectExpr -> QuerySchema q a
querySchemaWith Dd query
query (forall (qs :: DdK) (ts :: DdK).
CheckedQuery qs ts =>
Dd qs -> SelectExpr
checkedQ @query @table Dd query
query)

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

emptyQuery :: Dd EmptyQuery
emptyQuery :: Dd EmptyQuery
emptyQuery =
  forall (sel :: Sel) (mods :: [*]) (s1 :: Struct) a.
SelW sel -> Mods mods -> DdStruct s1 -> Dd ('DdK sel mods a s1)
Dd (forall (name :: Symbol).
KnownSymbol name =>
Proxy name -> SelW ('SelSymbol name)
SelWSymbol forall {k} (t :: k). Proxy t
Proxy) forall (ps :: [*]). (ps ~ NoMods) => Mods ps
NoMods (forall (sel :: TSel) (c :: Comp) (i :: CompInc) (sub :: [DdK]).
TSelW sel
-> DdSort c -> DdInc i -> NP Dd sub -> DdStruct ('Comp sel c i sub)
DdComp forall (sel :: TSel). MkTSel sel => TSelW sel
mkTSel DdSort ('Prod 'Reg)
DdProd DdInc 'Nest
DdNest forall {k} (a :: k -> *). NP a '[]
Nil)

primIdQuery :: Dd ('DdK ('SelSymbol "id") NoMods a 'Prim)
primIdQuery :: forall a. Dd ('DdK ('SelSymbol "id") NoMods a 'Prim)
primIdQuery =
  forall (name :: Symbol) a.
KnownSymbol name =>
Dd ('DdK ('SelSymbol name) NoMods a 'Prim)
primAs @"id"