{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Ribosome.Prelude (
  module Control.Monad.Trans.Control,
  module Cornea,
  module Data.Default,
  module Data.Foldable,
  module Relude,
  dbg,
  dbgs,
  dbgm,
  dbgWith,
  dbgmWith,
  makeClassy,
  mapLeft,
  tuple,
  undefined,
  unit,
  unsafeLogAnd,
  unsafeLogS,
  unsafeLogSAnd,
  throwText,
  (<$$>),
) where

import Control.Lens (makeClassy)
import Control.Monad.Base (MonadBase(..))
import Control.Monad.Trans.Control (MonadBaseControl(..))
import Control.Monad.Trans.Resource.Internal (ResourceT(ResourceT))
import Cornea
import Data.Default (Default(def))
import Data.Either.Combinators (mapLeft)
import Data.Foldable (foldl, traverse_)
import Data.Functor.Syntax ((<$$>))
import GHC.Err (undefined)
import GHC.IO.Unsafe (unsafePerformIO)
import Relude hiding (Type, ask, asks, get, gets, hoistEither, hoistMaybe, local, modify, put, state, undefined)
import System.IO.Error (ioError, userError)

dbg :: Monad m => Text -> m ()
dbg :: Text -> m ()
dbg Text
msg = do
  () <- () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> m ()) -> () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> ()
forall a. IO a -> a
unsafePerformIO (String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Text -> String
forall a. ToString a => a -> String
toString Text
msg))
  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

dbgs :: Monad m => Show a => a -> m ()
dbgs :: a -> m ()
dbgs =
  Text -> m ()
forall (m :: * -> *). Monad m => Text -> m ()
dbg (Text -> m ()) -> (a -> Text) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall b a. (Show a, IsString b) => a -> b
show

dbgm :: Monad m => Show a => m a -> m a
dbgm :: m a -> m a
dbgm m a
ma = do
  a
a <- m a
ma
  a
a a -> m () -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ a -> m ()
forall (m :: * -> *) a. (Monad m, Show a) => a -> m ()
dbgs a
a

dbgWith ::
  Monad m =>
  Show b =>
  (a -> b) ->
  a ->
  m a
dbgWith :: (a -> b) -> a -> m a
dbgWith a -> b
f a
a =
  a
a a -> m () -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ b -> m ()
forall (m :: * -> *) a. (Monad m, Show a) => a -> m ()
dbgs (a -> b
f a
a)

dbgmWith ::
  Monad m =>
  Show b =>
  (a -> b) ->
  m a ->
  m a
dbgmWith :: (a -> b) -> m a -> m a
dbgmWith a -> b
f m a
ma = do
  a
a <- m a
ma
  a
a a -> m () -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ b -> m ()
forall (m :: * -> *) a. (Monad m, Show a) => a -> m ()
dbgs (a -> b
f a
a)

unit ::
  Applicative f =>
  f ()
unit :: f ()
unit =
  () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

tuple ::
  Applicative f =>
  f a ->
  f b ->
  f (a, b)
tuple :: f a -> f b -> f (a, b)
tuple f a
fa f b
fb =
  (,) (a -> b -> (a, b)) -> f a -> f (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa f (b -> (a, b)) -> f b -> f (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f b
fb

unsafeLogSAnd :: Show a => a -> b -> b
unsafeLogSAnd :: a -> b -> b
unsafeLogSAnd a
a b
b =
  IO b -> b
forall a. IO a -> a
unsafePerformIO (IO b -> b) -> IO b -> b
forall a b. (a -> b) -> a -> b
$ a -> IO ()
forall a (m :: * -> *). (MonadIO m, Show a) => a -> m ()
print a
a IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

unsafeLogAnd :: Text -> b -> b
unsafeLogAnd :: Text -> b -> b
unsafeLogAnd Text
a b
b =
  IO b -> b
forall a. IO a -> a
unsafePerformIO (IO b -> b) -> IO b -> b
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Text -> String
forall a. ToString a => a -> String
toString Text
a) IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

unsafeLogS :: Show a => a -> a
unsafeLogS :: a -> a
unsafeLogS a
a =
  IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ a -> IO ()
forall a (m :: * -> *). (MonadIO m, Show a) => a -> m ()
print a
a IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

throwText ::
  MonadIO m =>
  Text ->
  m a
throwText :: Text -> m a
throwText =
  IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (Text -> IO a) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> (Text -> IOError) -> Text -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError (String -> IOError) -> (Text -> String) -> Text -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString

instance MonadBase b m => MonadBase b (ResourceT m) where
    liftBase :: b α -> ResourceT m α
liftBase = m α -> ResourceT m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> ResourceT m α) -> (b α -> m α) -> b α -> ResourceT m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance MonadBaseControl b m => MonadBaseControl b (ResourceT m) where
  type StM (ResourceT m) a = StM m a
  liftBaseWith :: (RunInBase (ResourceT m) b -> b a) -> ResourceT m a
liftBaseWith RunInBase (ResourceT m) b -> b a
f = (IORef ReleaseMap -> m a) -> ResourceT m a
forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT ((IORef ReleaseMap -> m a) -> ResourceT m a)
-> (IORef ReleaseMap -> m a) -> ResourceT m a
forall a b. (a -> b) -> a -> b
$ \IORef ReleaseMap
reader' ->
      (RunInBase m b -> b a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m b -> b a) -> m a) -> (RunInBase m b -> b a) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m b
runInBase ->
          RunInBase (ResourceT m) b -> b a
f (RunInBase (ResourceT m) b -> b a)
-> RunInBase (ResourceT m) b -> b a
forall a b. (a -> b) -> a -> b
$ m a -> b (StM m a)
RunInBase m b
runInBase (m a -> b (StM m a))
-> (ResourceT m a -> m a) -> ResourceT m a -> b (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(ResourceT IORef ReleaseMap -> m a
r) -> IORef ReleaseMap -> m a
r IORef ReleaseMap
reader'  )
  restoreM :: StM (ResourceT m) a -> ResourceT m a
restoreM = (IORef ReleaseMap -> m a) -> ResourceT m a
forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT ((IORef ReleaseMap -> m a) -> ResourceT m a)
-> (StM m a -> IORef ReleaseMap -> m a) -> StM m a -> ResourceT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> IORef ReleaseMap -> m a
forall a b. a -> b -> a
const (m a -> IORef ReleaseMap -> m a)
-> (StM m a -> m a) -> StM m a -> IORef ReleaseMap -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM