    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE ImplicitParams #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE StandaloneDeriving #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}
    -- | Orphan instances for the 'RIO' data type.
    module RIO.Orphans
      ( HasResourceMap (..)
      , ResourceMap
      , withResourceMap
      ) where

    import RIO
    import Control.Monad.Catch (MonadCatch, MonadMask)
    import Control.Monad.Base (MonadBase)
    import Control.Monad.IO.Unlift (askRunInIO)
    import Control.Monad.Trans.Resource.Internal (MonadResource (..), ReleaseMap, ResourceT (..))
    import Control.Monad.Trans.Resource (runResourceT)
    import Control.Monad.Trans.Control (MonadBaseControl (..))

    import qualified Control.Monad.Logger as LegacyLogger
    import Control.Monad.Logger (MonadLogger (..), MonadLoggerIO (..), LogStr)
    import System.Log.FastLogger (fromLogStr)
    import qualified GHC.Stack as GS

    -- | @since 0.1.0.0
    deriving instance MonadCatch (RIO env)

    -- | @since 0.1.0.0
    deriving instance MonadMask (RIO env)

    -- | @since 0.1.0.0
    deriving instance MonadBase IO (RIO env)

    -- | @since 0.1.0.0
    instance MonadBaseControl IO (RIO env) where
      type StM (RIO env) a = a

      liftBaseWith :: forall a. (RunInBase (RIO env) IO -> IO a) -> RIO env a
    liftBaseWith = ((forall a. RIO env a -> IO a) -> IO a) -> RIO env a
    (RunInBase (RIO env) IO -> IO a) -> RIO env a
    forall b. ((forall a. RIO env a -> IO a) -> IO b) -> RIO env b
    forall (m :: * -> *) b.
    MonadUnliftIO m =>
    ((forall a. m a -> IO a) -> IO b) -> m b
    withRunInIO
      restoreM :: forall a. StM (RIO env) a -> RIO env a
    restoreM = a -> RIO env a
    StM (RIO env) a -> RIO env a
    forall a. a -> RIO env a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    -- | @since 0.1.1.0
    instance Display LogStr where
      display :: LogStr -> Utf8Builder
    display = ByteString -> Utf8Builder
    displayBytesUtf8 (ByteString -> Utf8Builder)
    -> (LogStr -> ByteString) -> LogStr -> Utf8Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LogStr -> ByteString
    fromLogStr

    -- | @since 0.1.1.0
    instance HasLogFunc env => MonadLogger (RIO env) where
      monadLoggerLog :: forall msg.
    ToLogStr msg =>
    Loc -> Text -> LogLevel -> msg -> RIO env ()
    monadLoggerLog Loc
    loc Text
    source LogLevel
    level msg
    msg =
          let ?callStack = Loc -> CallStack
    rioCallStack Loc
    loc
           in Text -> LogLevel -> Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Text -> LogLevel -> Utf8Builder -> m ()
    logGeneric Text
    source (LogLevel -> LogLevel
    rioLogLevel LogLevel
    level) (LogStr -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display (LogStr -> Utf8Builder) -> LogStr -> Utf8Builder
    forall a b. (a -> b) -> a -> b
    $ msg -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    LegacyLogger.toLogStr msg
    msg)

    -- | Do not let the generated function escape its RIO context. This may lead
    --   to log-related cleanup running /before/ the function is called.
    --
    --   @since 0.1.2.0
    instance HasLogFunc env => MonadLoggerIO (RIO env) where
      askLoggerIO :: RIO env (Loc -> Text -> LogLevel -> LogStr -> IO ())
    askLoggerIO = do
        runInIO <- RIO env (RIO env () -> IO ())
    forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
    askRunInIO
        pure $ \Loc
    loc Text
    source LogLevel
    level LogStr
    str ->
          let ?callStack = Loc -> CallStack
    rioCallStack Loc
    loc
           in RIO env () -> IO ()
    runInIO (Text -> LogLevel -> Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Text -> LogLevel -> Utf8Builder -> m ()
    logGeneric Text
    source (LogLevel -> LogLevel
    rioLogLevel LogLevel
    level) (LogStr -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display LogStr
    str))

    rioLogLevel :: LegacyLogger.LogLevel -> LogLevel
    rioLogLevel :: LogLevel -> LogLevel
    rioLogLevel LogLevel
    level =
      case LogLevel
    level of
        LogLevel
    LegacyLogger.LevelDebug -> LogLevel
    LevelDebug
        LogLevel
    LegacyLogger.LevelInfo  -> LogLevel
    LevelInfo
        LogLevel
    LegacyLogger.LevelWarn  -> LogLevel
    LevelWarn
        LogLevel
    LegacyLogger.LevelError  -> LogLevel
    LevelError
        LegacyLogger.LevelOther Text
    name -> Text -> LogLevel
    LevelOther Text
    name

    rioCallStack :: LegacyLogger.Loc -> CallStack
    rioCallStack :: Loc -> CallStack
    rioCallStack Loc
    loc = [([Char], SrcLoc)] -> CallStack
    GS.fromCallSiteList [([Char]
    "", GS.SrcLoc
      { srcLocPackage :: [Char]
    GS.srcLocPackage = Loc -> [Char]
    LegacyLogger.loc_package Loc
    loc
      , srcLocModule :: [Char]
    GS.srcLocModule = Loc -> [Char]
    LegacyLogger.loc_module Loc
    loc
      , srcLocFile :: [Char]
    GS.srcLocFile = Loc -> [Char]
    LegacyLogger.loc_filename Loc
    loc
      , srcLocStartLine :: Int
    GS.srcLocStartLine = (Int, Int) -> Int
    forall a b. (a, b) -> a
    fst ((Int, Int) -> Int) -> (Int, Int) -> Int
    forall a b. (a -> b) -> a -> b
    $ Loc -> (Int, Int)
    LegacyLogger.loc_start Loc
    loc
      , srcLocStartCol :: Int
    GS.srcLocStartCol = (Int, Int) -> Int
    forall a b. (a, b) -> b
    snd ((Int, Int) -> Int) -> (Int, Int) -> Int
    forall a b. (a -> b) -> a -> b
    $ Loc -> (Int, Int)
    LegacyLogger.loc_start Loc
    loc
      , srcLocEndLine :: Int
    GS.srcLocEndLine = (Int, Int) -> Int
    forall a b. (a, b) -> a
    fst ((Int, Int) -> Int) -> (Int, Int) -> Int
    forall a b. (a -> b) -> a -> b
    $ Loc -> (Int, Int)
    LegacyLogger.loc_end Loc
    loc
      , srcLocEndCol :: Int
    GS.srcLocEndCol = (Int, Int) -> Int
    forall a b. (a, b) -> b
    snd ((Int, Int) -> Int) -> (Int, Int) -> Int
    forall a b. (a -> b) -> a -> b
    $ Loc -> (Int, Int)
    LegacyLogger.loc_end Loc
    loc
      })]

    -- | A collection of all of the registered resource cleanup actions.
    --
    -- @since 0.1.0.0
    type ResourceMap = IORef ReleaseMap

    -- | Perform an action with a 'ResourceMap'
    --
    -- @since 0.1.0.0
    withResourceMap :: MonadUnliftIO m => (ResourceMap -> m a) -> m a
    withResourceMap :: forall (m :: * -> *) a.
    MonadUnliftIO m =>
    (ResourceMap -> m a) -> m a
    withResourceMap ResourceMap -> m a
    inner =
      ((forall a. m a -> IO a) -> IO a) -> m a
    forall b. ((forall a. m a -> IO a) -> IO b) -> m b
    forall (m :: * -> *) b.
    MonadUnliftIO m =>
    ((forall a. m a -> IO a) -> IO b) -> m b
    withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
    -> ((forall a. m a -> IO a) -> IO a) -> m a
    forall a b. (a -> b) -> a -> b
    $ \forall a. m a -> IO a
    run -> ResourceT IO a -> IO a
    forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
    runResourceT (ResourceT IO a -> IO a) -> ResourceT IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ (ResourceMap -> IO a) -> ResourceT IO a
    forall (m :: * -> *) a. (ResourceMap -> m a) -> ResourceT m a
    ResourceT ((ResourceMap -> IO a) -> ResourceT IO a)
    -> (ResourceMap -> IO a) -> ResourceT IO a
    forall a b. (a -> b) -> a -> b
    $ m a -> IO a
    forall a. m a -> IO a
    run (m a -> IO a) -> (ResourceMap -> m a) -> ResourceMap -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ResourceMap -> m a
    inner

    -- | An environment with a 'ResourceMap'
    --
    -- @since 0.1.0.0
    class HasResourceMap env where
      resourceMapL :: Lens' env ResourceMap
    instance HasResourceMap (IORef ReleaseMap) where
      resourceMapL :: Lens' ResourceMap ResourceMap
    resourceMapL = (ResourceMap -> f ResourceMap) -> ResourceMap -> f ResourceMap
    forall a. a -> a
    id
    instance HasResourceMap env => MonadResource (RIO env) where
      liftResourceT :: forall a. ResourceT IO a -> RIO env a
    liftResourceT (ResourceT ResourceMap -> IO a
    f) = Getting ResourceMap env ResourceMap -> RIO env ResourceMap
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting ResourceMap env ResourceMap
    forall env. HasResourceMap env => Lens' env ResourceMap
    Lens' env ResourceMap
    resourceMapL RIO env ResourceMap -> (ResourceMap -> RIO env a) -> RIO env a
    forall a b. RIO env a -> (a -> RIO env b) -> RIO env b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO a -> RIO env a
    forall a. IO a -> RIO env a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> RIO env a)
    -> (ResourceMap -> IO a) -> ResourceMap -> RIO env a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ResourceMap -> IO a
    f