-- | A module for creating great logs in code that makes SQL queries.
module Log.SqlQuery
  ( Details,
    emptyDetails,
    query,
    queryTemplate,
    sqlOperation,
    queriedRelation,
    databaseType,
    host,
    port,
    database,
    rowsReturned,
    mysql,
    postgresql,
  )
where

import qualified Data.Aeson as Aeson

-- | A type describing an SQL query.
--
-- > emptyDetails
-- >   { query = Just (Log.mkSecret "SELECT cuddles FROM puppies")
-- >   , database = Just postgresql
-- >   }
data Details = Details
  { -- | The full query we're executing.
    Details -> Maybe (Secret Text)
query :: Maybe (Log.Secret Text),
    -- | The query we're executing with values mocked out.
    Details -> Maybe Text
queryTemplate :: Maybe Text,
    -- | The SQL operation we're performing (SELECT / INSERT / DELETE / ...).
    Details -> Maybe Text
sqlOperation :: Maybe Text,
    -- | The primary relation of the query.
    Details -> Maybe Text
queriedRelation :: Maybe Text,
    -- | The type of database.
    Details -> Maybe Text
databaseType :: Maybe Text,
    -- | Database host the connection is made to.
    Details -> Maybe Text
host :: Maybe Text,
    -- | Port the database is running on.
    Details -> Maybe Int
port :: Maybe Int,
    -- | The name of the database that is being queried.
    Details -> Maybe Text
database :: Maybe Text,
    -- | The amount of rows this query returned.
    Details -> Maybe Int
rowsReturned :: Maybe Int
  }
  deriving ((forall x. Details -> Rep Details x)
-> (forall x. Rep Details x -> Details) -> Generic Details
forall x. Rep Details x -> Details
forall x. Details -> Rep Details x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Details x -> Details
$cfrom :: forall x. Details -> Rep Details x
Generic)

-- | An empty details value to be modified by you.
emptyDetails :: Details
emptyDetails :: Details
emptyDetails = Maybe (Secret Text)
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Details
Details Maybe (Secret Text)
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing

instance Aeson.ToJSON Details where
  toJSON :: Details -> Value
toJSON = Options -> Details -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
options
  toEncoding :: Details -> Encoding
toEncoding = Options -> Details -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
options

options :: Aeson.Options
options :: Options
options =
  Options
Aeson.defaultOptions
    { fieldLabelModifier :: String -> String
Aeson.fieldLabelModifier = Char -> String -> String
Aeson.camelTo2 Char
' ',
      omitNothingFields :: Bool
Aeson.omitNothingFields = Bool
True
    }

instance Platform.TracingSpanDetails Details

mysql :: Text
mysql :: Text
mysql = Text
"MySQL"

postgresql :: Text
postgresql :: Text
postgresql = Text
"PostgreSQL"