{-# LANGUAGE DeriveAnyClass #-}
{-|
Module: IHP.DataSync.DynamicQuery
Description: The normal IHP query functionality is type-safe. This module provides type-unsafe access to the database.
Copyright: (c) digitally induced GmbH, 2021
-}
module IHP.DataSync.DynamicQuery where

import IHP.ControllerPrelude hiding (OrderByClause)
import Data.Aeson
import qualified Database.PostgreSQL.Simple.FromField as PG
import qualified Database.PostgreSQL.Simple.ToField as PG
import qualified Database.PostgreSQL.Simple.Types as PG
import qualified IHP.QueryBuilder as QueryBuilder
import Data.Aeson.TH
import qualified GHC.Generics
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Aeson.KeyMap as Aeson
import qualified Data.Aeson.Key as Aeson

data Field = Field { fieldName :: Text, fieldValue :: DynamicValue }

data DynamicValue
    = IntValue !Int
    | DoubleValue !Double
    | TextValue !Text
    | BoolValue !Bool
    | UUIDValue !UUID
    | DateTimeValue !UTCTime
    | PointValue !Point
    | IntervalValue !PGInterval
    | ArrayValue ![DynamicValue]
    | Null
    deriving (Show, Eq)

newtype UndecodedJSON = UndecodedJSON ByteString
    deriving (Show, Eq)

-- | Similiar to IHP.QueryBuilder.SQLQuery, but is designed to be accessed by external users
--
-- When compiling to SQL we have to be extra careful to escape all identifers and variables in the query.
-- The normal IHP.QueryBuilder doesn't need to be that careful as parts of the input are derived from
-- generated code from the Schema.sql.
--
data DynamicSQLQuery = DynamicSQLQuery
    { table :: !Text
    , selectedColumns :: SelectedColumns
    , whereCondition :: !(Maybe ConditionExpression)
    , orderByClause :: ![OrderByClause]
    , distinctOnColumn :: !(Maybe ByteString)
    , limit :: !(Maybe Int)
    , offset :: !(Maybe Int)
    } deriving (Show, Eq)

data OrderByClause
    = OrderByClause
        { orderByColumn :: !ByteString
        , orderByDirection :: !OrderByDirection }
    | OrderByTSRank { tsvector :: Text, tsquery :: !Text }
    deriving (Show, Eq, GHC.Generics.Generic, DeepSeq.NFData)

-- | Represents a WHERE conditions of a 'DynamicSQLQuery'
data ConditionExpression
    = ColumnExpression { field :: !Text }
    | InfixOperatorExpression
        { left :: !ConditionExpression
        , op :: !ConditionOperator
        , right :: !ConditionExpression
        }
    | LiteralExpression { value :: !DynamicValue }
    | CallExpression { functionCall :: !FunctionCall }
    | ListExpression { values :: ![DynamicValue] }
    deriving (Show, Eq)

data FunctionCall
    = ToTSQuery { text :: !Text } -- ^ to_tsquery('english', text)
    deriving (Show, Eq, GHC.Generics.Generic, DeepSeq.NFData)

-- | Operators available in WHERE conditions
data ConditionOperator
    = OpEqual -- ^ a = b
    | OpGreaterThan -- ^ a > b
    | OpLessThan -- ^ a < b
    | OpGreaterThanOrEqual -- ^ a >= b
    | OpLessThanOrEqual -- ^ a <= b
    | OpNotEqual -- ^ a <> b
    | OpAnd -- ^ a AND b
    | OpOr -- ^ a OR b
    | OpIs -- ^ a IS b
    | OpIsNot -- ^ a IS NOT b
    | OpTSMatch -- ^ tsvec_a @@ tsvec_b
    | OpIn -- ^ a IN b
    deriving (Show, Eq)

data SelectedColumns
    = SelectAll -- ^ SELECT * FROM table
    | SelectSpecific [Text] -- ^ SELECT a, b, c FROM table
    deriving (Show, Eq)

instance FromJSON ByteString where
    parseJSON (String v) = pure $ cs v

instance FromJSON PG.Action where
    parseJSON (String v) = pure (PG.Escape (cs v))

instance {-# OVERLAPS #-} ToJSON [Field] where
    toJSON fields = object (map (\Field { fieldName, fieldValue } -> (cs fieldName) .= (toJSON fieldValue)) fields)
    toEncoding fields = pairs $ foldl' (<>) mempty encodedFields
        where
            encodedFields = (map (\Field { fieldName, fieldValue } -> (cs fieldName) .= (toJSON fieldValue)) fields)

instance ToJSON DynamicValue where
    toJSON (IntValue value) = toJSON value
    toJSON (DoubleValue value) = toJSON value
    toJSON (TextValue value) = toJSON value
    toJSON (BoolValue value) = toJSON value
    toJSON (UUIDValue value) = toJSON value
    toJSON (DateTimeValue value) = toJSON value
    toJSON (PointValue value) = toJSON value
    toJSON (IntervalValue value) = toJSON value
    toJSON (ArrayValue value) = toJSON value
    toJSON IHP.DataSync.DynamicQuery.Null = toJSON Data.Aeson.Null

instance PG.FromField Field where
    fromField field fieldValue' = do
            fieldValue <- PG.fromField field fieldValue'
            pure Field { .. }
        where
            fieldName = (PG.name field)
                |> fmap cs
                |> fromMaybe ""

instance PG.FromField DynamicValue where
    fromField field fieldValue' = fieldValue
        where
            fieldValue =
                    (IntValue <$> PG.fromField field fieldValue')
                <|> (TextValue <$> PG.fromField field fieldValue')
                <|> (BoolValue <$> PG.fromField field fieldValue')
                <|> (UUIDValue <$> PG.fromField field fieldValue')
                <|> (DoubleValue <$> PG.fromField field fieldValue')
                <|> (DateTimeValue <$> PG.fromField field fieldValue')
                <|> (PointValue <$> PG.fromField field fieldValue')
                <|> (IntervalValue <$> PG.fromField field fieldValue')
                <|> (ArrayValue <$> PG.fromField field fieldValue')
                <|> (PG.fromField @PG.Null field fieldValue' >> pure IHP.DataSync.DynamicQuery.Null)
                <|> fromFieldCustomEnum field fieldValue'

            fromFieldCustomEnum field (Just value) = pure (TextValue (cs value))
            fromFieldCustomEnum field Nothing      = pure IHP.DataSync.DynamicQuery.Null

instance PG.FromField UndecodedJSON where
    fromField field (Just value) = pure (UndecodedJSON value)
    fromField field Nothing = pure (UndecodedJSON "null")

-- | Returns a list of all id's in a result
recordIds :: [[Field]] -> [UUID]
recordIds result = result
        |> concat
        |> filter (\Field { fieldName } -> fieldName == "id")
        |> map (.fieldValue)
        |> mapMaybe \case
            UUIDValue uuid -> Just uuid
            otherwise      -> Nothing



-- Here you can add functions which are available in all your controllers

-- | Transforms the keys of a JSON object from field name to column name
--
-- >>> transformColumnNamesToFieldNames [json|{"isCompleted": true}|]
-- [json|{"is_completed": true}|]
transformColumnNamesToFieldNames :: Value -> Value
transformColumnNamesToFieldNames (Object hashMap) =
        hashMap
        |> Aeson.toList
        |> map (\(key, value) -> (applyKey columnNameToFieldName key, value))
        |> Aeson.fromList
        |> Object
    where
        applyKey function key =
            key
                |> Aeson.toText
                |> function
                |> Aeson.fromText


$(deriveFromJSON defaultOptions ''FunctionCall)
$(deriveFromJSON defaultOptions 'QueryBuilder.OrCondition)
$(deriveFromJSON defaultOptions 'QueryBuilder.Join)
$(deriveFromJSON defaultOptions ''QueryBuilder.OrderByDirection)
$(deriveFromJSON defaultOptions 'QueryBuilder.OrderByClause)
$(deriveFromJSON defaultOptions 'SelectAll)
$(deriveFromJSON defaultOptions ''ConditionOperator)
$(deriveFromJSON defaultOptions ''DynamicValue)
$(deriveFromJSON defaultOptions ''ConditionExpression)

instance FromJSON DynamicSQLQuery where
    parseJSON = withObject "DynamicSQLQuery" $ \v -> DynamicSQLQuery
        <$> v .: "table"
        <*> v .: "selectedColumns"
        <*> v .: "whereCondition"
        <*> v .: "orderByClause"
        <*> v .:? "distinctOnColumn" -- distinctOnColumn can be absent in older versions of ihp-datasync.js
        <*> v .:? "limit" -- Limit can be absent in older versions of ihp-datasync.js
        <*> v .:? "offset" -- Offset can be absent in older versions of ihp-datasync.js


instance FromJSON OrderByClause where
    parseJSON = withObject "OrderByClause" $ \v -> do
        let oldFormat = OrderByClause
                <$> v .: "orderByColumn"
                <*> v .: "orderByDirection"
        let tagged = do
                tag <- v .: "tag"
                case tag of
                    "OrderByClause" -> oldFormat
                    "OrderByTSRank" -> OrderByTSRank <$> v .: "tsvector" <*> v .: "tsquery"
                    otherwise -> error ("Invalid tag: " <> otherwise)
        tagged <|> oldFormat