{-# LANGUAGE NoImplicitPrelude #-}

module Polysemy.Http.Prelude (
  module Polysemy.Http.Prelude,
  module Data.Aeson,
  module Data.Aeson.TH,
  module Data.Composition,
  module Data.Default,
  module Data.Either.Combinators,
  module Data.Foldable,
  module Data.Map.Strict,
  module GHC.Err,
  module Polysemy,
  module Polysemy.State,
  module Polysemy.Error,
  module Relude,
) where

import Control.Exception (try)
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.TH (deriveFromJSON, deriveJSON)
import qualified Data.Aeson.TH as Aeson (Options, defaultOptions, unwrapUnaryRecords)
import Data.Composition ((.:))
import Data.Default (Default(def))
import Data.Either.Combinators (mapLeft)
import Data.Foldable (foldl, traverse_)
import Data.Map.Strict (Map)
import Data.String.Interpolate (i)
import GHC.Err (undefined)
import GHC.IO.Unsafe (unsafePerformIO)
import Language.Haskell.TH.Quote (QuasiQuoter)
import qualified Language.Haskell.TH.Syntax as TH
import Polysemy (
  Effect,
  Embed,
  InterpreterFor,
  Member,
  Members,
  Sem,
  WithTactics,
  embed,
  interpret,
  makeSem,
  pureT,
  raise,
  raiseUnder,
  raiseUnder2,
  raiseUnder3,
  )
import Polysemy.Error (Error, fromEither, runError, throw)
import Polysemy.State (State, evalState, get, gets, modify, put)
import Relude hiding (
  Reader,
  State,
  Type,
  ask,
  asks,
  evalState,
  get,
  gets,
  hoistEither,
  modify,
  put,
  readFile,
  runReader,
  runState,
  state,
  undefined,
  )

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 #-}

qt :: QuasiQuoter
qt :: QuasiQuoter
qt =
  QuasiQuoter
i
{-# INLINE qt #-}

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 #-}

defaultOptions :: Aeson.Options
defaultOptions :: Options
defaultOptions =
  Options
Aeson.defaultOptions { unwrapUnaryRecords :: Bool
Aeson.unwrapUnaryRecords = Bool
True }

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

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

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

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

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 #-}

defaultJson :: TH.Name -> TH.Q [TH.Dec]
defaultJson :: Name -> Q [Dec]
defaultJson =
  Options -> Name -> Q [Dec]
deriveJSON Options
defaultOptions