module Sqel.Data.Projection where

import Exon (exon)
import Hasql.Decoders (Row)
import Hasql.Encoders (Params)

import qualified Sqel.Data.PgType as PgType
import Sqel.Data.PgType (PgTable (PgTable))
import Sqel.Data.ProjectionWitness (ProjectionWitness)
import Sqel.Data.Sql (ToSql (toSql), sql)
import Sqel.Data.SqlFragment (From (From), Select (Select))
import qualified Sqel.Data.TableSchema as TableSchema
import Sqel.Data.TableSchema (TableSchema (TableSchema))

data Projection proj table =
  Projection {
    forall proj table. Projection proj table -> PgTable proj
pg :: PgTable proj,
    forall proj table. Projection proj table -> Row proj
decoder :: Row proj,
    forall proj table. Projection proj table -> Params proj
encoder :: Params proj,
    forall proj table. Projection proj table -> TableSchema table
table :: TableSchema table,
    forall proj table.
Projection proj table -> ProjectionWitness proj table
witness :: ProjectionWitness proj table
  }
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall proj table x.
Rep (Projection proj table) x -> Projection proj table
forall proj table x.
Projection proj table -> Rep (Projection proj table) x
$cto :: forall proj table x.
Rep (Projection proj table) x -> Projection proj table
$cfrom :: forall proj table x.
Projection proj table -> Rep (Projection proj table) x
Generic)

instance Show (Projection proj table) where
  showsPrec :: Int -> Projection proj table -> ShowS
showsPrec Int
d Projection {PgTable proj
pg :: PgTable proj
$sel:pg:Projection :: forall proj table. Projection proj table -> PgTable proj
pg} =
    Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) [exon|Projection #{showsPrec 11 pg}|]

instance ToSql (Select (Projection proj table)) where
  toSql :: Select (Projection proj table) -> Sql
toSql (Select Projection {$sel:pg:Projection :: forall proj table. Projection proj table -> PgTable proj
pg = PgTable {TableSelectors
$sel:selectors:PgTable :: forall {k} (a :: k). PgTable a -> TableSelectors
selectors :: TableSelectors
selectors}, $sel:table:Projection :: forall proj table. Projection proj table -> TableSchema table
table = TableSchema {$sel:pg:TableSchema :: forall a. TableSchema a -> PgTable a
pg = PgTable {PgTableName
$sel:name:PgTable :: forall {k} (a :: k). PgTable a -> PgTableName
name :: PgTableName
name}}}) =
    [sql|##{Select selectors} ##{From name}|]