2 files changed, 27 insertions(+), 15 deletions(-)

M lib/Text/XML/LibXML/SAX.hs
M libxml-sax.cabal

@@ 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)

@@ 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