mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 19:22:50 -06:00
Move CGIError stuff to FastCGIUtils.
This commit is contained in:
@@ -1,9 +1,12 @@
|
|||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
module FastCGIUtils (initFastCGI, loopFastCGI,
|
module FastCGIUtils (initFastCGI, loopFastCGI,
|
||||||
DataRef, newDataRef, getData) where
|
DataRef, newDataRef, getData,
|
||||||
|
throwCGIError, handleCGIErrors) where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Data.Dynamic
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
import Prelude hiding (catch)
|
import Prelude hiding (catch)
|
||||||
import System.Directory
|
import System.Directory
|
||||||
@@ -14,6 +17,7 @@ import System.IO.Unsafe
|
|||||||
import System.Posix
|
import System.Posix
|
||||||
import System.Time
|
import System.Time
|
||||||
|
|
||||||
|
|
||||||
import Network.FastCGI
|
import Network.FastCGI
|
||||||
|
|
||||||
initFastCGI :: IO ()
|
initFastCGI :: IO ()
|
||||||
@@ -119,4 +123,19 @@ getData loadData ref file = liftIO $
|
|||||||
-- Logging
|
-- Logging
|
||||||
|
|
||||||
logError :: String -> IO ()
|
logError :: String -> IO ()
|
||||||
logError s = hPutStrLn stderr s
|
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
|
||||||
|
|||||||
@@ -9,9 +9,7 @@ import Network.CGI
|
|||||||
import Text.JSON
|
import Text.JSON
|
||||||
import qualified Codec.Binary.UTF8.String as UTF8 (encodeString)
|
import qualified Codec.Binary.UTF8.String as UTF8 (encodeString)
|
||||||
|
|
||||||
import Control.Exception
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Dynamic
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
||||||
@@ -127,21 +125,6 @@ linearize' pgf mto tree =
|
|||||||
Nothing -> PGF.linearizeAllLang pgf tree
|
Nothing -> PGF.linearizeAllLang pgf tree
|
||||||
Just to -> [(to,PGF.linearize pgf to tree)]
|
Just to -> [(to,PGF.linearize pgf to tree)]
|
||||||
|
|
||||||
-- * 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
|
|
||||||
|
|
||||||
-- * General CGI and JSON stuff
|
-- * General CGI and JSON stuff
|
||||||
|
|
||||||
outputJSON :: JSON a => a -> CGI CGIResult
|
outputJSON :: JSON a => a -> CGI CGIResult
|
||||||
|
|||||||
Reference in New Issue
Block a user