summaryrefslogtreecommitdiff
path: root/src/compiler/GF
diff options
context:
space:
mode:
authorInari Listenmaa <inari.listenmaa@gmail.com>2021-06-29 23:48:00 +0200
committerGitHub <noreply@github.com>2021-06-29 23:48:00 +0200
commit6efbd23c5cf450f3702e628225872650a619270f (patch)
treefbe74bc715730c2932da4e6d7492942beaecd1c0 /src/compiler/GF
parent3a27fa0d390b86cab3ecc68418e4116ea5c4f8ba (diff)
parent76bec6d71e7c4fdffa2e618ec6578e0858166465 (diff)
Merge pull request #84 from ffrixslee/issue-46
Issue 46 (various deprecations during compilation of GF)
Diffstat (limited to 'src/compiler/GF')
-rw-r--r--src/compiler/GF/Compile/Compute/ConcreteNew.hs2
-rw-r--r--src/compiler/GF/Grammar/Canonical.hs1
-rw-r--r--src/compiler/GF/Server.hs13
3 files changed, 6 insertions, 10 deletions
diff --git a/src/compiler/GF/Compile/Compute/ConcreteNew.hs b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
index ea55e77cb..6f00c45e1 100644
--- a/src/compiler/GF/Compile/Compute/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
@@ -528,7 +528,7 @@ value2term' stop loc xs v0 =
-- VGlue v1 v2 -> Glue (v2t v1) (v2t v2)
-- VExtR v1 v2 -> ExtR (v2t v1) (v2t v2)
VError err -> return (Error err)
- _ -> bug ("value2term "++show loc++" : "++show v0)
+
where
v2t = v2txs xs
v2txs = value2term' stop loc
diff --git a/src/compiler/GF/Grammar/Canonical.hs b/src/compiler/GF/Grammar/Canonical.hs
index 4adff02f2..0df3236ff 100644
--- a/src/compiler/GF/Grammar/Canonical.hs
+++ b/src/compiler/GF/Grammar/Canonical.hs
@@ -265,7 +265,6 @@ instance PPA LinPattern where
RecordPattern r -> block r
TuplePattern ps -> "<"<>punctuate "," ps<>">"
WildPattern -> pp "_"
- _ -> parens p
instance RhsSeparator LinPattern where rhsSep _ = pp "="
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" ""