diff options
| author | krangelov <kr.angelov@gmail.com> | 2021-07-26 16:52:11 +0200 |
|---|---|---|
| committer | krangelov <kr.angelov@gmail.com> | 2021-07-26 16:52:11 +0200 |
| commit | e47042424ee2450c69c509601ddc3c1cc8cd9a39 (patch) | |
| tree | 5cfad2acca46f8c9aafa3a5f97600ae26bbe0e1c /src/compiler/GF/Server.hs | |
| parent | ecf309a28e9935923308da4b6aa2b1cc6c4b52e2 (diff) | |
| parent | d0a881f9038d2ca1620e0d95f90c297a452774d5 (diff) | |
Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core
Diffstat (limited to 'src/compiler/GF/Server.hs')
| -rw-r--r-- | src/compiler/GF/Server.hs | 13 |
1 files changed, 5 insertions, 8 deletions
diff --git a/src/compiler/GF/Server.hs b/src/compiler/GF/Server.hs index c287e8001..2e8b8b056 100644 --- a/src/compiler/GF/Server.hs +++ b/src/compiler/GF/Server.hs @@ -6,7 +6,7 @@ import qualified Data.Map as M import Control.Applicative -- for GHC<7.10 import Control.Monad(when) import Control.Monad.State(StateT(..),get,gets,put) -import Control.Monad.Error(ErrorT(..),Error(..)) +import Control.Monad.Except(ExceptT(..),runExceptT) import System.Random(randomRIO) --import System.IO(stderr,hPutStrLn) import GF.System.Catch(try) @@ -108,9 +108,9 @@ handle_fcgi execute1 state0 stateM cache = -- * Request handler -- | Handler monad -type HM s a = StateT (Q,s) (ErrorT Response IO) a +type HM s a = StateT (Q,s) (ExceptT Response IO) a run :: HM s Response -> (Q,s) -> IO (s,Response) -run m s = either bad ok =<< runErrorT (runStateT m s) +run m s = either bad ok =<< runExceptT (runStateT m s) where bad resp = return (snd s,resp) ok (resp,(qs,state)) = return (state,resp) @@ -123,12 +123,12 @@ put_qs qs = do state <- get_state; put (qs,state) put_state state = do qs <- get_qs; put (qs,state) err :: Response -> HM s a -err e = StateT $ \ s -> ErrorT $ return $ Left e +err e = StateT $ \ s -> ExceptT $ return $ Left e hmbracket_ :: IO () -> IO () -> HM s a -> HM s a hmbracket_ pre post m = do s <- get - e <- liftIO $ bracket_ pre post $ runErrorT $ runStateT m s + e <- liftIO $ bracket_ pre post $ runExceptT $ runStateT m s case e of Left resp -> err resp Right (a,s) -> do put s;return a @@ -407,9 +407,6 @@ resp404 path = Response 404 [plain,xo] $ "Not found: "++path++"\n" resp500 msg = Response 500 [plain,xo] $ "Internal error: "++msg++"\n" resp501 msg = Response 501 [plain,xo] $ "Not implemented: "++msg++"\n" -instance Error Response where - noMsg = resp500 "no message" - strMsg = resp500 -- * Content types plain = ct "text/plain" "" |
