{-# LANGUAGE RankNTypes #-}

{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

@since 1.0.0.0
-}
module Orville.PostgreSQL.Internal.OrvilleState
  ( OrvilleState
  , newOrvilleState
  , resetOrvilleState
  , orvilleConnectionPool
  , orvilleConnectionState
  , orvilleErrorDetailLevel
  , orvilleTransactionCallback
  , orvilleSqlCommenterAttributes
  , addTransactionCallback
  , TransactionEvent (BeginTransaction, NewSavepoint, ReleaseSavepoint, RollbackToSavepoint, CommitTransaction, RollbackTransaction)
  , openTransactionEvent
  , rollbackTransactionEvent
  , transactionSuccessEvent
  , ConnectionState (NotConnected, Connected)
  , ConnectedState (ConnectedState, connectedConnection, connectedTransaction)
  , connectState
  , TransactionState (OutermostTransaction, SavepointTransaction)
  , newTransaction
  , Savepoint
  , savepointNestingLevel
  , initialSavepoint
  , nextSavepoint
  , orvilleSqlExecutionCallback
  , addSqlExecutionCallback
  , orvilleBeginTransactionExpr
  , setBeginTransactionExpr
  , setSqlCommenterAttributes
  , addSqlCommenterAttributes
  )
where

import qualified Data.Map.Strict as Map

import Orville.PostgreSQL.ErrorDetailLevel (ErrorDetailLevel)
import Orville.PostgreSQL.Execution.QueryType (QueryType)
import qualified Orville.PostgreSQL.Expr as Expr
import Orville.PostgreSQL.Raw.Connection (Connection, ConnectionPool)
import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
import qualified Orville.PostgreSQL.Raw.SqlCommenter as SqlCommenter

{- |
  'OrvilleState' is used to manage opening connections to the database,
  transactions, etc. 'newOrvilleState' should be used to create an appopriate
  initial state for your monad's context.

@since 1.0.0.0
-}
data OrvilleState = OrvilleState
  { OrvilleState -> ConnectionPool
_orvilleConnectionPool :: ConnectionPool
  , OrvilleState -> ConnectionState
_orvilleConnectionState :: ConnectionState
  , OrvilleState -> ErrorDetailLevel
_orvilleErrorDetailLevel :: ErrorDetailLevel
  , OrvilleState -> TransactionEvent -> IO ()
_orvilleTransactionCallback :: TransactionEvent -> IO ()
  , OrvilleState -> forall a. QueryType -> RawSql -> IO a -> IO a
_orvilleSqlExecutionCallback :: forall a. QueryType -> RawSql.RawSql -> IO a -> IO a
  , OrvilleState -> BeginTransactionExpr
_orvilleBeginTransactionExpr :: Expr.BeginTransactionExpr
  , OrvilleState -> Maybe SqlCommenterAttributes
_orvilleSqlCommenterAttributes :: Maybe SqlCommenter.SqlCommenterAttributes
  }

{- |
  Get the connection pool being used for the 'OrvilleState'.

@since 1.0.0.0
-}
orvilleConnectionPool :: OrvilleState -> ConnectionPool
orvilleConnectionPool :: OrvilleState -> ConnectionPool
orvilleConnectionPool =
  OrvilleState -> ConnectionPool
_orvilleConnectionPool

{- |
  INTERNAL: The 'ConnectionState' indicates whether Orville currently has a
  connection open, and contains the connection if it does.

@since 1.0.0.0
-}
orvilleConnectionState :: OrvilleState -> ConnectionState
orvilleConnectionState :: OrvilleState -> ConnectionState
orvilleConnectionState =
  OrvilleState -> ConnectionState
_orvilleConnectionState

{- |
  The 'ErrorDetailLevel' controls how much information Orville includes in
  error messages it generates when data cannot be decoded from rows in the
  database.

@since 1.0.0.0
-}
orvilleErrorDetailLevel :: OrvilleState -> ErrorDetailLevel
orvilleErrorDetailLevel :: OrvilleState -> ErrorDetailLevel
orvilleErrorDetailLevel =
  OrvilleState -> ErrorDetailLevel
_orvilleErrorDetailLevel

{- |
  Orville will call the transaction callback any time a transaction event
  occurs. You can register a callback with 'addTransactionCallback'.

@since 1.0.0.0
-}
orvilleTransactionCallback :: OrvilleState -> TransactionEvent -> IO ()
orvilleTransactionCallback :: OrvilleState -> TransactionEvent -> IO ()
orvilleTransactionCallback =
  OrvilleState -> TransactionEvent -> IO ()
_orvilleTransactionCallback

{- |
  The SQL expression that Orville will use to begin a transaction. You can set
  this via 'setBeginTransactionExpr' to have fine-grained control over the
  transaction parameters, such as isolation level.

@since 1.0.0.0
-}
orvilleBeginTransactionExpr :: OrvilleState -> Expr.BeginTransactionExpr
orvilleBeginTransactionExpr :: OrvilleState -> BeginTransactionExpr
orvilleBeginTransactionExpr =
  OrvilleState -> BeginTransactionExpr
_orvilleBeginTransactionExpr

{- |
  The SqlCommenter attributes that Orville will include with queries. These can
  be modified with 'addSqlCommenterAttributes'. See
  https://google.github.io/sqlcommenter/.

@since 1.0.0.0
-}
orvilleSqlCommenterAttributes :: OrvilleState -> Maybe SqlCommenter.SqlCommenterAttributes
orvilleSqlCommenterAttributes :: OrvilleState -> Maybe SqlCommenterAttributes
orvilleSqlCommenterAttributes =
  OrvilleState -> Maybe SqlCommenterAttributes
_orvilleSqlCommenterAttributes

{- |
  Registers a callback to be invoked during transactions.

  The callback given will be called after the SQL statement corresponding
  to the given event has finished executing. Callbacks will be called
  in the order they are added.

  Note: There is no specialized error handling for these callbacks. This means
  that if a callback raises an exception, no further callbacks will be called
  and the exception will propagate up until it is caught elsewhere. In
  particular, if an exception is raised by a callback upon opening the
  transaction, it will cause the transaction to be rolled-back the same as any
  other exception that might happen during the transaction. In general, we
  recommend only using callbacks that either raise no exceptions or can handle
  their own exceptions cleanly.

@since 1.0.0.0
-}
addTransactionCallback ::
  (TransactionEvent -> IO ()) ->
  OrvilleState ->
  OrvilleState
addTransactionCallback :: (TransactionEvent -> IO ()) -> OrvilleState -> OrvilleState
addTransactionCallback TransactionEvent -> IO ()
newCallback OrvilleState
state =
  let
    originalCallback :: TransactionEvent -> IO ()
originalCallback =
      OrvilleState -> TransactionEvent -> IO ()
_orvilleTransactionCallback OrvilleState
state

    wrappedCallback :: TransactionEvent -> IO ()
wrappedCallback TransactionEvent
event = do
      TransactionEvent -> IO ()
originalCallback TransactionEvent
event
      TransactionEvent -> IO ()
newCallback TransactionEvent
event
  in
    OrvilleState
state {_orvilleTransactionCallback :: TransactionEvent -> IO ()
_orvilleTransactionCallback = TransactionEvent -> IO ()
wrappedCallback}

{- |
  Creates an appropriate initial 'OrvilleState' that will use the connection
  pool given to initiate connections to the database.

@since 1.0.0.0
-}
newOrvilleState :: ErrorDetailLevel -> ConnectionPool -> OrvilleState
newOrvilleState :: ErrorDetailLevel -> ConnectionPool -> OrvilleState
newOrvilleState ErrorDetailLevel
errorDetailLevel ConnectionPool
pool =
  OrvilleState
    { _orvilleConnectionPool :: ConnectionPool
_orvilleConnectionPool = ConnectionPool
pool
    , _orvilleConnectionState :: ConnectionState
_orvilleConnectionState = ConnectionState
NotConnected
    , _orvilleErrorDetailLevel :: ErrorDetailLevel
_orvilleErrorDetailLevel = ErrorDetailLevel
errorDetailLevel
    , _orvilleTransactionCallback :: TransactionEvent -> IO ()
_orvilleTransactionCallback = TransactionEvent -> IO ()
defaultTransactionCallback
    , _orvilleSqlExecutionCallback :: forall a. QueryType -> RawSql -> IO a -> IO a
_orvilleSqlExecutionCallback = QueryType -> RawSql -> IO a -> IO a
forall a. QueryType -> RawSql -> IO a -> IO a
defaultSqlExectionCallback
    , _orvilleBeginTransactionExpr :: BeginTransactionExpr
_orvilleBeginTransactionExpr = BeginTransactionExpr
defaultBeginTransactionExpr
    , _orvilleSqlCommenterAttributes :: Maybe SqlCommenterAttributes
_orvilleSqlCommenterAttributes = Maybe SqlCommenterAttributes
forall a. Maybe a
Nothing
    }

{- |
  Creates a new initial 'OrvilleState' using the connection pool from the
  provided state. You might need to use this if you are spawning one Orville
  monad from another and they should not share the same connection and
  transaction state.

@since 1.0.0.0
-}
resetOrvilleState :: OrvilleState -> OrvilleState
resetOrvilleState :: OrvilleState -> OrvilleState
resetOrvilleState =
  ErrorDetailLevel -> ConnectionPool -> OrvilleState
newOrvilleState
    (ErrorDetailLevel -> ConnectionPool -> OrvilleState)
-> (OrvilleState -> ErrorDetailLevel)
-> OrvilleState
-> ConnectionPool
-> OrvilleState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OrvilleState -> ErrorDetailLevel
_orvilleErrorDetailLevel
    (OrvilleState -> ConnectionPool -> OrvilleState)
-> (OrvilleState -> ConnectionPool) -> OrvilleState -> OrvilleState
forall a b.
(OrvilleState -> a -> b)
-> (OrvilleState -> a) -> OrvilleState -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OrvilleState -> ConnectionPool
_orvilleConnectionPool

{- |
  INTERNAL: Transitions the 'OrvilleState' into "connected" status, storing the
  given 'Connection' as the database connection to be used to execute all
  queries. This is used by 'Orville.PostgreSQL.Monad.withConnection' to track
  the connection it retrieves from the pool.

@since 1.0.0.0
-}
connectState :: ConnectedState -> OrvilleState -> OrvilleState
connectState :: ConnectedState -> OrvilleState -> OrvilleState
connectState ConnectedState
connectedState OrvilleState
state =
  OrvilleState
state
    { _orvilleConnectionState :: ConnectionState
_orvilleConnectionState = ConnectedState -> ConnectionState
Connected ConnectedState
connectedState
    }

{- |
  INTERNAL: This type is used to signal whether a database connection has
  been retrieved from the pool for the current operation or not. The
  value is tracked in the 'OrvilleState' for the host monad, and is checked
  by 'Orville.PostgreSQL.Monad.withConnection' to avoid checking out two
  separate connections for a multiple operations that needs to be run on the
  same connection (e.g. multiple operations inside a transaction).

@since 1.0.0.0
-}
data ConnectionState
  = NotConnected
  | Connected ConnectedState

{- |
  INTERNAL: This type is used hold the connection while it is open and
  track the state of open transactions and savepoints on the connection.

@since 1.0.0.0
-}
data ConnectedState = ConnectedState
  { ConnectedState -> Connection
connectedConnection :: Connection
  , ConnectedState -> Maybe TransactionState
connectedTransaction :: Maybe TransactionState
  }

{- |
  INTERNAL: This type is use to track the state of open transactions and
  savepoints on an open connection.

@since 1.0.0.0
-}
data TransactionState
  = OutermostTransaction
  | SavepointTransaction Savepoint

{- |
  INTERNAL: Constructs a new 'TransactionState' to represent beginning a
  new transaction in SQL.

@since 1.0.0.0
-}
newTransaction :: Maybe TransactionState -> TransactionState
newTransaction :: Maybe TransactionState -> TransactionState
newTransaction Maybe TransactionState
maybeTransactionState =
  case Maybe TransactionState
maybeTransactionState of
    Maybe TransactionState
Nothing ->
      TransactionState
OutermostTransaction
    Just TransactionState
OutermostTransaction ->
      Savepoint -> TransactionState
SavepointTransaction Savepoint
initialSavepoint
    Just (SavepointTransaction Savepoint
savepoint) ->
      Savepoint -> TransactionState
SavepointTransaction (Savepoint -> Savepoint
nextSavepoint Savepoint
savepoint)

{- |
  An internal Orville identifier for a savepoint in a PostgreSQL transaction.

@since 1.0.0.0
-}
newtype Savepoint
  = Savepoint Int
  deriving (Savepoint -> Savepoint -> Bool
(Savepoint -> Savepoint -> Bool)
-> (Savepoint -> Savepoint -> Bool) -> Eq Savepoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Savepoint -> Savepoint -> Bool
== :: Savepoint -> Savepoint -> Bool
$c/= :: Savepoint -> Savepoint -> Bool
/= :: Savepoint -> Savepoint -> Bool
Eq, Int -> Savepoint -> ShowS
[Savepoint] -> ShowS
Savepoint -> String
(Int -> Savepoint -> ShowS)
-> (Savepoint -> String)
-> ([Savepoint] -> ShowS)
-> Show Savepoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Savepoint -> ShowS
showsPrec :: Int -> Savepoint -> ShowS
$cshow :: Savepoint -> String
show :: Savepoint -> String
$cshowList :: [Savepoint] -> ShowS
showList :: [Savepoint] -> ShowS
Show)

{- |
  The initial identifier Orville uses to track the first savepoint within
  a transaction.

@since 1.0.0.0
-}
initialSavepoint :: Savepoint
initialSavepoint :: Savepoint
initialSavepoint =
  Int -> Savepoint
Savepoint Int
1

{- |
  Determines the identifier for the next savepoint in a transaction after the
  given savepoint.

@since 1.0.0.0
-}
nextSavepoint :: Savepoint -> Savepoint
nextSavepoint :: Savepoint -> Savepoint
nextSavepoint (Savepoint Int
n) =
  Int -> Savepoint
Savepoint (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

{- |
  Indicates how many levels of nested savepoints the given 'Savepoint'
  identifier represents.

@since 1.0.0.0
-}
savepointNestingLevel :: Savepoint -> Int
savepointNestingLevel :: Savepoint -> Int
savepointNestingLevel (Savepoint Int
n) = Int
n

{- |
  Describes an event in the lifecycle of a database transaction. You can use
  'addTransactionCallback' to register a callback to respond to these events.
  The callback will be called after the event in question has been successfully
  executed.

@since 1.0.0.0
-}
data TransactionEvent
  = -- | Indicates a new transaction has been started.
    BeginTransaction
  | -- | Indicates that a new savepoint has been saved within a transaction.
    NewSavepoint Savepoint
  | -- | Indicates that a previous savepoint has been released. It can no
    -- longer be rolled back to.
    ReleaseSavepoint Savepoint
  | -- | Indicates that rollback was performed to a prior savepoint.
    --
    -- Note: It is possible to rollback to a savepoint prior to the most recent
    -- one without releasing or rolling back to intermediate savepoints. Doing
    -- so destroys any savepoints created after the given savepoint. Although
    -- Orville currently always matches 'NewSavepoint' with either
    -- 'ReleaseSavepoint' or 'RollbackToSavepoint', it is recommended that you
    -- do not rely on this behavior.
    RollbackToSavepoint Savepoint
  | -- | Indicates that the transaction has been committed.
    CommitTransaction
  | -- | Indicates that the transaction has been rolled back.
    RollbackTransaction
  deriving (TransactionEvent -> TransactionEvent -> Bool
(TransactionEvent -> TransactionEvent -> Bool)
-> (TransactionEvent -> TransactionEvent -> Bool)
-> Eq TransactionEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransactionEvent -> TransactionEvent -> Bool
== :: TransactionEvent -> TransactionEvent -> Bool
$c/= :: TransactionEvent -> TransactionEvent -> Bool
/= :: TransactionEvent -> TransactionEvent -> Bool
Eq, Int -> TransactionEvent -> ShowS
[TransactionEvent] -> ShowS
TransactionEvent -> String
(Int -> TransactionEvent -> ShowS)
-> (TransactionEvent -> String)
-> ([TransactionEvent] -> ShowS)
-> Show TransactionEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransactionEvent -> ShowS
showsPrec :: Int -> TransactionEvent -> ShowS
$cshow :: TransactionEvent -> String
show :: TransactionEvent -> String
$cshowList :: [TransactionEvent] -> ShowS
showList :: [TransactionEvent] -> ShowS
Show)

{- |
  The default transaction callback is simply a no-op.

@since 1.0.0.0
-}
defaultTransactionCallback :: TransactionEvent -> IO ()
defaultTransactionCallback :: TransactionEvent -> IO ()
defaultTransactionCallback = IO () -> TransactionEvent -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{- |
  Constructs the appropriate 'TransactionEvent' for opening a new transaction
  based on the current 'TransactionState'.

@since 1.0.0.0
-}
openTransactionEvent :: TransactionState -> TransactionEvent
openTransactionEvent :: TransactionState -> TransactionEvent
openTransactionEvent TransactionState
txnState =
  case TransactionState
txnState of
    TransactionState
OutermostTransaction -> TransactionEvent
BeginTransaction
    SavepointTransaction Savepoint
savepoint -> Savepoint -> TransactionEvent
NewSavepoint Savepoint
savepoint

{- |
  Constructs the appropriate 'TransactionEvent' for rolling back the innermost
  transaction based on the current 'TransactionState'.

@since 1.0.0.0
-}
rollbackTransactionEvent :: TransactionState -> TransactionEvent
rollbackTransactionEvent :: TransactionState -> TransactionEvent
rollbackTransactionEvent TransactionState
txnState =
  case TransactionState
txnState of
    TransactionState
OutermostTransaction -> TransactionEvent
RollbackTransaction
    SavepointTransaction Savepoint
savepoint -> Savepoint -> TransactionEvent
RollbackToSavepoint Savepoint
savepoint

{- |
  Constructs the appropriate 'TransactionEvent' to represent a transaction
  completely successfully based on the current 'TransactionState'.

@since 1.0.0.0
-}
transactionSuccessEvent :: TransactionState -> TransactionEvent
transactionSuccessEvent :: TransactionState -> TransactionEvent
transactionSuccessEvent TransactionState
txnState =
  case TransactionState
txnState of
    TransactionState
OutermostTransaction -> TransactionEvent
CommitTransaction
    SavepointTransaction Savepoint
savepoint -> Savepoint -> TransactionEvent
ReleaseSavepoint Savepoint
savepoint

{- |
  The callback Orville will call whenever it wants to run SQL. You can
  register a callback using 'addSqlExecutionCallback'.

@since 1.0.0.0
-}
orvilleSqlExecutionCallback ::
  OrvilleState ->
  forall a.
  QueryType ->
  RawSql.RawSql ->
  IO a ->
  IO a
orvilleSqlExecutionCallback :: OrvilleState -> forall a. QueryType -> RawSql -> IO a -> IO a
orvilleSqlExecutionCallback =
  OrvilleState -> QueryType -> RawSql -> IO a -> IO a
OrvilleState -> forall a. QueryType -> RawSql -> IO a -> IO a
_orvilleSqlExecutionCallback

{- |
  The default SQL execption callback simply runs the IO action given without
  doing anything else.

@since 1.0.0.0
-}
defaultSqlExectionCallback :: QueryType -> RawSql.RawSql -> IO a -> IO a
defaultSqlExectionCallback :: forall a. QueryType -> RawSql -> IO a -> IO a
defaultSqlExectionCallback QueryType
_ RawSql
_ IO a
io = IO a
io

{- |
  Adds a callback to be called when an Orville operation executes a SQL
  statement. The callback is given the IO action that will perform the
  query execution and must call that action for the query to be run.
  In particular, you can use this to time queries and log any that are slow.

  Calls to any previously added callbacks will also be executed as part of
  the IO action passed to the new callback. Thus the newly added callback
  happens "around" the previously added callback.

  There is no special exception handling done for these callbacks beyond what
  they implement themselves. Any callbacks should allow for the possibility
  that the IO action they are given may raise an exception.

@since 1.0.0.0
-}
addSqlExecutionCallback ::
  (forall a. QueryType -> RawSql.RawSql -> IO a -> IO a) ->
  OrvilleState ->
  OrvilleState
addSqlExecutionCallback :: (forall a. QueryType -> RawSql -> IO a -> IO a)
-> OrvilleState -> OrvilleState
addSqlExecutionCallback forall a. QueryType -> RawSql -> IO a -> IO a
outerCallback OrvilleState
state =
  let
    layeredCallback, innerCallback :: QueryType -> RawSql.RawSql -> IO a -> IO a
    layeredCallback :: forall a. QueryType -> RawSql -> IO a -> IO a
layeredCallback QueryType
queryType RawSql
sql IO a
action =
      QueryType -> RawSql -> IO a -> IO a
forall a. QueryType -> RawSql -> IO a -> IO a
outerCallback QueryType
queryType RawSql
sql (QueryType -> RawSql -> IO a -> IO a
forall a. QueryType -> RawSql -> IO a -> IO a
innerCallback QueryType
queryType RawSql
sql IO a
action)
    innerCallback :: forall a. QueryType -> RawSql -> IO a -> IO a
innerCallback = OrvilleState -> forall a. QueryType -> RawSql -> IO a -> IO a
_orvilleSqlExecutionCallback OrvilleState
state
  in
    OrvilleState
state {_orvilleSqlExecutionCallback :: forall a. QueryType -> RawSql -> IO a -> IO a
_orvilleSqlExecutionCallback = QueryType -> RawSql -> IO a -> IO a
forall a. QueryType -> RawSql -> IO a -> IO a
layeredCallback}

{- |
  The default begin transaction expression is simply @BEGIN TRANSACTION@
  with no options specified.

@since 1.0.0.0
-}
defaultBeginTransactionExpr :: Expr.BeginTransactionExpr
defaultBeginTransactionExpr :: BeginTransactionExpr
defaultBeginTransactionExpr =
  Maybe TransactionMode -> BeginTransactionExpr
Expr.beginTransaction Maybe TransactionMode
forall a. Maybe a
Nothing

{- |
  Sets the SQL expression that Orville will use to begin transactions. You can
  control the transaction isolation level by building your own
  'Expr.BeginTransactionExpr' with the desired isolation level.

@since 1.0.0.0
-}
setBeginTransactionExpr ::
  Expr.BeginTransactionExpr ->
  OrvilleState ->
  OrvilleState
setBeginTransactionExpr :: BeginTransactionExpr -> OrvilleState -> OrvilleState
setBeginTransactionExpr BeginTransactionExpr
expr OrvilleState
state =
  OrvilleState
state
    { _orvilleBeginTransactionExpr :: BeginTransactionExpr
_orvilleBeginTransactionExpr = BeginTransactionExpr
expr
    }

{- |
  Sets the SqlCommenterAttributes that Orville will then add to any following
  statement executions.

@since 1.0.0.0
-}
setSqlCommenterAttributes ::
  SqlCommenter.SqlCommenterAttributes ->
  OrvilleState ->
  OrvilleState
setSqlCommenterAttributes :: SqlCommenterAttributes -> OrvilleState -> OrvilleState
setSqlCommenterAttributes SqlCommenterAttributes
comments OrvilleState
state =
  OrvilleState
state
    { _orvilleSqlCommenterAttributes :: Maybe SqlCommenterAttributes
_orvilleSqlCommenterAttributes = SqlCommenterAttributes -> Maybe SqlCommenterAttributes
forall a. a -> Maybe a
Just SqlCommenterAttributes
comments
    }

{- |
  Adds the SqlCommenterAttributes to the already existing attributes that
  Orville will then add to any following statement executions.

@since 1.0.0.0
-}
addSqlCommenterAttributes ::
  SqlCommenter.SqlCommenterAttributes ->
  OrvilleState ->
  OrvilleState
addSqlCommenterAttributes :: SqlCommenterAttributes -> OrvilleState -> OrvilleState
addSqlCommenterAttributes SqlCommenterAttributes
comments OrvilleState
state =
  case OrvilleState -> Maybe SqlCommenterAttributes
orvilleSqlCommenterAttributes OrvilleState
state of
    Maybe SqlCommenterAttributes
Nothing ->
      OrvilleState
state
        { _orvilleSqlCommenterAttributes :: Maybe SqlCommenterAttributes
_orvilleSqlCommenterAttributes = SqlCommenterAttributes -> Maybe SqlCommenterAttributes
forall a. a -> Maybe a
Just SqlCommenterAttributes
comments
        }
    Just SqlCommenterAttributes
existingAttrs ->
      OrvilleState
state
        { _orvilleSqlCommenterAttributes :: Maybe SqlCommenterAttributes
_orvilleSqlCommenterAttributes = SqlCommenterAttributes -> Maybe SqlCommenterAttributes
forall a. a -> Maybe a
Just (SqlCommenterAttributes -> Maybe SqlCommenterAttributes)
-> SqlCommenterAttributes -> Maybe SqlCommenterAttributes
forall a b. (a -> b) -> a -> b
$ SqlCommenterAttributes
-> SqlCommenterAttributes -> SqlCommenterAttributes
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union SqlCommenterAttributes
comments SqlCommenterAttributes
existingAttrs
        }