diff options
| -rw-r--r-- | src/Cana/Extra.hs | 12 |
1 files changed, 10 insertions, 2 deletions
diff --git a/src/Cana/Extra.hs b/src/Cana/Extra.hs index 6076155..f4d9f73 100644 --- a/src/Cana/Extra.hs +++ b/src/Cana/Extra.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, PartialTypeSignatures #-} -- | -- Module : Cana.Extra -- @@ -18,6 +18,7 @@ import Cana.Monad import Control.Applicative import Control.Monad import Control.Monad.Trans.Maybe +import Control.Exception (SomeException, try) import Data.String import Data.Maybe @@ -100,9 +101,12 @@ runCGI :: FilePath -- ^ CGI script -> [String] -- ^ Script arguments -> Handler runCGI script args request = do - (code, stdout, stderr) <- liftIO + (scriptResult :: Either SomeException rest_) <- liftIO . try $ readProcessWithExitCode script args (show $ requestUri request) + (code, stdout, stderr) <- except + $ mapLeft (\e -> "CGI execution error: " ++ show e) scriptResult + case code of ExitFailure _ -> do logError ("CGI script " ++ script ++ " exited with an error:") @@ -122,3 +126,7 @@ runCGI script args request = do , responseMeta = "Dynamic content generation has failed" , responseData = "" } + + mapLeft :: (a -> b) -> Either a c -> Either b c + mapLeft f (Left x) = Left (f x) + mapLeft _ (Right x) = Right x |