From e9713d2256757a8746c3391db12684087b4957c1 Mon Sep 17 00:00:00 2001
From: John Millikin <jmillikin@gmail.com>
Date: Sun, 7 Oct 2012 19:07:20 -0700
Subject: [PATCH] Build with GHC 7.6.

---
 lib/Text/XML/LibXML/SAX.hs | 40 +++++++++++++++++++++++++-------------
 libxml-sax.cabal           |  2 +-
 2 files changed, 27 insertions(+), 15 deletions(-)

diff --git a/lib/Text/XML/LibXML/SAX.hs b/lib/Text/XML/LibXML/SAX.hs
index 878a795..e63b8c7 100644
--- a/lib/Text/XML/LibXML/SAX.hs
+++ b/lib/Text/XML/LibXML/SAX.hs
@@ -54,6 +54,13 @@ module Text.XML.LibXML.SAX
 import qualified Control.Exception as E
 import           Control.Monad (when, unless)
 import qualified Control.Monad.ST as ST
+
+#if MIN_VERSION_base(4,4,0)
+import           Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
+#else
+import           Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
+#endif
+
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Unsafe as BU
 import           Data.Char (chr, isDigit)
@@ -61,7 +68,7 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import qualified Data.XML.Types as X
 import           Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import           Foreign hiding (free, void)
+import           Foreign hiding (free)
 import           Foreign.C
 import qualified Foreign.Concurrent as FC
 import           Text.ParserCombinators.ReadP ((+++))
@@ -86,7 +93,7 @@ data Parser m = Parser
 
 newParserIO :: Maybe T.Text -- ^ An optional filename or URI
             -> IO (Parser IO)
-newParserIO filename = E.block $ do
+newParserIO filename = mask $ \_ -> do
 	ref <- newIORef Nothing
 	
 	raw <- maybeWith withUTF8 filename cAllocParser
@@ -99,17 +106,17 @@ newParserIO filename = E.block $ do
 
 newParserST :: Maybe T.Text -- ^ An optional filename or URI
             -> ST.ST s (Parser (ST.ST s))
-newParserST filename = ST.unsafeIOToST $ do
+newParserST filename = unsafeIOToST $ do
 	p <- newParserIO filename
 	return $ p
-		{ parserToIO = ST.unsafeSTToIO
-		, parserFromIO = ST.unsafeIOToST
+		{ parserToIO = unsafeSTToIO
+		, parserFromIO = unsafeIOToST
 		}
 
-parseImpl :: Parser m -> (Ptr Context -> IO a) -> m ()
+parseImpl :: Parser m -> (Ptr Context -> IO CInt) -> m ()
 parseImpl p io = parserFromIO p $ do
 	writeIORef (parserErrorRef p) Nothing
-	E.block (void (withParserIO p io))
+	_ <- mask (\_ -> withParserIO p io)
 	
 	threw <- readIORef (parserErrorRef p)
 	case threw of
@@ -168,7 +175,7 @@ catchRef :: Parser m -> Ptr Context -> m Bool -> IO ()
 catchRef p cb_ctx io = withParserIO p $ \ctx ->
 	(cWantCallback ctx cb_ctx >>=) $ \want ->
 	when (want == 1) $ do
-		continue <- E.catch (E.unblock (parserToIO p io)) $ \e -> do
+		continue <- E.catch (parserToIO p io) $ \e -> do
 			writeIORef (parserErrorRef p) (Just e)
 			return False
 		unless continue (cStopParser ctx)
@@ -294,14 +301,14 @@ parseAttributeContent = parse . T.unpack where
 	parser = ReadP.manyTill content eof
 	content = charRef +++ reference +++ text
 	charRef = do
-		void (ReadP.string "&#")
+		_ <- ReadP.string "&#"
 		val <- ReadP.munch1 (isDigit)
-		void (ReadP.char ';')
+		_ <- ReadP.char ';'
 		return (X.ContentText (T.singleton (chr (read val))))
 	reference = do
-		void (ReadP.char '&')
+		_ <- ReadP.char '&'
 		name <- ReadP.munch1 (/= ';')
-		void (ReadP.char ';')
+		_ <- ReadP.char ';'
 		return (X.ContentEntity (T.pack name))
 	text = do
 		chars <- ReadP.munch1 (/= '&')
@@ -611,8 +618,13 @@ freeFunPtr ptr = if ptr == nullFunPtr
 	then return ()
 	else freeHaskellFunPtr ptr
 
-void :: Functor f => f a -> f ()
-void = fmap (const ())
+-- mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
+mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
+#if MIN_VERSION_base(4,3,0)
+mask = E.mask
+#else
+mask io = E.block (io E.unblock)
+#endif
 
 foreign import ccall unsafe "hslibxml-shim.h hslibxml_alloc_parser"
 	cAllocParser :: CString -> IO (Ptr Context)
diff --git a/libxml-sax.cabal b/libxml-sax.cabal
index 54f7365..2594e4b 100644
--- a/libxml-sax.cabal
+++ b/libxml-sax.cabal
@@ -33,7 +33,7 @@ library
   cc-options: -Wall
 
   build-depends:
-      base >= 4.0 && < 5.0
+      base >= 4.1 && < 5.0
     , bytestring >= 0.9
     , text >= 0.7 && < 0.12
     , xml-types >= 0.3 && < 0.4
-- 
2.38.5