GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-24 03:52:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

Fix a few warnings

Browse Source
This commit is contained in:
Andreas Källberg
2020-08-05 17:38:21 +02:00
parent 0581d6827e
commit 3bd1f01959
2 changed files with 7 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/server/CGI.hs
View File

@@ -4,7 +4,7 @@ import Network.CGI as C(
CGI,ContentType(..),Accept(..),Language(..), CGI,ContentType(..),Accept(..),Language(..),
getVarWithDefault,readInput,negotiate,requestAcceptLanguage,getInput, getVarWithDefault,readInput,negotiate,requestAcceptLanguage,getInput,
setHeader,output,outputFPS,outputError, setHeader,output,outputFPS,outputError,
handleErrors,catchCGI,throwCGI, handleErrors,
liftIO) liftIO)
import Network.CGI.Protocol as C(CGIResult(..),CGIRequest(..),Input(..), import Network.CGI.Protocol as C(CGIResult(..),CGIRequest(..),Input(..),
Headers,HeaderName(..)) Headers,HeaderName(..))

9
src/server/CGIUtils.hs
View File

@@ -15,11 +15,14 @@ import System.Posix
#endif #endif
import CGI(CGI,CGIResult,setHeader,output,outputFPS,outputError, import CGI(CGI,CGIResult,setHeader,output,outputFPS,outputError,
getInput,catchCGI,throwCGI) getInput)
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 qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy as BS
import Control.Monad.Catch (MonadThrow(throwM))
import Network.CGI.Monad (catchCGI)
import Control.Monad.Catch (MonadCatch(catch))
-- * Logging -- * Logging
@@ -53,11 +56,11 @@ instance Exception CGIError where
fromException (SomeException e) = cast e fromException (SomeException e) = cast e
throwCGIError :: Int -> String -> [String] -> CGI a throwCGIError :: Int -> String -> [String] -> CGI a
throwCGIError c m t = throwCGI $ toException $ CGIError c m t throwCGIError c m t = throwM $ toException $ CGIError c m t
handleCGIErrors :: CGI CGIResult -> CGI CGIResult handleCGIErrors :: CGI CGIResult -> CGI CGIResult
handleCGIErrors x = handleCGIErrors x =
x `catchCGI` \e -> case fromException e of x `catch` \e -> case fromException e of
Nothing -> throw e Nothing -> throw e
Just (CGIError c m t) -> do setXO; outputError c m t Just (CGIError c m t) -> do setXO; outputError c m t