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

ghc-7.6: fix src/server/PGFService.hs (use catch from base-4 Control.Exception)

Browse Source
This commit is contained in:
Sergei Trofimovich
2013-03-09 21:38:14 +00:00
parent 8d00819790
commit 6898804a11
1 changed files with 6 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
src/server/PGFService.hs
View File

@@ -16,7 +16,7 @@ import qualified Codec.Binary.UTF8.String as UTF8 (decodeString)
import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy as BS
import Control.Concurrent import Control.Concurrent
import Control.Exception(evaluate) import qualified Control.Exception as E
import Control.Monad import Control.Monad
import Control.Monad.State(State,evalState,get,put) import Control.Monad.State(State,evalState,get,put)
import Data.Char import Data.Char
@@ -31,6 +31,9 @@ import System.IO
import System.Directory(removeFile) import System.Directory(removeFile)
import Fold(fold) -- transfer function for OpenMath LaTeX import Fold(fold) -- transfer function for OpenMath LaTeX
catchIOE :: IO a -> (E.IOException -> IO a) -> IO a
catchIOE = E.catch
logFile :: FilePath logFile :: FilePath
logFile = "pgf-error.log" logFile = "pgf-error.log"
@@ -154,7 +157,7 @@ doExternal Nothing input = throwCGIError 400 "Unknown external command" ["Unknow
doExternal (Just cmd) input = doExternal (Just cmd) input =
do liftIO $ logError ("External command: "++cmd) do liftIO $ logError ("External command: "++cmd)
cmds <- liftIO $ (fmap lines $ readFile "external_services") cmds <- liftIO $ (fmap lines $ readFile "external_services")
`catch` const (return []) `catchIOE` const (return [])
liftIO $ logError ("External services: "++show cmds) liftIO $ logError ("External services: "++show cmds)
if cmd `elem` cmds then ok else err if cmd `elem` cmds then ok else err
where where
@@ -357,7 +360,7 @@ pipeIt2graphviz format code = do
-- fork off a thread to start consuming the output -- fork off a thread to start consuming the output
output <- BS.hGetContents outh output <- BS.hGetContents outh
outMVar <- newEmptyMVar outMVar <- newEmptyMVar
_ <- forkIO $ evaluate (BS.length output) >> putMVar outMVar () _ <- forkIO $ E.evaluate (BS.length output) >> putMVar outMVar ()
-- now write and flush any input -- now write and flush any input
hPutStr inh code hPutStr inh code