{-# LANGUAGE FieldSelectors #-}

module Conduit.App.Monad where

import Conduit.App.Env (Env)
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ActionT)
import Conduit.Errors (FeatureError, handleFeatureErrors)

-- | The app monad. woo.
newtype AppM a = AppM
  { forall a. AppM a -> ReaderT Env IO a
runAppM :: ReaderT Env IO a
  } deriving newtype ((forall a b. (a -> b) -> AppM a -> AppM b)
-> (forall a b. a -> AppM b -> AppM a) -> Functor AppM
forall a b. a -> AppM b -> AppM a
forall a b. (a -> b) -> AppM a -> AppM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> AppM a -> AppM b
fmap :: forall a b. (a -> b) -> AppM a -> AppM b
$c<$ :: forall a b. a -> AppM b -> AppM a
<$ :: forall a b. a -> AppM b -> AppM a
Functor, Functor AppM
Functor AppM
-> (forall a. a -> AppM a)
-> (forall a b. AppM (a -> b) -> AppM a -> AppM b)
-> (forall a b c. (a -> b -> c) -> AppM a -> AppM b -> AppM c)
-> (forall a b. AppM a -> AppM b -> AppM b)
-> (forall a b. AppM a -> AppM b -> AppM a)
-> Applicative AppM
forall a. a -> AppM a
forall a b. AppM a -> AppM b -> AppM a
forall a b. AppM a -> AppM b -> AppM b
forall a b. AppM (a -> b) -> AppM a -> AppM b
forall a b c. (a -> b -> c) -> AppM a -> AppM b -> AppM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> AppM a
pure :: forall a. a -> AppM a
$c<*> :: forall a b. AppM (a -> b) -> AppM a -> AppM b
<*> :: forall a b. AppM (a -> b) -> AppM a -> AppM b
$cliftA2 :: forall a b c. (a -> b -> c) -> AppM a -> AppM b -> AppM c
liftA2 :: forall a b c. (a -> b -> c) -> AppM a -> AppM b -> AppM c
$c*> :: forall a b. AppM a -> AppM b -> AppM b
*> :: forall a b. AppM a -> AppM b -> AppM b
$c<* :: forall a b. AppM a -> AppM b -> AppM a
<* :: forall a b. AppM a -> AppM b -> AppM a
Applicative, Applicative AppM
Applicative AppM
-> (forall a b. AppM a -> (a -> AppM b) -> AppM b)
-> (forall a b. AppM a -> AppM b -> AppM b)
-> (forall a. a -> AppM a)
-> Monad AppM
forall a. a -> AppM a
forall a b. AppM a -> AppM b -> AppM b
forall a b. AppM a -> (a -> AppM b) -> AppM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. AppM a -> (a -> AppM b) -> AppM b
>>= :: forall a b. AppM a -> (a -> AppM b) -> AppM b
$c>> :: forall a b. AppM a -> AppM b -> AppM b
>> :: forall a b. AppM a -> AppM b -> AppM b
$creturn :: forall a. a -> AppM a
return :: forall a. a -> AppM a
Monad, Monad AppM
Monad AppM -> (forall a. IO a -> AppM a) -> MonadIO AppM
forall a. IO a -> AppM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> AppM a
liftIO :: forall a. IO a -> AppM a
MonadIO, MonadReader Env, MonadIO AppM
MonadIO AppM
-> (forall b. ((forall a. AppM a -> IO a) -> IO b) -> AppM b)
-> MonadUnliftIO AppM
forall b. ((forall a. AppM a -> IO a) -> IO b) -> AppM b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall b. ((forall a. AppM a -> IO a) -> IO b) -> AppM b
withRunInIO :: forall b. ((forall a. AppM a -> IO a) -> IO b) -> AppM b
MonadUnliftIO)

-- | Lifts computations to the app monad level. @(MonadApp m)@ shouldn't be used directly as a constraint;
--   Rather, just use @liftApp@ and see 'Conduit.App.Has.Has'.
class (Monad m) => MonadApp m where
  liftApp :: AppM a -> m a

instance MonadApp AppM where
  liftApp :: AppM a -> AppM a
  liftApp :: forall a. AppM a -> AppM a
liftApp = AppM a -> AppM a
forall a. a -> a
id
  {-# INLINE liftApp #-}

instance MonadApp (ActionT AppM) where
  liftApp :: AppM a -> ActionT AppM a
  liftApp :: forall a. AppM a -> ActionT AppM a
liftApp = AppM a -> ActionT AppM a
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
  {-# INLINE liftApp #-}

-- | Runs a service in the App monad and converts its potentially failed result to the appropriate error if neccesary.
-- 
-- > data MyErr = Aw Text
-- > data MyResult = Yay Text deriving (Generic, ToJSON)
-- > 
-- > instance FeatureError MyErr where
-- >   handleFeatureError (ResultErr msg) = do 
-- >     status status500
-- >     text msg
-- > 
-- > endpoint = get "/" $ do
-- >   (result :: MyResult) <- runService (someAppService :: AppM (Either MyErr MyResult))
-- >   json result
runService :: (FeatureError e) => AppM (Either e a) -> ActionT AppM a
runService :: forall e a. FeatureError e => AppM (Either e a) -> ActionT AppM a
runService = AppM (Either e a) -> ActionT AppM (Either e a)
forall a. AppM a -> ActionT AppM a
forall (m :: * -> *) a. MonadApp m => AppM a -> m a
liftApp (AppM (Either e a) -> ActionT AppM (Either e a))
-> (Either e a -> ActionT AppM a)
-> AppM (Either e a)
-> ActionT AppM a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (e -> ActionT AppM a)
-> (a -> ActionT AppM a) -> Either e a -> ActionT AppM a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> ActionT AppM a
forall (m :: * -> *) e a.
(MonadUnliftIO m, FeatureError e) =>
e -> ActionT m a
handleFeatureErrors a -> ActionT AppM a
forall a. a -> ActionT AppM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure