{-# options_haddock hide #-}
{-# 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,
InterpretersFor,
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 (f :: * -> *) a (e :: Effect) (m :: * -> *) (r :: [Effect]).
Functor f =>
a -> Sem (WithTactics e f m r) (f 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