{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Polysemy.Test.Prelude (
  module Polysemy.Test.Prelude,
  module Data.Either.Combinators,
  module Data.Foldable,
  module Data.Map.Strict,
  module Data.String.Interpolate,
  module Debug.Trace,
  module GHC.Err,
  module Polysemy,
  module Polysemy.AtomicState,
  module Polysemy.Error,
  module Polysemy.Internal.Bundle,
  module Polysemy.Reader,
  module Polysemy.State,
  module Relude,
) where

import Control.Exception (throwIO, try)
import Data.Either.Combinators (mapLeft)
import Data.Foldable (foldl, traverse_)
import Data.Map.Strict (Map, lookup)
import Data.String.Interpolate (i)
import qualified Data.Text as Text
import Debug.Trace (trace, traceShow)
import GHC.Err (undefined)
import GHC.IO.Unsafe (unsafePerformIO)
import Polysemy (
  Effect,
  EffectRow,
  Embed,
  Final,
  InterpreterFor,
  Member,
  Members,
  Sem,
  WithTactics,
  embed,
  embedToFinal,
  interpret,
  makeSem,
  pureT,
  raise,
  raiseUnder,
  raiseUnder2,
  raiseUnder3,
  reinterpret,
  runFinal,
  )
import Polysemy.AtomicState (AtomicState, atomicGet, atomicGets, atomicModify', atomicPut, runAtomicStateTVar)
import Polysemy.Error (Error, fromEither, mapError, note, runError, throw)
import Polysemy.Internal.Bundle (Append)
import Polysemy.Reader (Reader)
import Polysemy.State (State, evalState, get, gets, modify, modify', put, runState)
import Relude hiding (
  Reader,
  State,
  Type,
  ask,
  asks,
  evalState,
  filterM,
  get,
  gets,
  hoistEither,
  modify,
  modify',
  put,
  readFile,
  runReader,
  runState,
  state,
  trace,
  traceShow,
  undefined,
  )
import System.IO.Error (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 ()
{-# INLINE dbg #-}

dbgs :: Monad m => Show a => a -> m ()
dbgs :: a -> m ()
dbgs a
a =
  Text -> m ()
forall (m :: * -> *). Monad m => Text -> m ()
dbg (a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
a)
{-# INLINE dbgs_ #-}

dbgs_ :: Monad m => Show a => a -> m a
dbgs_ :: a -> m a
dbgs_ a
a =
  a
a a -> m () -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m ()
forall (m :: * -> *). Monad m => Text -> m ()
dbg (a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
a)
{-# INLINE dbgs #-}

unit ::
  Applicative f =>
  f ()
unit :: f ()
unit =
  () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE unit #-}

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
{-# INLINE tuple #-}

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
{-# INLINE unsafeLogSAnd #-}

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
{-# INLINE unsafeLogAnd #-}

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
{-# INLINE unsafeLogS #-}

liftT ::
  forall m f r e a .
  Functor f =>
  Sem r a ->
  Sem (WithTactics e f m r) (f a)
liftT :: Sem r a -> Sem (WithTactics e f m r) (f a)
liftT =
  a -> Sem (WithTactics e f m r) (f a)
forall a (e :: Effect) (m :: * -> *) (r :: [Effect]).
a -> Tactical e m r a
pureT (a -> Sem (WithTactics e f m r) (f a))
-> (Sem r a -> Sem (WithTactics e f m r) a)
-> Sem r a
-> Sem (WithTactics e f m r) (f a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Sem r a -> Sem (WithTactics e f m r) a
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise
{-# INLINE liftT #-}

hoistEither ::
  Member (Error e2) r =>
  (e1 -> e2) ->
  Either e1 a ->
  Sem r a
hoistEither :: (e1 -> e2) -> Either e1 a -> Sem r a
hoistEither e1 -> e2
f =
  Either e2 a -> Sem r a
forall e (r :: [Effect]) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either e2 a -> Sem r a)
-> (Either e1 a -> Either e2 a) -> Either e1 a -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e1 -> e2) -> Either e1 a -> Either e2 a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft e1 -> e2
f
{-# INLINE hoistEither #-}

hoistEitherWith ::
  (e -> Sem r a) ->
  Either e a ->
  Sem r a
hoistEitherWith :: (e -> Sem r a) -> Either e a -> Sem r a
hoistEitherWith e -> Sem r a
f =
  (e -> Sem r a) -> (a -> Sem r a) -> Either e a -> Sem r a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Sem r a
f a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE hoistEitherWith #-}

hoistEitherShow ::
  Show e1 =>
  Member (Error e2) r =>
  (Text -> e2) ->
  Either e1 a ->
  Sem r a
hoistEitherShow :: (Text -> e2) -> Either e1 a -> Sem r a
hoistEitherShow Text -> e2
f =
  Either e2 a -> Sem r a
forall e (r :: [Effect]) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either e2 a -> Sem r a)
-> (Either e1 a -> Either e2 a) -> Either e1 a -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e1 -> e2) -> Either e1 a -> Either e2 a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (Text -> e2
f (Text -> e2) -> (e1 -> Text) -> e1 -> e2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
Text.replace Text
"\\" Text
"" (Text -> Text) -> (e1 -> Text) -> e1 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> Text
forall b a. (Show a, IsString b) => a -> b
show)
{-# INLINE hoistEitherShow #-}

hoistErrorWith ::
  (e -> Sem r a) ->
  Sem (Error e : r) a ->
  Sem r a
hoistErrorWith :: (e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
hoistErrorWith e -> Sem r a
f =
  (e -> Sem r a) -> Either e a -> Sem r a
forall e (r :: [Effect]) a. (e -> Sem r a) -> Either e a -> Sem r a
hoistEitherWith e -> Sem r a
f (Either e a -> Sem r a)
-> (Sem (Error e : r) a -> Sem r (Either e a))
-> Sem (Error e : r) a
-> Sem r a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Sem (Error e : r) a -> Sem r (Either e a)
forall e (r :: [Effect]) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError
{-# INLINE hoistErrorWith #-}

tryAny ::
  Member (Embed IO) r =>
  IO a ->
  Sem r (Either Text a)
tryAny :: IO a -> Sem r (Either Text a)
tryAny =
  IO (Either Text a) -> Sem r (Either Text a)
forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either Text a) -> Sem r (Either Text a))
-> (IO a -> IO (Either Text a)) -> IO a -> Sem r (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either SomeException a -> Either Text a)
-> IO (Either SomeException a) -> IO (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SomeException -> Text) -> Either SomeException a -> Either Text a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft SomeException -> Text
forall b a. (Show a, IsString b) => a -> b
show) (IO (Either SomeException a) -> IO (Either Text a))
-> (IO a -> IO (Either SomeException a))
-> IO a
-> IO (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Exception SomeException =>
IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException
{-# INLINE tryAny #-}

tryHoist ::
  Member (Embed IO) r =>
  (Text -> e) ->
  IO a ->
  Sem r (Either e a)
tryHoist :: (Text -> e) -> IO a -> Sem r (Either e a)
tryHoist Text -> e
f =
  (Either Text a -> Either e a)
-> Sem r (Either Text a) -> Sem r (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> e) -> Either Text a -> Either e a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> e
f) (Sem r (Either Text a) -> Sem r (Either e a))
-> (IO a -> Sem r (Either Text a)) -> IO a -> Sem r (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Sem r (Either Text a)
forall (r :: [Effect]) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny
{-# INLINE tryHoist #-}

tryThrow ::
  Members [Embed IO, Error e] r =>
  (Text -> e) ->
  IO a ->
  Sem r a
tryThrow :: (Text -> e) -> IO a -> Sem r a
tryThrow Text -> e
f =
  Either e a -> Sem r a
forall e (r :: [Effect]) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either e a -> Sem r a)
-> (IO a -> Sem r (Either e a)) -> IO a -> Sem r a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Text -> e) -> IO a -> Sem r (Either e a)
forall (r :: [Effect]) e a.
Member (Embed IO) r =>
(Text -> e) -> IO a -> Sem r (Either e a)
tryHoist Text -> e
f
{-# INLINE tryThrow #-}

throwTextIO :: Text -> IO a
throwTextIO :: Text -> IO a
throwTextIO =
  IOError -> IO a
forall e a. Exception e => e -> IO a
throwIO (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
{-# INLINE throwTextIO #-}

throwEitherIO :: Either Text a -> IO a
throwEitherIO :: Either Text a -> IO a
throwEitherIO =
  (Text -> IO a) -> Either Text a -> IO a
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
traverseLeft Text -> IO a
forall a. Text -> IO a
throwTextIO
{-# INLINE throwEitherIO #-}

type a ++ b =
  Append a b

rightOr :: (a -> b) -> Either a b -> b
rightOr :: (a -> b) -> Either a b -> b
rightOr a -> b
f =
  (a -> b) -> (b -> b) -> Either a b -> b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> b
f b -> b
forall a. a -> a
id
{-# INLINE rightOr #-}

traverseLeft ::
  Applicative m =>
  (a -> m b) ->
  Either a b ->
  m b
traverseLeft :: (a -> m b) -> Either a b -> m b
traverseLeft a -> m b
f =
  (a -> m b) -> (b -> m b) -> Either a b -> m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m b
f b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE traverseLeft #-}

as ::
  Functor m =>
  a ->
  m b ->
  m a
as :: a -> m b -> m a
as =
  a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$)
{-# INLINE as #-}

mneToList :: Maybe (NonEmpty a) -> [a]
mneToList :: Maybe (NonEmpty a) -> [a]
mneToList =
  [a] -> (NonEmpty a -> [a]) -> Maybe (NonEmpty a) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# INLINE mneToList #-}