content: {-|
  Module: IHP.DataSync.DynamicQueryCompiler
  Description: Compiles a DynamicQuery to SQL
  Copyright: (c) digitally induced GmbH, 2021
  -}
  module IHP.DataSync.DynamicQueryCompiler where
  
  import IHP.Prelude
  import IHP.DataSync.DynamicQuery
  import qualified IHP.QueryBuilder as QueryBuilder
  import qualified Database.PostgreSQL.Simple as PG
  import qualified Database.PostgreSQL.Simple.ToField as PG
  import qualified Database.PostgreSQL.Simple.Types as PG
  import qualified Data.List as List
  
  data Renamer = Renamer
      { fieldToColumn :: Text -> Text
      , columnToField :: Text -> Text
      }
  
  compileQuery :: DynamicSQLQuery -> (PG.Query, [PG.Action])
  compileQuery = compileQueryWithRenamer camelCaseRenamer
  
  compileQueryWithRenamer :: Renamer -> DynamicSQLQuery -> (PG.Query, [PG.Action])
  compileQueryWithRenamer renamer query = compileQueryMapped (mapColumnNames renamer.fieldToColumn query)
  
  -- | Default renamer used by DataSync.
  --
  -- Transforms JS inputs in @camelCase@ to snake_case for the database
  -- and DB outputs in @snake_case@ back to @camelCase@
  camelCaseRenamer :: Renamer
  camelCaseRenamer =
      Renamer
      { fieldToColumn = fieldNameToColumnName
      , columnToField = columnNameToFieldName
      }
  
  -- | Renamer that does not modify the column names
  unmodifiedRenamer :: Renamer
  unmodifiedRenamer =
      Renamer
      { fieldToColumn = id
      , columnToField = id
      }
  
  -- | When a Field is retrieved from the database, it's all in @snake_case@. This turns it into @camelCase@
  renameField :: Renamer -> Field -> Field
  renameField renamer field =
      field { fieldName = renamer.columnToField field.fieldName }
  
  compileQueryMapped :: DynamicSQLQuery -> (PG.Query, [PG.Action])
  compileQueryMapped DynamicSQLQuery { .. } = (sql, args)
      where
          sql = "SELECT" <> distinctOnSql <> "? FROM ?" <> whereSql <> orderBySql <> limitSql <> offsetSql
          args = distinctOnArgs
                  <> catMaybes
                      [ Just (compileSelectedColumns selectedColumns)
                      , Just (PG.toField (PG.Identifier table))
                      ]
                  <> whereArgs
                  <> orderByArgs
                  <> limitArgs
                  <> offsetArgs
  
          (distinctOnSql, distinctOnArgs) = case distinctOnColumn of
              Just column -> (" DISTINCT ON (?) ", [PG.toField $ PG.Identifier (cs column)])
              Nothing     -> (" ", [])
  
          (orderBySql, orderByArgs) = case orderByClause of
                  [] -> ("", [])
                  orderByClauses ->
                      ( PG.Query $ cs $ " ORDER BY " <> (intercalate ", " (map compileOrderByClause orderByClauses))
                      , orderByClauses
                          |> map (\case
                              OrderByClause { orderByColumn, orderByDirection } ->
                                      [ PG.toField $ PG.Identifier (cs orderByColumn)
                                      , PG.toField $ if orderByDirection == QueryBuilder.Desc
                                          then PG.Plain "DESC"
                                          else PG.Plain ""
                                      ]
                              OrderByTSRank { tsvector, tsquery } ->
                                      [ PG.toField $ PG.Identifier tsvector
                                      , PG.toField tsquery
                                      ]
                          )
                          |> concat
                      )
  
          (whereSql, whereArgs) = case compileCondition <$> whereCondition of
              Just (sql, args) -> (" WHERE " <> sql, args)
              Nothing -> ("", [])
  
          (limitSql, limitArgs) = case limit of
                  Just limit -> (" LIMIT ?", [PG.toField limit])
                  Nothing -> ("", [])
  
          (offsetSql, offsetArgs) = case offset of
                  Just offset -> (" OFFSET ?", [PG.toField offset])
                  Nothing -> ("", [])
  
  -- | Used to transform column names from @camelCase@ to @snake_case@
  mapColumnNames :: (Text -> Text) -> DynamicSQLQuery -> DynamicSQLQuery
  mapColumnNames rename query =
      query
      { selectedColumns = mapSelectedColumns query.selectedColumns
      , whereCondition = mapConditionExpression <$> query.whereCondition
      , orderByClause = map mapOrderByClause query.orderByClause
      , distinctOnColumn = (cs . rename . cs) <$> query.distinctOnColumn
      }
      where
          mapSelectedColumns :: SelectedColumns -> SelectedColumns
          mapSelectedColumns SelectAll = SelectAll
          mapSelectedColumns (SelectSpecific columns) = SelectSpecific (map rename columns)
  
          mapConditionExpression :: ConditionExpression -> ConditionExpression
          mapConditionExpression ColumnExpression { field } = ColumnExpression { field = rename field }
          mapConditionExpression InfixOperatorExpression { left, op, right } = InfixOperatorExpression { left = mapConditionExpression left, op, right = mapConditionExpression right }
          mapConditionExpression otherwise = otherwise
  
          mapOrderByClause :: OrderByClause -> OrderByClause
          mapOrderByClause OrderByClause { orderByColumn, orderByDirection } = OrderByClause { orderByColumn = cs (rename (cs orderByColumn)), orderByDirection }
          mapOrderByClause otherwise = otherwise
  
  compileOrderByClause :: OrderByClause -> Text
  compileOrderByClause OrderByClause {} = "? ?"
  compileOrderByClause OrderByTSRank { tsvector, tsquery } = "ts_rank(?, to_tsquery('english', ?))"
  
  compileSelectedColumns :: SelectedColumns -> PG.Action
  compileSelectedColumns SelectAll = PG.Plain "*"
  compileSelectedColumns (SelectSpecific fields) = PG.Many args
      where
          args :: [PG.Action]
          args = List.intercalate ([PG.Plain ", "]) fieldActions
          fieldActions :: [[PG.Action]]
          fieldActions = (map (\field -> [ PG.toField (PG.Identifier field) ]) fields)
  
  -- TODO: validate query against schema
  
  compileCondition :: ConditionExpression -> (PG.Query, [PG.Action])
  compileCondition (ColumnExpression column) = ("?", [PG.toField $ PG.Identifier column])
  compileCondition (InfixOperatorExpression a OpEqual (LiteralExpression Null)) = compileCondition (InfixOperatorExpression a OpIs (LiteralExpression Null)) -- Turn 'a = NULL' into 'a IS NULL'
  compileCondition (InfixOperatorExpression a OpNotEqual (LiteralExpression Null)) = compileCondition (InfixOperatorExpression a OpIsNot (LiteralExpression Null)) -- Turn 'a <> NULL' into 'a IS NOT NULL'
  compileCondition (InfixOperatorExpression a OpIn (ListExpression { values })) | (Null `List.elem` values) =
      -- Turn 'a IN (NULL)' into 'a IS NULL'
      case partition ((/=) Null) values of
          ([], nullValues) -> compileCondition (InfixOperatorExpression a OpIs (LiteralExpression Null))
          (nonNullValues, nullValues) -> compileCondition (InfixOperatorExpression (InfixOperatorExpression a OpIn (ListExpression { values = nonNullValues })) OpOr (InfixOperatorExpression a OpIs (LiteralExpression Null)))
  compileCondition (InfixOperatorExpression a operator b) = ("(" <> queryA <> ") " <> compileOperator operator <> " " <> rightOperand, paramsA <> paramsB)
      where
          (queryA, paramsA) = compileCondition a
          (queryB, paramsB) = compileCondition b
  
          rightOperand = if rightParentheses
                  then "(" <>  queryB <> ")"
                  else queryB
  
          rightParentheses :: Bool
          rightParentheses =
              case b of
                  LiteralExpression Null -> False
                  ListExpression {} -> False -- The () are inserted already via @PG.In@
                  _ -> True
  compileCondition (LiteralExpression literal) = ("?", [PG.toField literal])
  compileCondition (CallExpression { functionCall = ToTSQuery { text } }) = ("to_tsquery('english', ?)", [PG.toField text])
  compileCondition (ListExpression { values }) = ("?", [PG.toField (PG.In values)])
  
  compileOperator :: ConditionOperator -> PG.Query
  compileOperator OpEqual = "="
  compileOperator OpGreaterThan = ">"
  compileOperator OpLessThan = "<"
  compileOperator OpGreaterThanOrEqual = ">="
  compileOperator OpLessThanOrEqual = "<="
  compileOperator OpNotEqual = "<>"
  compileOperator OpAnd = "AND"
  compileOperator OpOr = "OR"
  compileOperator OpIs = "IS"
  compileOperator OpIsNot = "IS NOT"
  compileOperator OpTSMatch = "@@"
  compileOperator OpIn = "IN"
  
  instance PG.ToField DynamicValue where
      toField (IntValue int) = PG.toField int
      toField (DoubleValue double) = PG.toField double
      toField (TextValue text) = PG.toField text
      toField (BoolValue bool) = PG.toField bool
      toField (UUIDValue uuid) = PG.toField uuid
      toField (DateTimeValue utcTime) = PG.toField utcTime
      toField (PointValue point) = PG.toField point
      toField (ArrayValue values) = PG.toField (PG.PGArray values)
      toField Null = PG.toField PG.Null
  