binary-0.6 compatibility
Ignore-this: 6af2adadedc20f51bb5084b3da59724e darcs-hash:20121213030806-76d51-6d52680cab9b4f4b6c2ba17e29fa457b85d4d838
This commit is contained in:
parent
25d4551635
commit
8b1f45a6ec
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user