binary-0.6 compatibility

Ignore-this: 6af2adadedc20f51bb5084b3da59724e

darcs-hash:20121213030806-76d51-6d52680cab9b4f4b6c2ba17e29fa457b85d4d838
This commit is contained in:
Daniel Wagner 2012-12-12 19:08:06 -08:00
parent 25d4551635
commit 8b1f45a6ec
3 changed files with 37 additions and 35 deletions

View File

@ -6,7 +6,9 @@ import Data.Encoding.Exception
import Data.Bits
import Data.Binary.Get
import Data.Char
import Data.Maybe
import Data.Word
import Control.Applicative as A
import Control.Monad.State
import Control.Monad.Identity
import Control.Monad.Reader
@ -19,7 +21,9 @@ import System.IO
class (Monad m,Throws DecodingException m) => ByteSource m where
sourceEmpty :: m Bool
fetchWord8 :: m Word8
fetchAhead :: m a -> m a
-- 'fetchAhead act' should return the same thing 'act' does, but should
-- only consume input if 'act' returns a 'Just' value
fetchAhead :: m (Maybe a) -> m (Maybe a)
fetchWord16be :: m Word16
fetchWord16be = do
w1 <- fetchWord8
@ -95,7 +99,20 @@ instance Throws DecodingException Get where
instance ByteSource Get where
sourceEmpty = isEmpty
fetchWord8 = getWord8
fetchAhead = lookAhead
#if MIN_VERSION_binary(0,6,0)
fetchAhead act = (do
res <- act
case res of
Nothing -> A.empty
Just a -> return res
) <|> return Nothing
#else
fetchAhead act = do
res <- lookAhead act
case res of
Nothing -> return Nothing
Just a -> act
#endif
fetchWord16be = getWord16be
fetchWord16le = getWord16le
fetchWord32be = getWord32be
@ -103,6 +120,12 @@ instance ByteSource Get where
fetchWord64be = getWord64be
fetchWord64le = getWord64le
fetchAheadState act = do
chs <- get
res <- act
when (isNothing res) (put chs)
return res
instance ByteSource (StateT [Char] Identity) where
sourceEmpty = gets null
fetchWord8 = do
@ -112,11 +135,7 @@ instance ByteSource (StateT [Char] Identity) where
c:cs -> do
put cs
return (fromIntegral $ ord c)
fetchAhead act = do
chs <- get
res <- act
put chs
return res
fetchAhead = fetchAheadState
#if MIN_VERSION_base(4,3,0)
#else
@ -135,33 +154,21 @@ instance ByteSource (StateT [Char] (Either DecodingException)) where
c:cs -> do
put cs
return (fromIntegral $ ord c)
fetchAhead act = do
chs <- get
res <- act
put chs
return res
fetchAhead = fetchAheadState
instance (Monad m,Throws DecodingException m) => ByteSource (StateT BS.ByteString m) where
sourceEmpty = gets BS.null
fetchWord8 = StateT (\str -> case BS.uncons str of
Nothing -> throwException UnexpectedEnd
Just (c,cs) -> return (c,cs))
fetchAhead act = do
str <- get
res <- act
put str
return res
fetchAhead = fetchAheadState
instance ByteSource (StateT LBS.ByteString (Either DecodingException)) where
sourceEmpty = gets LBS.null
fetchWord8 = StateT (\str -> case LBS.uncons str of
Nothing -> Left UnexpectedEnd
Just ns -> Right ns)
fetchAhead act = do
chs <- get
res <- act
put chs
return res
fetchAhead = fetchAheadState
instance ByteSource (ReaderT Handle IO) where
sourceEmpty = do
@ -176,5 +183,5 @@ instance ByteSource (ReaderT Handle IO) where
h <- ask
pos <- liftIO $ hGetPosn h
res <- act
liftIO $ hSetPosn pos
when (isNothing res) (liftIO $ hSetPosn pos)
return res

View File

@ -26,11 +26,10 @@ instance Encoding ISO2022JP where
encodeable _ c = encodeable ASCII c || encodeable JISX0201 c || encodeable JISX0208 c
instance ISO2022 ISO2022JP where
readEscape _ = do
w <- fetchAhead fetchWord8
readEscape _ = fetchAhead $ do
w <- fetchWord8
if w == 27
then (do
fetchWord8
w2 <- fetchWord8
w3 <- fetchWord8
case w2 of

View File

@ -1,5 +1,5 @@
Name: encoding
Version: 0.6.7.2
Version: 0.7
Author: Henning Günther
Maintainer: daniel@wagner-home.com
License: BSD3
@ -24,8 +24,6 @@ Extra-Source-Files:
Flag splitBase
description: Choose the new smaller, split-up base package.
Flag newGHC
description: Use ghc version > 6.10
Flag systemEncoding
description: Provide the getSystemEncoding action to query the locale.
@ -36,16 +34,14 @@ Source-Repository head
Source-Repository this
Type: darcs
Location: http://code.haskell.org/encoding
Tag: 0.6.7.1
Tag: 0.7
Library
Build-Depends: binary < 0.6, extensible-exceptions, HaXml >= 1.22 && < 1.24
Build-Depends: binary < 0.7, extensible-exceptions, HaXml >= 1.22 && < 1.24
if flag(splitBase)
Build-Depends: bytestring, base >= 3 && < 5, mtl, containers, array, regex-compat
if flag(newGHC)
Build-Depends: ghc-prim, ghc >= 6.10
else
Build-Depends: ghc < 6.10
if impl(ghc >= 6.10)
Build-Depends: ghc-prim
else
Build-Depends: base < 3