Syntax.hs

{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
-- TODO: clean up unused top binds
{-# OPTIONS_GHC -Wno-unused-top-binds #-}

module Database.Beam.DuckDB.Syntax
  ( -- * Command
    DuckDBCommandSyntax (..),

    -- * Concrete syntaxes
    DuckDBSelectSyntax (..),
    DuckDBFromSyntax (..),
    DuckDBExpressionSyntax (..),
    DuckDBInsertSyntax (..),
    DuckDBUpdateSyntax (..),
    DuckDBDeleteSyntax (..),
    DuckDBTableNameSyntax (..),
    DuckDBOnConflictSyntax (..),
  )
where

import Data.Bifunctor (second)
import Data.Coerce (coerce)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Scientific (Scientific)
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy
import Data.Time (Day, LocalTime, TimeOfDay, UTCTime)
import Data.Word (Word16, Word32, Word64, Word8)
import Database.Beam.Backend
  ( HasSqlValueSyntax (..),
    IsSql2003EnhancedNumericFunctionsAggregationExpressionSyntax (..),
    IsSql2003EnhancedNumericFunctionsExpressionSyntax (..),
    IsSql2003ExpressionAdvancedOLAPOperationsSyntax (..),
    IsSql2003ExpressionElementaryOLAPOperationsSyntax (..),
    IsSql2003ExpressionSyntax (..),
    IsSql2003FirstValueAndLastValueExpressionSyntax (..),
    IsSql2003LeadAndLagExpressionSyntax (..),
    IsSql2003NthValueExpressionSyntax (..),
    IsSql2003NtileExpressionSyntax (..),
    IsSql2003OrderingElementaryOLAPOperationsSyntax (..),
    IsSql2003WindowFrameBoundSyntax (..),
    IsSql2003WindowFrameBoundsSyntax (..),
    IsSql2003WindowFrameSyntax (..),
    IsSql92AggregationExpressionSyntax (..),
    IsSql92AggregationSetQuantifierSyntax (..),
    IsSql92DataTypeSyntax (..),
    IsSql92DeleteSyntax (..),
    IsSql92ExpressionSyntax (..),
    IsSql92ExtractFieldSyntax (..),
    IsSql92FieldNameSyntax (..),
    IsSql92FromOuterJoinSyntax (..),
    IsSql92FromSyntax (..),
    IsSql92GroupingSyntax (..),
    IsSql92InsertSyntax (..),
    IsSql92InsertValuesSyntax (..),
    IsSql92OrderingSyntax (..),
    IsSql92ProjectionSyntax (..),
    IsSql92QuantifierSyntax (..),
    IsSql92SelectSyntax (..),
    IsSql92SelectTableSyntax (..),
    IsSql92Syntax (..),
    IsSql92TableNameSyntax (..),
    IsSql92TableSourceSyntax (..),
    IsSql92UpdateSyntax (..),
    IsSql99AggregationExpressionSyntax (..),
    IsSql99CommonTableExpressionSelectSyntax (..),
    IsSql99CommonTableExpressionSyntax (..),
    IsSql99ConcatExpressionSyntax (..),
    IsSql99DataTypeSyntax (..),
    IsSql99ExpressionSyntax (..),
    IsSql99FunctionExpressionSyntax (..),
    IsSql99RecursiveCommonTableExpressionSelectSyntax (..),
    SqlNull (..),
  )
import Database.Beam.DuckDB.Syntax.Builder (DuckDBSyntax, commas, emit, emitChar, emitIntegral, emitRealFloat, emitScientific, emitValue, parens, quotedIdentifier, sepBy, spaces)
import Database.Beam.Migrate.Serialization (BeamSerializedDataType)
import Database.DuckDB.Simple (Null (Null))

newtype DuckDBCommandSyntax = DuckDBCommandSyntax {fromDuckDBSyntax :: DuckDBSyntax}

--
instance IsSql92Syntax DuckDBCommandSyntax where
  type Sql92SelectSyntax DuckDBCommandSyntax = DuckDBSelectSyntax
  type Sql92InsertSyntax DuckDBCommandSyntax = DuckDBInsertSyntax
  type Sql92UpdateSyntax DuckDBCommandSyntax = DuckDBUpdateSyntax
  type Sql92DeleteSyntax DuckDBCommandSyntax = DuckDBDeleteSyntax

  selectCmd = DuckDBCommandSyntax . fromDuckDBSelect
  insertCmd = DuckDBCommandSyntax . fromDuckDBInsert
  updateCmd = DuckDBCommandSyntax . fromDuckDBUpdate
  deleteCmd = DuckDBCommandSyntax . fromDuckDBDelete

newtype DuckDBTableNameSyntax = DuckDBTableNameSyntax {fromDuckDBTableName :: DuckDBSyntax}

-- | DuckDB @SELECT@ syntax
newtype DuckDBSelectSyntax = DuckDBSelectSyntax {fromDuckDBSelect :: DuckDBSyntax}

newtype DuckDBSelectTableSyntax = DuckDBSelectTableSyntax {fromDuckDBSelectTable :: DuckDBSyntax}

newtype DuckDBOrderingSyntax = DuckDBOrderingSyntax {fromDuckDBOrdering :: DuckDBSyntax}

newtype DuckDBExpressionSyntax = DuckDBExpressionSyntax {fromDuckDBExpression :: DuckDBSyntax} deriving (Eq)

newtype DuckDBTableSourceSyntax = DuckDBTableSourceSyntax {fromDuckDBTableSource :: DuckDBSyntax}

newtype DuckDBProjectionSyntax = DuckDBProjectionSyntax {fromDuckDBProjection :: DuckDBSyntax}

newtype DuckDBFromSyntax = DuckDBFromSyntax {fromDuckDBFrom :: DuckDBSyntax}

newtype DuckDBValueSyntax = DuckDBValueSyntax {fromDuckDBValue :: DuckDBSyntax}

newtype DuckDBFieldNameSyntax = DuckDBFieldNameSyntax {fromDuckDBFieldName :: DuckDBSyntax}

newtype DuckDBComparisonQuantifierSyntax = DuckDBComparisonQuantifierSyntax {fromDuckDBComparisonQuantifier :: DuckDBSyntax}

data DuckDBDataTypeSyntax = DuckDBDataTypeSyntax
  { duckDBDataType :: DuckDBSyntax,
    duckDBDataTypeSerialized :: BeamSerializedDataType
  }

newtype DuckDBExtractFieldSyntax = DuckDBExtractFieldSyntax {fromDuckDBExtractField :: DuckDBSyntax}

newtype DuckDBGroupingSyntax = DuckDBGroupingSyntax {fromDuckDBGrouping :: DuckDBSyntax}

newtype DuckDBSelectSetQuantifierSyntax = DuckDBSelectSetQuantifierSyntax {fromDuckDBSelectSetQuantifier :: DuckDBSyntax}

newtype DuckDBAggregationSetQuantifierSyntax = DuckDBAggregationSetQuantifierSyntax {fromDuckDBAggregationSetQuantifier :: DuckDBSyntax}

newtype DuckDBCommonTableExpressionSyntax = DuckDBCommonTableExpressionSyntax {fromDuckDBCommonTableExpressionSyntax :: DuckDBSyntax}

newtype DuckDBWindowFrameSyntax = DuckDBWindowFrameSyntax {fromDuckDBWindowFrame :: DuckDBSyntax}

newtype DuckDBWindowFrameBoundsSyntax = DuckDBWindowFrameBoundsSyntax {fromDuckDBWindowFrameBounds :: DuckDBSyntax}

newtype DuckDBWindowFrameBoundSyntax = DuckDBWindowFrameBoundSyntax {fromDuckDBWindowFrameBound :: Text -> DuckDBSyntax}

instance IsSql92AggregationExpressionSyntax DuckDBExpressionSyntax where
  type Sql92AggregationSetQuantifierSyntax DuckDBExpressionSyntax = DuckDBAggregationSetQuantifierSyntax

  countAllE = DuckDBExpressionSyntax (emit "COUNT(*)")
  countE = aggFunc "COUNT"
  avgE = aggFunc "AVG"
  sumE = aggFunc "SUM"
  minE = aggFunc "MIN"
  maxE = aggFunc "MAX"

aggFunc :: Text -> Maybe DuckDBAggregationSetQuantifierSyntax -> DuckDBExpressionSyntax -> DuckDBExpressionSyntax
aggFunc fn q e =
  DuckDBExpressionSyntax $
    emit fn <> emit "(" <> maybe mempty (\qInner -> fromDuckDBAggregationSetQuantifier qInner <> emit " ") q <> fromDuckDBExpression e <> emit ")"

instance IsSql92SelectTableSyntax DuckDBSelectTableSyntax where
  type Sql92SelectTableSelectSyntax DuckDBSelectTableSyntax = DuckDBSelectSyntax
  type Sql92SelectTableExpressionSyntax DuckDBSelectTableSyntax = DuckDBExpressionSyntax
  type Sql92SelectTableProjectionSyntax DuckDBSelectTableSyntax = DuckDBProjectionSyntax
  type Sql92SelectTableFromSyntax DuckDBSelectTableSyntax = DuckDBFromSyntax
  type Sql92SelectTableGroupingSyntax DuckDBSelectTableSyntax = DuckDBGroupingSyntax
  type Sql92SelectTableSetQuantifierSyntax DuckDBSelectTableSyntax = DuckDBAggregationSetQuantifierSyntax

  selectTableStmt setQuantifier proj from where_ grouping having =
    DuckDBSelectTableSyntax $
      mconcat
        [ emit "SELECT ",
          maybe mempty ((<> emit " ") . fromDuckDBAggregationSetQuantifier) setQuantifier,
          fromDuckDBProjection proj,
          maybe mempty ((emit " FROM " <>) . fromDuckDBFrom) from,
          maybe mempty ((emit " WHERE " <>) . fromDuckDBExpression) where_,
          maybe mempty ((emit " GROUP BY " <>) . fromDuckDBGrouping) grouping,
          maybe mempty ((emit " HAVING " <>) . fromDuckDBExpression) having
        ]

  unionTables unionAll = tableOp (if unionAll then "UNION ALL" else "UNION")
  intersectTables intersectAcc = tableOp (if intersectAcc then "INTERSECT ALL" else "INTERSECT")
  exceptTable exceptAll = tableOp (if exceptAll then "EXCEPT ALL" else "EXCEPT")

tableOp :: Text -> DuckDBSelectTableSyntax -> DuckDBSelectTableSyntax -> DuckDBSelectTableSyntax
tableOp op a b =
  DuckDBSelectTableSyntax $
    fromDuckDBSelectTable a <> spaces (emit op) <> fromDuckDBSelectTable b

instance IsSql92QuantifierSyntax DuckDBComparisonQuantifierSyntax where
  quantifyOverAll = DuckDBComparisonQuantifierSyntax (emit "ALL")
  quantifyOverAny = DuckDBComparisonQuantifierSyntax (emit "ANY")

instance IsSql92ExtractFieldSyntax DuckDBExtractFieldSyntax where
  secondsField = DuckDBExtractFieldSyntax (emit "SECOND")
  minutesField = DuckDBExtractFieldSyntax (emit "MINUTE")
  hourField = DuckDBExtractFieldSyntax (emit "HOUR")
  dayField = DuckDBExtractFieldSyntax (emit "DAY")
  weekField = DuckDBExtractFieldSyntax (emit "WEEK")
  monthField = DuckDBExtractFieldSyntax (emit "MONTH")
  yearField = DuckDBExtractFieldSyntax (emit "YEAR")

instance IsSql92AggregationSetQuantifierSyntax DuckDBAggregationSetQuantifierSyntax where
  setQuantifierDistinct = DuckDBAggregationSetQuantifierSyntax $ emit "DISTINCT"
  setQuantifierAll = DuckDBAggregationSetQuantifierSyntax $ emit "ALL"

instance IsSql92AggregationSetQuantifierSyntax DuckDBSelectSetQuantifierSyntax where
  setQuantifierDistinct = DuckDBSelectSetQuantifierSyntax $ emit "DISTINCT"
  setQuantifierAll = DuckDBSelectSetQuantifierSyntax $ emit "ALL"

instance IsSql92GroupingSyntax DuckDBGroupingSyntax where
  type Sql92GroupingExpressionSyntax DuckDBGroupingSyntax = DuckDBExpressionSyntax

  groupByExpressions es =
    DuckDBGroupingSyntax $
      commas (map fromDuckDBExpression es)

instance IsSql92TableNameSyntax DuckDBTableNameSyntax where
  tableName Nothing t = DuckDBTableNameSyntax (quotedIdentifier t)
  tableName (Just s) t = DuckDBTableNameSyntax (quotedIdentifier s <> emit "." <> quotedIdentifier t)

instance IsSql92TableSourceSyntax DuckDBTableSourceSyntax where
  type Sql92TableSourceSelectSyntax DuckDBTableSourceSyntax = DuckDBSelectSyntax
  type Sql92TableSourceExpressionSyntax DuckDBTableSourceSyntax = DuckDBExpressionSyntax
  type Sql92TableSourceTableNameSyntax DuckDBTableSourceSyntax = DuckDBTableNameSyntax

  tableNamed = DuckDBTableSourceSyntax . fromDuckDBTableName
  tableFromSubSelect s = DuckDBTableSourceSyntax $ emit "(" <> fromDuckDBSelect s <> emit ")"
  tableFromValues vss =
    DuckDBTableSourceSyntax . parens $
      emit "VALUES "
        <> commas
          ( map
              (parens . commas . map fromDuckDBExpression)
              vss
          )

instance IsSql92FromSyntax DuckDBFromSyntax where
  type Sql92FromExpressionSyntax DuckDBFromSyntax = DuckDBExpressionSyntax
  type Sql92FromTableSourceSyntax DuckDBFromSyntax = DuckDBTableSourceSyntax

  fromTable tableSrc Nothing = coerce tableSrc
  fromTable tableSrc (Just (nm, colNms)) =
    DuckDBFromSyntax $
      coerce tableSrc
        <> emit " AS "
        <> quotedIdentifier nm
        <> maybe mempty (parens . commas . map quotedIdentifier) colNms

  innerJoin a b Nothing = DuckDBFromSyntax (fromDuckDBFrom a <> emit " CROSS JOIN " <> fromDuckDBFrom b)
  innerJoin a b (Just e) = join "INNER JOIN" a b (Just e)

  leftJoin = join "LEFT JOIN"
  rightJoin = join "RIGHT JOIN"

join :: Text -> DuckDBFromSyntax -> DuckDBFromSyntax -> Maybe DuckDBExpressionSyntax -> DuckDBFromSyntax
join joinType a b Nothing =
  DuckDBFromSyntax $
    fromDuckDBFrom a <> emit (" " <> joinType <> " ") <> fromDuckDBFrom b <> emit " ON TRUE"
join joinType a b (Just on) =
  DuckDBFromSyntax $
    fromDuckDBFrom a
      <> emit (" " <> joinType <> " ")
      <> fromDuckDBFrom b
      <> emit " ON "
      <> fromDuckDBExpression on

instance IsSql92FromOuterJoinSyntax DuckDBFromSyntax where
  outerJoin = join "FULL OUTER JOIN"

instance IsSql92FieldNameSyntax DuckDBFieldNameSyntax where
  qualifiedField a b =
    DuckDBFieldNameSyntax $
      quotedIdentifier a <> emit "." <> quotedIdentifier b
  unqualifiedField = DuckDBFieldNameSyntax . quotedIdentifier

instance IsSql92DataTypeSyntax DuckDBDataTypeSyntax where
  domainType nm =
    DuckDBDataTypeSyntax
      (quotedIdentifier nm)
      (domainType nm)

  charType prec charSet =
    DuckDBDataTypeSyntax
      (emit "CHAR" <> optPrec prec <> optCharSet charSet)
      (charType prec charSet)
  varCharType prec charSet =
    DuckDBDataTypeSyntax
      (emit "VARCHAR" <> optPrec prec <> optCharSet charSet)
      (varCharType prec charSet)
  nationalCharType prec =
    DuckDBDataTypeSyntax
      (emit "NATIONAL CHAR" <> optPrec prec)
      (nationalCharType prec)
  nationalVarCharType prec =
    DuckDBDataTypeSyntax
      (emit "NATIONAL CHARACTER VARYING" <> optPrec prec)
      (nationalVarCharType prec)

  bitType prec =
    DuckDBDataTypeSyntax
      (emit "BIT" <> optPrec prec)
      (bitType prec)
  varBitType prec =
    DuckDBDataTypeSyntax
      (emit "BIT VARYING" <> optPrec prec)
      (varBitType prec)

  numericType prec =
    DuckDBDataTypeSyntax
      (emit "NUMERIC" <> optNumericPrec prec)
      (numericType prec)
  decimalType prec =
    DuckDBDataTypeSyntax
      (emit "DECIMAL" <> optNumericPrec prec)
      (decimalType prec)

  intType = DuckDBDataTypeSyntax (emit "INT") intType
  smallIntType = DuckDBDataTypeSyntax (emit "SMALLINT") smallIntType

  floatType prec =
    DuckDBDataTypeSyntax
      (emit "FLOAT" <> optPrec prec)
      (floatType prec)
  doubleType = DuckDBDataTypeSyntax (emit "DOUBLE PRECISION") doubleType
  realType = DuckDBDataTypeSyntax (emit "REAL") realType
  dateType = DuckDBDataTypeSyntax (emit "DATE") dateType
  timeType prec withTz =
    DuckDBDataTypeSyntax
      (emit "TIME" <> optPrec prec <> if withTz then emit " WITH TIME ZONE" else mempty)
      (timeType prec withTz)
  timestampType prec withTz =
    DuckDBDataTypeSyntax
      (emit "TIMESTAMP" <> optPrec prec <> if withTz then emit " WITH TIME ZONE" else mempty)
      (timestampType prec withTz)

instance IsSql99DataTypeSyntax DuckDBDataTypeSyntax where
  characterLargeObjectType = DuckDBDataTypeSyntax {duckDBDataType = emit "TEXT", duckDBDataTypeSerialized = characterLargeObjectType}
  binaryLargeObjectType = DuckDBDataTypeSyntax {duckDBDataType = emit "BYTEA", duckDBDataTypeSerialized = binaryLargeObjectType}
  booleanType = DuckDBDataTypeSyntax (emit "BOOLEAN") booleanType
  arrayType (DuckDBDataTypeSyntax syntax serialized) sz =
    DuckDBDataTypeSyntax
      (syntax <> emit "[" <> emit (fromString (show sz)) <> emit "]")
      (arrayType serialized sz)
  rowType fields =
    DuckDBDataTypeSyntax
      { duckDBDataType =
          -- Note that DuckDB's support for ROW is effectively STRUCT, as far as I understand
          emit "STRUCT("
            <> sepBy (emit ", ") (map (\(fieldName, DuckDBDataTypeSyntax t _) -> emit fieldName <> emit " " <> t) fields)
            <> emitChar ')',
        duckDBDataTypeSerialized = rowType (map (second duckDBDataTypeSerialized) fields)
      }

optPrec :: Maybe Word -> DuckDBSyntax
optPrec Nothing = mempty
optPrec (Just x) = emit "(" <> emit (fromString (show x)) <> emit ")"

optCharSet :: Maybe Text -> DuckDBSyntax
optCharSet Nothing = mempty
optCharSet (Just cs) = emit " CHARACTER SET " <> emit cs

optNumericPrec :: Maybe (Word, Maybe Word) -> DuckDBSyntax
optNumericPrec Nothing = mempty
optNumericPrec (Just (prec, Nothing)) = optPrec (Just prec)
optNumericPrec (Just (prec, Just dec)) = emit "(" <> emit (fromString (show prec)) <> emit ", " <> emit (fromString (show dec)) <> emit ")"

instance HasSqlValueSyntax DuckDBValueSyntax Int8 where
  sqlValueSyntax i = DuckDBValueSyntax (emitIntegral i)

instance HasSqlValueSyntax DuckDBValueSyntax Int16 where
  sqlValueSyntax i = DuckDBValueSyntax (emitIntegral i)

instance HasSqlValueSyntax DuckDBValueSyntax Int32 where
  sqlValueSyntax i = DuckDBValueSyntax (emitIntegral i)

instance HasSqlValueSyntax DuckDBValueSyntax Int64 where
  sqlValueSyntax i = DuckDBValueSyntax (emitIntegral i)

instance HasSqlValueSyntax DuckDBValueSyntax Word8 where
  sqlValueSyntax i = DuckDBValueSyntax (emitIntegral i)

instance HasSqlValueSyntax DuckDBValueSyntax Word16 where
  sqlValueSyntax i = DuckDBValueSyntax (emitIntegral i)

instance HasSqlValueSyntax DuckDBValueSyntax Word32 where
  sqlValueSyntax i = DuckDBValueSyntax (emitIntegral i)

instance HasSqlValueSyntax DuckDBValueSyntax Word64 where
  sqlValueSyntax i = DuckDBValueSyntax (emitIntegral i)

instance HasSqlValueSyntax DuckDBValueSyntax Float where
  sqlValueSyntax f = DuckDBValueSyntax (emitRealFloat f)

instance HasSqlValueSyntax DuckDBValueSyntax Double where
  sqlValueSyntax f = DuckDBValueSyntax (emitRealFloat f)

instance HasSqlValueSyntax DuckDBValueSyntax Scientific where
  sqlValueSyntax f = DuckDBValueSyntax (emitScientific f)

instance HasSqlValueSyntax DuckDBValueSyntax Bool where
  sqlValueSyntax = DuckDBValueSyntax . emitValue

instance HasSqlValueSyntax DuckDBValueSyntax SqlNull where
  sqlValueSyntax _ = DuckDBValueSyntax (emitValue Null)

instance HasSqlValueSyntax DuckDBValueSyntax String where
  sqlValueSyntax = sqlValueSyntax . Text.pack

instance HasSqlValueSyntax DuckDBValueSyntax Text where
  sqlValueSyntax = DuckDBValueSyntax . emitValue

instance HasSqlValueSyntax DuckDBValueSyntax Lazy.Text where
  sqlValueSyntax = sqlValueSyntax . Lazy.toStrict

instance HasSqlValueSyntax DuckDBValueSyntax Day where
  sqlValueSyntax = DuckDBValueSyntax . emitValue

instance HasSqlValueSyntax DuckDBValueSyntax TimeOfDay where
  sqlValueSyntax = DuckDBValueSyntax . emitValue

instance HasSqlValueSyntax DuckDBValueSyntax LocalTime where
  sqlValueSyntax = DuckDBValueSyntax . emitValue

instance HasSqlValueSyntax DuckDBValueSyntax UTCTime where
  sqlValueSyntax = DuckDBValueSyntax . emitValue

instance (HasSqlValueSyntax DuckDBValueSyntax x) => HasSqlValueSyntax DuckDBValueSyntax (Maybe x) where
  sqlValueSyntax (Just x) = sqlValueSyntax x
  sqlValueSyntax Nothing = sqlValueSyntax SqlNull

instance IsSql92ExpressionSyntax DuckDBExpressionSyntax where
  type Sql92ExpressionValueSyntax DuckDBExpressionSyntax = DuckDBValueSyntax
  type Sql92ExpressionSelectSyntax DuckDBExpressionSyntax = DuckDBSelectSyntax
  type Sql92ExpressionFieldNameSyntax DuckDBExpressionSyntax = DuckDBFieldNameSyntax
  type Sql92ExpressionQuantifierSyntax DuckDBExpressionSyntax = DuckDBComparisonQuantifierSyntax
  type Sql92ExpressionCastTargetSyntax DuckDBExpressionSyntax = DuckDBDataTypeSyntax
  type Sql92ExpressionExtractFieldSyntax DuckDBExpressionSyntax = DuckDBExtractFieldSyntax

  addE = binOp "+"
  subE = binOp "-"
  mulE = binOp "*"
  divE = binOp "/"
  modE = binOp "%"
  orE = binOp "OR"
  andE = binOp "AND"
  likeE = binOp "LIKE"
  overlapsE = binOp "OVERLAPS"

  eqE = compOp "="
  neqE = compOp "<>"
  ltE = compOp "<"
  gtE = compOp ">"
  leE = compOp "<="
  geE = compOp ">="

  negateE = unOp "-"
  notE = unOp "NOT"

  isNotNullE = postFix "IS NOT NULL"
  isNullE = postFix "IS NULL"
  isTrueE = postFix "IS TRUE"
  isFalseE = postFix "IS FALSE"
  isNotTrueE = postFix "IS NOT TRUE"
  isNotFalseE = postFix "IS NOT FALSE"
  isUnknownE = postFix "IS UNKNOWN"
  isNotUnknownE = postFix "IS NOT UNKNOWN"

  existsE select = DuckDBExpressionSyntax (emit "EXISTS " <> parens (fromDuckDBSelect select))
  uniqueE select = DuckDBExpressionSyntax (emit "UNIQUE " <> parens (fromDuckDBSelect select))

  betweenE a b c =
    DuckDBExpressionSyntax
      ( parens (fromDuckDBExpression a)
          <> emit " BETWEEN "
          <> parens (fromDuckDBExpression b)
          <> emit " AND "
          <> parens (fromDuckDBExpression c)
      )

  valueE = DuckDBExpressionSyntax . fromDuckDBValue

  rowE vs = DuckDBExpressionSyntax (parens (commas (map fromDuckDBExpression vs)))
  quantifierListE vs =
    DuckDBExpressionSyntax $
      emit "(VALUES " <> sepBy (emit ", ") (fmap (parens . coerce) vs) <> emit ")"
  fieldE = DuckDBExpressionSyntax . fromDuckDBFieldName

  subqueryE = DuckDBExpressionSyntax . parens . fromDuckDBSelect

  positionE needle haystack =
    DuckDBExpressionSyntax $
      emit "POSITION" <> parens (parens (fromDuckDBExpression needle) <> emit " IN " <> parens (fromDuckDBExpression haystack))
  nullIfE a b =
    DuckDBExpressionSyntax $
      emit "NULLIF" <> parens (fromDuckDBExpression a <> emit ", " <> fromDuckDBExpression b)
  absE x = DuckDBExpressionSyntax (emit "ABS" <> parens (fromDuckDBExpression x))
  bitLengthE x = DuckDBExpressionSyntax (emit "8 * LENGTH" <> parens (emit "CAST" <> parens (parens (fromDuckDBExpression x) <> emit " AS BLOB")))
  charLengthE x = DuckDBExpressionSyntax (emit "LENGTH" <> parens (fromDuckDBExpression x))
  octetLengthE x = DuckDBExpressionSyntax (emit "LENGTH" <> parens (emit "CAST" <> parens (parens (fromDuckDBExpression x) <> emit " AS BLOB")))
  lowerE x = DuckDBExpressionSyntax (emit "LOWER" <> parens (fromDuckDBExpression x))
  upperE x = DuckDBExpressionSyntax (emit "UPPER" <> parens (fromDuckDBExpression x))
  trimE x = DuckDBExpressionSyntax (emit "TRIM" <> parens (fromDuckDBExpression x))
  coalesceE es = DuckDBExpressionSyntax (emit "COALESCE" <> parens (commas (map fromDuckDBExpression es)))
  extractE field from = DuckDBExpressionSyntax (emit "EXTRACT(" <> fromDuckDBExtractField field <> emit " FROM (" <> fromDuckDBExpression from <> emit "))")
  castE e t = DuckDBExpressionSyntax (emit "CAST" <> parens (parens (fromDuckDBExpression e) <> emit " AS " <> duckDBDataType t))
  caseE cases else_ =
    DuckDBExpressionSyntax $
      emit "CASE "
        <> foldMap (\(cond, res) -> emit "WHEN " <> fromDuckDBExpression cond <> emit " THEN " <> fromDuckDBExpression res <> emit " ") cases
        <> emit "ELSE "
        <> fromDuckDBExpression else_
        <> emit " END"

  currentTimestampE = DuckDBExpressionSyntax (emit "CURRENT_TIMESTAMP")

  defaultE = DuckDBExpressionSyntax (emit "DEFAULT")
  inE e es = DuckDBExpressionSyntax (parens (fromDuckDBExpression e) <> emit " IN " <> parens (commas (map fromDuckDBExpression es)))
  inSelectE e sel =
    DuckDBExpressionSyntax (parens (fromDuckDBExpression e) <> emit " IN " <> parens (fromDuckDBSelect sel))

binOp :: Text -> DuckDBExpressionSyntax -> DuckDBExpressionSyntax -> DuckDBExpressionSyntax
binOp op a b =
  DuckDBExpressionSyntax $
    parens (fromDuckDBExpression a) <> emit " " <> emit op <> emit " " <> parens (fromDuckDBExpression b)

compOp ::
  Text ->
  Maybe DuckDBComparisonQuantifierSyntax ->
  DuckDBExpressionSyntax ->
  DuckDBExpressionSyntax ->
  DuckDBExpressionSyntax
compOp op quantifier a b =
  DuckDBExpressionSyntax $
    parens (fromDuckDBExpression a)
      <> emit op
      <> maybe mempty (\q -> emit " " <> fromDuckDBComparisonQuantifier q <> emit " ") quantifier
      <> parens (fromDuckDBExpression b)

unOp, postFix :: Text -> DuckDBExpressionSyntax -> DuckDBExpressionSyntax
unOp op a =
  DuckDBExpressionSyntax (emit op <> parens (fromDuckDBExpression a))
postFix op a =
  DuckDBExpressionSyntax (parens (fromDuckDBExpression a) <> emit " " <> emit op)

instance IsSql92ProjectionSyntax DuckDBProjectionSyntax where
  type Sql92ProjectionExpressionSyntax DuckDBProjectionSyntax = DuckDBExpressionSyntax

  projExprs exprs =
    DuckDBProjectionSyntax $
      commas
        ( map
            ( \(expr, nm) ->
                fromDuckDBExpression expr
                  <> maybe mempty (\nm' -> emit " AS " <> quotedIdentifier nm') nm
            )
            exprs
        )

instance IsSql92OrderingSyntax DuckDBOrderingSyntax where
  type Sql92OrderingExpressionSyntax DuckDBOrderingSyntax = DuckDBExpressionSyntax

  ascOrdering e = DuckDBOrderingSyntax (fromDuckDBExpression e <> emit " ASC")
  descOrdering e = DuckDBOrderingSyntax (fromDuckDBExpression e <> emit " DESC")

instance IsSql2003OrderingElementaryOLAPOperationsSyntax DuckDBOrderingSyntax where
  nullsFirstOrdering o = DuckDBOrderingSyntax $ coerce o <> emit " NULLS FIRST"
  nullsLastOrdering o = DuckDBOrderingSyntax $ coerce o <> emit " NULLS LAST"

instance IsSql92SelectSyntax DuckDBSelectSyntax where
  type Sql92SelectSelectTableSyntax DuckDBSelectSyntax = DuckDBSelectTableSyntax
  type Sql92SelectOrderingSyntax DuckDBSelectSyntax = DuckDBOrderingSyntax

  selectStmt tbl ordering limit offset =
    DuckDBSelectSyntax $
      mconcat
        [ fromDuckDBSelectTable tbl,
          case ordering of
            [] -> mempty
            ordering' -> emit " ORDER BY " <> commas (map coerce ordering'),
          maybe mempty (emit . fromString . (" LIMIT " <>) . show) limit,
          maybe mempty (emit . fromString . (" OFFSET " <>) . show) offset
        ]

-- | DuckDB @ON CONFLICT@ syntax
newtype DuckDBOnConflictSyntax = DuckDBOnConflictSyntax {fromDuckDBOnConflict :: DuckDBSyntax}

-- | SQLite @INSERT@ syntax.
newtype DuckDBInsertSyntax = DuckDBInsertSyntax {fromDuckDBInsert :: DuckDBSyntax}

newtype DuckDBInsertValuesSyntax = DuckDBInsertValuesSyntax {fromDuckDBInsertValues :: DuckDBSyntax}

instance IsSql92InsertSyntax DuckDBInsertSyntax where
  type Sql92InsertTableNameSyntax DuckDBInsertSyntax = DuckDBTableNameSyntax
  type Sql92InsertValuesSyntax DuckDBInsertSyntax = DuckDBInsertValuesSyntax

  insertStmt tblName fields values =
    DuckDBInsertSyntax $
      emit "INSERT INTO "
        <> fromDuckDBTableName tblName
        <> emit "("
        <> commas (map quotedIdentifier fields)
        <> emit ") "
        <> fromDuckDBInsertValues values

instance IsSql92InsertValuesSyntax DuckDBInsertValuesSyntax where
  type Sql92InsertValuesExpressionSyntax DuckDBInsertValuesSyntax = DuckDBExpressionSyntax
  type Sql92InsertValuesSelectSyntax DuckDBInsertValuesSyntax = DuckDBSelectSyntax

  insertSqlExpressions es =
    DuckDBInsertValuesSyntax $
      emit "VALUES "
        <> commas
          ( map
              (\values -> emit "(" <> commas (coerce values) <> emit ")")
              es
          )
  insertFromSql (DuckDBSelectSyntax a) = DuckDBInsertValuesSyntax a

-- | DuckDB @UPDATE@ syntax
newtype DuckDBUpdateSyntax = DuckDBUpdateSyntax {fromDuckDBUpdate :: DuckDBSyntax}

instance IsSql92UpdateSyntax DuckDBUpdateSyntax where
  type Sql92UpdateFieldNameSyntax DuckDBUpdateSyntax = DuckDBFieldNameSyntax
  type Sql92UpdateExpressionSyntax DuckDBUpdateSyntax = DuckDBExpressionSyntax
  type Sql92UpdateTableNameSyntax DuckDBUpdateSyntax = DuckDBTableNameSyntax

  updateStmt tbl fields where_ =
    DuckDBUpdateSyntax $
      emit "UPDATE "
        <> fromDuckDBTableName tbl
        <> ( case fields of
               [] -> mempty
               fs ->
                 emit " SET "
                   <> commas (map (\(field, val) -> fromDuckDBFieldName field <> emit "=" <> fromDuckDBExpression val) fs)
           )
        <> maybe mempty (\whereInner -> emit " WHERE " <> fromDuckDBExpression whereInner) where_

-- | DuckDB @DELETE@ syntax
newtype DuckDBDeleteSyntax = DuckDBDeleteSyntax {fromDuckDBDelete :: DuckDBSyntax}

instance IsSql92DeleteSyntax DuckDBDeleteSyntax where
  type Sql92DeleteExpressionSyntax DuckDBDeleteSyntax = DuckDBExpressionSyntax
  type Sql92DeleteTableNameSyntax DuckDBDeleteSyntax = DuckDBTableNameSyntax

  deleteStmt tbl alias where_ =
    DuckDBDeleteSyntax $
      emit "DELETE FROM "
        <> fromDuckDBTableName tbl
        <> maybe mempty (\alias_ -> emit " AS " <> quotedIdentifier alias_) alias
        <> maybe mempty (\whereInner -> emit " WHERE " <> fromDuckDBExpression whereInner) where_

  deleteSupportsAlias _ = True

instance IsSql99CommonTableExpressionSelectSyntax DuckDBSelectSyntax where
  type Sql99SelectCTESyntax DuckDBSelectSyntax = DuckDBCommonTableExpressionSyntax

  withSyntax ctes (DuckDBSelectSyntax select) =
    DuckDBSelectSyntax $
      emit "WITH "
        <> sepBy (emit ", ") (map fromDuckDBCommonTableExpressionSyntax ctes)
        <> select

instance IsSql99RecursiveCommonTableExpressionSelectSyntax DuckDBSelectSyntax where
  withRecursiveSyntax ctes (DuckDBSelectSyntax select) =
    DuckDBSelectSyntax $
      emit "WITH RECURSIVE "
        <> sepBy (emit ", ") (map fromDuckDBCommonTableExpressionSyntax ctes)
        <> select

instance IsSql99CommonTableExpressionSyntax DuckDBCommonTableExpressionSyntax where
  type Sql99CTESelectSyntax DuckDBCommonTableExpressionSyntax = DuckDBSelectSyntax

  cteSubquerySyntax tbl fields (DuckDBSelectSyntax select) =
    DuckDBCommonTableExpressionSyntax $
      quotedIdentifier tbl
        <> parens (sepBy (emit ",") (map quotedIdentifier fields))
        <> emit " AS "
        <> parens select

instance IsSql99FunctionExpressionSyntax DuckDBExpressionSyntax where
  functionCallE name args =
    DuckDBExpressionSyntax $
      fromDuckDBExpression name
        <> parens (sepBy (emit ", ") (map fromDuckDBExpression args))
  functionNameE nm = DuckDBExpressionSyntax (emit nm)

instance IsSql99ExpressionSyntax DuckDBExpressionSyntax where
  -- The implementation of 'distinctE' is the same as Postgres', but its
  -- use via 'distinct_' creates SQL queries which are not necessarily supported
  distinctE select = DuckDBExpressionSyntax (emit "DISTINCT (" <> fromDuckDBSelect select <> emit ")")

  -- DuckDB doesn't support 'SIMILAR TO' exactly, but rather
  -- provides the 'regexp_matches' function
  similarToE left right =
    DuckDBExpressionSyntax $
      mconcat
        [ emit "regexp_matches(",
          coerce left,
          emit ", ",
          coerce right,
          emitChar ')'
        ]

  instanceFieldE i nm =
    DuckDBExpressionSyntax $
      parens (fromDuckDBExpression i) <> emit "." <> quotedIdentifier nm

  refFieldE i nm =
    DuckDBExpressionSyntax $
      parens (fromDuckDBExpression i) <> emit "->" <> quotedIdentifier nm

instance IsSql99ConcatExpressionSyntax DuckDBExpressionSyntax where
  concatE [] = valueE (sqlValueSyntax ("" :: Text))
  concatE [x] = x
  concatE es =
    DuckDBExpressionSyntax $
      emit "CONCAT"
        <> parens
          ( sepBy
              (emit ", ")
              -- DuckDB's type inference doesn't work reliably inside of CONCAT. I suspect
              -- that this is only for ? parameters for binding.
              -- However, to be extra safe, we cast every element inside the `CONCAT` call
              -- to a VARCHAR
              -- TODO: optimize this to only CAST when the expression is a binding parameter
              (map (\e -> emit "CAST" <> parens (coerce e <> emit " AS VARCHAR")) es)
          )

instance IsSql99AggregationExpressionSyntax DuckDBExpressionSyntax where
  everyE = aggFunc "BOOL_AND" -- DuckDB doesn't implement 'EVERY'

  -- The following two functions are modeled the same way
  -- as for the Postgres backend
  someE = aggFunc "BOOL_OR"
  anyE = aggFunc "BOOL_OR"

instance IsSql2003ExpressionSyntax DuckDBExpressionSyntax where
  type
    Sql2003ExpressionWindowFrameSyntax DuckDBExpressionSyntax =
      DuckDBWindowFrameSyntax

  overE expr frame =
    DuckDBExpressionSyntax $
      fromDuckDBExpression expr <> emit " " <> fromDuckDBWindowFrame frame
  rowNumberE = DuckDBExpressionSyntax $ emit "ROW_NUMBER()"

instance IsSql2003EnhancedNumericFunctionsExpressionSyntax DuckDBExpressionSyntax where
  lnE x = DuckDBExpressionSyntax (emit "LN(" <> fromDuckDBExpression x <> emit ")")
  expE x = DuckDBExpressionSyntax (emit "EXP(" <> fromDuckDBExpression x <> emit ")")
  sqrtE x = DuckDBExpressionSyntax (emit "SQRT(" <> fromDuckDBExpression x <> emit ")")
  ceilE x = DuckDBExpressionSyntax (emit "CEIL(" <> fromDuckDBExpression x <> emit ")")
  floorE x = DuckDBExpressionSyntax (emit "FLOOR(" <> fromDuckDBExpression x <> emit ")")
  powerE x y = DuckDBExpressionSyntax (emit "POWER(" <> fromDuckDBExpression x <> emit ", " <> fromDuckDBExpression y <> emit ")")

instance IsSql2003ExpressionAdvancedOLAPOperationsSyntax DuckDBExpressionSyntax where
  denseRankAggE = DuckDBExpressionSyntax $ emit "DENSE_RANK()"
  percentRankAggE = DuckDBExpressionSyntax $ emit "PERCENT_RANK()"
  cumeDistAggE = DuckDBExpressionSyntax $ emit "CUME_DIST()"

instance IsSql2003ExpressionElementaryOLAPOperationsSyntax DuckDBExpressionSyntax where
  rankAggE = DuckDBExpressionSyntax $ emit "RANK()"
  filterAggE agg f =
    DuckDBExpressionSyntax $
      fromDuckDBExpression agg <> emit " FILTER (WHERE " <> fromDuckDBExpression f <> emit ")"

binAggFunc ::
  Text ->
  Maybe DuckDBAggregationSetQuantifierSyntax ->
  DuckDBExpressionSyntax ->
  DuckDBExpressionSyntax ->
  DuckDBExpressionSyntax
binAggFunc fn q x y =
  DuckDBExpressionSyntax $
    emit fn
      <> emitChar '('
      <> maybe mempty (\inner -> fromDuckDBAggregationSetQuantifier inner <> emitChar ' ') q
      <> fromDuckDBExpression x
      <> emit ", "
      <> fromDuckDBExpression y
      <> emitChar ')'

instance IsSql2003EnhancedNumericFunctionsAggregationExpressionSyntax DuckDBExpressionSyntax where
  stddevPopE = aggFunc "STDDEV_POP"
  stddevSampE = aggFunc "STDDEV_SAMP"
  varPopE = aggFunc "VAR_POP"
  varSampE = aggFunc "VAR_SAMP"

  covarPopE = binAggFunc "COVAR_POP"
  covarSampE = binAggFunc "COVAR_SAMP"
  corrE = binAggFunc "CORR"
  regrSlopeE = binAggFunc "REGR_SLOPE"
  regrInterceptE = binAggFunc "REGR_INTERCEPT"
  regrCountE = binAggFunc "REGR_COUNT"
  regrRSquaredE = binAggFunc "REGR_R2"
  regrAvgXE = binAggFunc "REGR_AVGX"
  regrAvgYE = binAggFunc "REGR_AVGY"
  regrSXXE = binAggFunc "REGR_SXX"
  regrSYYE = binAggFunc "REGR_SYY"
  regrSXYE = binAggFunc "REGR_SXY"

instance IsSql2003NtileExpressionSyntax DuckDBExpressionSyntax where
  ntileE x = DuckDBExpressionSyntax (emit "NTILE(" <> fromDuckDBExpression x <> emit ")")

instance IsSql2003LeadAndLagExpressionSyntax DuckDBExpressionSyntax where
  leadE x Nothing Nothing =
    DuckDBExpressionSyntax (emit "LEAD(" <> fromDuckDBExpression x <> emit ")")
  leadE x (Just n) Nothing =
    DuckDBExpressionSyntax (emit "LEAD(" <> fromDuckDBExpression x <> emit ", " <> fromDuckDBExpression n <> emit ")")
  leadE x (Just n) (Just def) =
    DuckDBExpressionSyntax (emit "LEAD(" <> fromDuckDBExpression x <> emit ", " <> fromDuckDBExpression n <> emit ", " <> fromDuckDBExpression def <> emit ")")
  leadE x Nothing (Just def) =
    DuckDBExpressionSyntax (emit "LEAD(" <> fromDuckDBExpression x <> emit ", 1, " <> fromDuckDBExpression def <> emit ")")

  lagE x Nothing Nothing =
    DuckDBExpressionSyntax (emit "LAG(" <> fromDuckDBExpression x <> emit ")")
  lagE x (Just n) Nothing =
    DuckDBExpressionSyntax (emit "LAG(" <> fromDuckDBExpression x <> emit ", " <> fromDuckDBExpression n <> emit ")")
  lagE x (Just n) (Just def) =
    DuckDBExpressionSyntax (emit "LAG(" <> fromDuckDBExpression x <> emit ", " <> fromDuckDBExpression n <> emit ", " <> fromDuckDBExpression def <> emit ")")
  lagE x Nothing (Just def) =
    DuckDBExpressionSyntax (emit "LAG(" <> fromDuckDBExpression x <> emit ", 1, " <> fromDuckDBExpression def <> emit ")")

instance IsSql2003FirstValueAndLastValueExpressionSyntax DuckDBExpressionSyntax where
  firstValueE x = DuckDBExpressionSyntax (emit "FIRST_VALUE(" <> fromDuckDBExpression x <> emit ")")
  lastValueE x = DuckDBExpressionSyntax (emit "LAST_VALUE(" <> fromDuckDBExpression x <> emit ")")

instance IsSql2003NthValueExpressionSyntax DuckDBExpressionSyntax where
  nthValueE x n = DuckDBExpressionSyntax (emit "NTH_VALUE(" <> fromDuckDBExpression x <> emit ", " <> fromDuckDBExpression n <> emit ")")

instance IsSql2003WindowFrameSyntax DuckDBWindowFrameSyntax where
  type Sql2003WindowFrameExpressionSyntax DuckDBWindowFrameSyntax = DuckDBExpressionSyntax
  type Sql2003WindowFrameOrderingSyntax DuckDBWindowFrameSyntax = DuckDBOrderingSyntax
  type Sql2003WindowFrameBoundsSyntax DuckDBWindowFrameSyntax = DuckDBWindowFrameBoundsSyntax

  frameSyntax partition_ ordering_ bounds_ =
    DuckDBWindowFrameSyntax $
      emit "OVER "
        <> parens
          ( maybe mempty (\p -> emit "PARTITION BY " <> sepBy (emit ", ") (map fromDuckDBExpression p)) partition_
              <> maybe mempty (\o -> emit " ORDER BY " <> sepBy (emit ", ") (map fromDuckDBOrdering o)) ordering_
              <> maybe mempty (\b -> emit " ROWS " <> fromDuckDBWindowFrameBounds b) bounds_
          )

instance IsSql2003WindowFrameBoundsSyntax DuckDBWindowFrameBoundsSyntax where
  type Sql2003WindowFrameBoundsBoundSyntax DuckDBWindowFrameBoundsSyntax = DuckDBWindowFrameBoundSyntax

  fromToBoundSyntax from Nothing =
    DuckDBWindowFrameBoundsSyntax (fromDuckDBWindowFrameBound from "PRECEDING")
  fromToBoundSyntax from (Just to) =
    DuckDBWindowFrameBoundsSyntax $
      emit "BETWEEN " <> fromDuckDBWindowFrameBound from "PRECEDING" <> emit " AND " <> fromDuckDBWindowFrameBound to "FOLLOWING"

instance IsSql2003WindowFrameBoundSyntax DuckDBWindowFrameBoundSyntax where
  unboundedSyntax = DuckDBWindowFrameBoundSyntax $ \where_ -> emit "UNBOUNDED " <> emit where_
  nrowsBoundSyntax 0 = DuckDBWindowFrameBoundSyntax $ \_ -> emit "CURRENT ROW"
  nrowsBoundSyntax n = DuckDBWindowFrameBoundSyntax $ \where_ -> emit (fromString (show n)) <> emit " " <> emit where_