forked from GitHub/gf-core
gf-server: move some general stuff to FastCGIUtils
This commit is contained in:
@@ -1,6 +1,8 @@
|
|||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
module FastCGIUtils (initFastCGI, loopFastCGI,
|
module FastCGIUtils (initFastCGI, loopFastCGI,
|
||||||
throwCGIError, handleCGIErrors) where
|
throwCGIError, handleCGIErrors,
|
||||||
|
outputJSONP,
|
||||||
|
splitBy) where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
@@ -18,6 +20,10 @@ import System.Time
|
|||||||
|
|
||||||
import Network.FastCGI
|
import Network.FastCGI
|
||||||
|
|
||||||
|
import Text.JSON
|
||||||
|
import qualified Codec.Binary.UTF8.String as UTF8 (encodeString, decodeString)
|
||||||
|
|
||||||
|
|
||||||
initFastCGI :: IO ()
|
initFastCGI :: IO ()
|
||||||
initFastCGI = installSignalHandlers
|
initFastCGI = installSignalHandlers
|
||||||
|
|
||||||
@@ -118,3 +124,26 @@ handleCGIErrors x = x `catchCGI` \e -> case e of
|
|||||||
Nothing -> throw e
|
Nothing -> throw e
|
||||||
Just (CGIError c m t) -> outputError c m t
|
Just (CGIError c m t) -> outputError c m t
|
||||||
_ -> throw e
|
_ -> throw e
|
||||||
|
|
||||||
|
-- * General CGI and JSON stuff
|
||||||
|
|
||||||
|
outputJSONP :: JSON a => a -> CGI CGIResult
|
||||||
|
outputJSONP x =
|
||||||
|
do mc <- getInput "jsonp"
|
||||||
|
let str = case mc of
|
||||||
|
Nothing -> encode x
|
||||||
|
Just c -> c ++ "(" ++ encode x ++ ")"
|
||||||
|
setHeader "Content-Type" "text/json; charset=utf-8"
|
||||||
|
outputStrict $ UTF8.encodeString str
|
||||||
|
|
||||||
|
outputStrict :: String -> CGI CGIResult
|
||||||
|
outputStrict x | x == x = output x
|
||||||
|
| otherwise = fail "I am the pope."
|
||||||
|
|
||||||
|
-- * General utilities
|
||||||
|
|
||||||
|
splitBy :: (a -> Bool) -> [a] -> [[a]]
|
||||||
|
splitBy _ [] = [[]]
|
||||||
|
splitBy f list = case break f list of
|
||||||
|
(first,[]) -> [first]
|
||||||
|
(first,_:rest) -> first : splitBy f rest
|
||||||
@@ -154,26 +154,3 @@ selectLanguage pgf macc = case acceptable of
|
|||||||
|
|
||||||
langCodeLanguage :: PGF -> String -> Maybe PGF.Language
|
langCodeLanguage :: PGF -> String -> Maybe PGF.Language
|
||||||
langCodeLanguage pgf code = listToMaybe [l | l <- PGF.languages pgf, PGF.languageCode pgf l == Just code]
|
langCodeLanguage pgf code = listToMaybe [l | l <- PGF.languages pgf, PGF.languageCode pgf l == Just code]
|
||||||
|
|
||||||
-- * General CGI and JSON stuff
|
|
||||||
|
|
||||||
outputJSONP :: JSON a => a -> CGI CGIResult
|
|
||||||
outputJSONP x =
|
|
||||||
do mc <- getInput "jsonp"
|
|
||||||
let str = case mc of
|
|
||||||
Nothing -> encode x
|
|
||||||
Just c -> c ++ "(" ++ encode x ++ ")"
|
|
||||||
setHeader "Content-Type" "text/json; charset=utf-8"
|
|
||||||
outputStrict $ UTF8.encodeString str
|
|
||||||
|
|
||||||
outputStrict :: String -> CGI CGIResult
|
|
||||||
outputStrict x | x == x = output x
|
|
||||||
| otherwise = fail "I am the pope."
|
|
||||||
|
|
||||||
-- * General utilities
|
|
||||||
|
|
||||||
splitBy :: (a -> Bool) -> [a] -> [[a]]
|
|
||||||
splitBy _ [] = [[]]
|
|
||||||
splitBy f list = case break f list of
|
|
||||||
(first,[]) -> [first]
|
|
||||||
(first,_:rest) -> first : splitBy f rest
|
|
||||||
Reference in New Issue
Block a user