Move CGIError stuff to FastCGIUtils.

1 files changed, 21 insertions, 2 deletions

diff --git a/src/server/FastCGIUtils.hs b/src/server/FastCGIUtils.hs
index 762127f7c..2cf64af91 100644
--- a/src/server/FastCGIUtils.hs
+++ b/src/server/FastCGIUtils.hs
@@ -1,9 +1,12 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 module FastCGIUtils (initFastCGI, loopFastCGI,
-                     DataRef, newDataRef, getData) where
+                     DataRef, newDataRef, getData,
+                     throwCGIError, handleCGIErrors) where
 
 import Control.Concurrent
 import Control.Exception
 import Control.Monad
+import Data.Dynamic
 import Data.IORef
 import Prelude hiding (catch)
 import System.Directory
@@ -14,6 +17,7 @@ import System.IO.Unsafe
 import System.Posix
 import System.Time
 
+
 import Network.FastCGI
 
 initFastCGI :: IO ()
@@ -119,4 +123,19 @@ getData loadData ref file = liftIO $
 -- Logging
 
 logError :: String -> IO ()
-logError s = hPutStrLn stderr s
\ No newline at end of file
+logError s = hPutStrLn stderr s
+
+-- * General CGI Error exception mechanism
+
+data CGIError = CGIError { cgiErrorCode :: Int, cgiErrorMessage :: String, cgiErrorText :: [String] }
+                deriving Typeable
+
+throwCGIError :: Int -> String -> [String] -> CGI a
+throwCGIError c m t = throwCGI $ DynException $ toDyn $ CGIError c m t
+
+handleCGIErrors :: CGI CGIResult -> CGI CGIResult
+handleCGIErrors x = x `catchCGI` \e -> case e of
+                                         DynException d -> case fromDynamic d of
+                                                             Nothing -> throw e
+                                                             Just (CGIError c m t) -> outputError c m t
+                                         _ -> throw e