Fix error handling in pure runtimes

src/AWS/Lambda/Combinators.hs

@@ -13,11 +13,12 @@ They map functions (instead of values) to turn basic handlers into handlers comp
 
 module AWS.Lambda.Combinators (
     withoutContext,
-    withInfallibleParse
+    withInfallibleParse,
+    withInfallibleParseEither
 ) where
 
-import           Data.Aeson             (FromJSON, parseJSON, Value)
-import           Data.Aeson.Types       (parseEither)
+import           Data.Aeson       (FromJSON, Value, parseJSON)
+import           Data.Aeson.Types (parseEither)
 
 -- | An alias of 'const', this upgrades a handler that does not accept
 -- 'AWS.Lambda.Context.LambdaContext' as its first curried argument to one that does.
@@ -70,3 +71,6 @@ withoutContext = const
 -- on a failure to convert the JSON AST sent to the Lambda.
 withInfallibleParse :: FromJSON a => (a -> b) -> Value -> b
 withInfallibleParse fn = either error fn . parseEither parseJSON
+
+withInfallibleParseEither :: FromJSON a => (a -> b) -> Value -> Either String b
+withInfallibleParseEither fn = fmap fn . parseEither parseJSON

src/AWS/Lambda/Context.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE NamedFieldPuns, OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns    #-}
+
 
 {-|
 Module      : AWS.Lambda.Context
@@ -21,8 +22,8 @@ import           Control.Monad.IO.Class (MonadIO, liftIO)
 import           Data.Aeson             (FromJSON, ToJSON)
 import           Data.Map               (Map)
 import           Data.Text              (Text)
-import           Data.Time.Clock        (DiffTime, UTCTime,
-                                         diffUTCTime, getCurrentTime)
+import           Data.Time.Clock        (DiffTime, UTCTime, diffUTCTime,
+                                         getCurrentTime)
 import           GHC.Generics           (Generic)
 
 data ClientApplication = ClientApplication

src/AWS/Lambda/Runtime.hs

@@ -29,9 +29,12 @@ module AWS.Lambda.Runtime (
   mRuntimeWithContext
 ) where
 
-import           AWS.Lambda.Combinators   (withInfallibleParse)
-import           AWS.Lambda.Context       (LambdaContext(..))
+import           AWS.Lambda.Combinators   (withInfallibleParse,
+                                           withInfallibleParseEither,
+                                           withoutContext)
+import           AWS.Lambda.Context       (LambdaContext (..))
 import qualified AWS.Lambda.Runtime.Value as ValueRuntime
+import           Control.Monad            (join)
 import           Control.Monad.Catch      (MonadCatch)
 import           Control.Monad.IO.Class   (MonadIO)
 import           Control.Monad.Reader     (ReaderT)
@@ -253,7 +256,7 @@ ioRuntime = ValueRuntime.ioRuntime . withInfallibleParse
 -- @
 fallibleRuntimeWithContext :: (FromJSON event, ToJSON result) =>
   (LambdaContext -> event -> Either String result) -> IO ()
-fallibleRuntimeWithContext = ValueRuntime.fallibleRuntimeWithContext . fmap withInfallibleParse
+fallibleRuntimeWithContext fn = ValueRuntime.fallibleRuntimeWithContext $ \lc -> join . withInfallibleParseEither (fn lc)
 
 -- | For pure functions that can still fail.
 --
@@ -286,7 +289,7 @@ fallibleRuntimeWithContext = ValueRuntime.fallibleRuntimeWithContext . fmap with
 -- @
 fallibleRuntime :: (FromJSON event, ToJSON result) =>
   (event -> Either String result) -> IO ()
-fallibleRuntime = ValueRuntime.fallibleRuntime . withInfallibleParse
+fallibleRuntime = fallibleRuntimeWithContext . withoutContext
 
 -- | For pure functions that can never fail that also need access to the context.
 --
@@ -318,7 +321,7 @@ fallibleRuntime = ValueRuntime.fallibleRuntime . withInfallibleParse
 -- @
 pureRuntimeWithContext :: (FromJSON event, ToJSON result) =>
   (LambdaContext -> event -> result) -> IO ()
-pureRuntimeWithContext = ValueRuntime.pureRuntimeWithContext . fmap withInfallibleParse
+pureRuntimeWithContext fn = ValueRuntime.fallibleRuntimeWithContext $ withInfallibleParseEither . fn
 
 -- | For pure functions that can never fail.
 --
@@ -345,4 +348,4 @@ pureRuntimeWithContext = ValueRuntime.pureRuntimeWithContext . fmap withInfallib
 -- main = pureRuntime myHandler
 -- @
 pureRuntime :: (FromJSON event, ToJSON result) => (event -> result) -> IO ()
-pureRuntime = ValueRuntime.pureRuntime . withInfallibleParse
+pureRuntime = pureRuntimeWithContext . withoutContext

src/AWS/Lambda/Runtime/Value.hs

@@ -39,12 +39,13 @@ module AWS.Lambda.Runtime.Value (
   mRuntimeWithContext,
 ) where
 
-import           AWS.Lambda.RuntimeClient (RuntimeClientConfig, getRuntimeClientConfig,
-                                           getNextData, sendEventError, sendEventSuccess)
 import           AWS.Lambda.Combinators   (withoutContext)
-import           AWS.Lambda.Context       (LambdaContext(..))
+import           AWS.Lambda.Context       (LambdaContext (..))
+import           AWS.Lambda.RuntimeClient (RuntimeClientConfig, getNextData,
+                                           getRuntimeClientConfig,
+                                           sendEventError, sendEventSuccess)
 import           Control.Exception        (SomeException, displayException)
-import           Control.Monad            ((<=<), forever)
+import           Control.Monad            (forever, (<=<))
 import           Control.Monad.Catch      (MonadCatch, try)
 import           Control.Monad.IO.Class   (MonadIO, liftIO)
 import           Control.Monad.Reader     (ReaderT, runReaderT)
@@ -331,7 +332,7 @@ ioRuntime = ioRuntimeWithContext . withoutContext
 -- @
 fallibleRuntimeWithContext :: ToJSON result =>
   (LambdaContext -> Value -> Either String result) -> IO ()
-fallibleRuntimeWithContext = mRuntimeWithContext . fmap (fmap pure)
+fallibleRuntimeWithContext fn = mRuntimeWithContext (\lc -> either error pure . fn lc)
 
 -- | For pure functions that can still fail.
 --