diff --git a/binary-file.cabal b/binary-file.cabal --- a/binary-file.cabal +++ b/binary-file.cabal @@ -2,7 +2,7 @@ cabal-version: >= 1.8 name: binary-file -version: 0.15.9 +version: 0.15.10 stability: experimental author: Yoshikuni Jujo maintainer: Yoshikuni Jujo @@ -90,7 +90,7 @@ source-repository this type: git location: git://github.com/YoshikuniJujo/binary-file.git - tag: 0.15.9 + tag: 0.15.10 library hs-source-dirs: src diff --git a/examples/readPNG.hs b/examples/readPNG.hs --- a/examples/readPNG.hs +++ b/examples/readPNG.hs @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} import Prelude hiding (concat) -import File.Binary (binary, Field(..), Binary(..)) +import File.Binary (binary, Field(..)) import File.Binary.Instances () import File.Binary.Instances.BigEndian () import CRC (crc) @@ -12,9 +12,8 @@ import qualified Data.ByteString as BS (ByteString, length, readFile, writeFile) import qualified Data.ByteString.Char8 as BSC (unpack) import Data.ByteString.Lazy - (ByteString, pack, unpack, concat, toChunks, fromChunks) -import Data.Word (Word8, Word32) -import Data.Bits (Bits, (.&.), (.|.), shiftL, shiftR) + (ByteString, concat, toChunks, fromChunks) +import Data.Word (Word32) import Data.Monoid (mconcat) import Control.Applicative ((<$>)) import Control.Arrow(first) @@ -94,20 +93,6 @@ 4{Word32}:chunkCRC |] - -instance Field Word32 where - type FieldArgument Word32 = Int - toBinary n = makeBinary . pack . intToWords n - fromBinary n = return . first (wordsToInt . unpack) . getBytes n - -intToWords :: (Bits i, Integral i) => Int -> i -> [Word8] -intToWords = itw [] - where - itw r 0 _ = r - itw r n i = itw (fromIntegral (i .&. 0xff) : r) (n - 1) (i `shiftR` 8) - -wordsToInt :: Bits i => [Word8] -> i -wordsToInt = foldl (\r w -> r `shiftL` 8 .|. fromIntegral w) 0 data ChunkBody = ChunkIHDR IHDR diff --git a/src/File/Binary/Instances.hs b/src/File/Binary/Instances.hs --- a/src/File/Binary/Instances.hs +++ b/src/File/Binary/Instances.hs @@ -44,7 +44,7 @@ whole e f = runStateT $ do emp <- gets (== e) if emp then return [] else - (:) <$> (StateT f) <*> (StateT $ whole e f) + (:) <$> StateT f <*> (StateT $ whole e f) -------------------------------------------------------------------------------- diff --git a/src/File/Binary/Instances/BigEndian.hs b/src/File/Binary/Instances/BigEndian.hs --- a/src/File/Binary/Instances/BigEndian.hs +++ b/src/File/Binary/Instances/BigEndian.hs @@ -5,7 +5,7 @@ import File.Binary.Classes (Field(..), Binary(..), pop, push) import Data.ByteString.Lazy (pack, unpack) -import Data.Word (Word8) +import Data.Word (Word8, Word32) import Data.Bits (Bits, (.&.), (.|.), shiftL, shiftR) import Control.Arrow (first) @@ -21,6 +21,11 @@ fromBinary n = return . first (wordsToInt . unpack) . getBytes n toBinary n = makeBinary . pack . intToWords n +instance Field Word32 where + type FieldArgument Word32 = Int + fromBinary n = return . first (wordsToInt . unpack) . getBytes n + toBinary n = makeBinary . pack . intToWords n + wordsToInt :: Bits i => [Word8] -> i wordsToInt = foldl (\i w -> i `shiftL` 8 .|. fromIntegral w) 0 @@ -54,7 +59,7 @@ fb :: (Bits f, Binary b) => Int -> f -> ([Bool], b) -> (f, ([Bool], b)) fb 0 r bb = (r, bb) fb n r ([], b) = fb n r $ pop b -fb n r (bs, b) = fb (n - 1) (r `shiftL` 1 .|. (fromEnum' $ last bs)) (init bs, b) +fb n r (bs, b) = fb (n - 1) (r `shiftL` 1 .|. fromEnum' (last bs)) (init bs, b) ctb :: (Bits f, Integral f, Binary b) => Int -> f -> ([Bool], b) -> ([Bool], b) ctb 0 _ r = r diff --git a/src/File/Binary/Instances/LittleEndian.hs b/src/File/Binary/Instances/LittleEndian.hs --- a/src/File/Binary/Instances/LittleEndian.hs +++ b/src/File/Binary/Instances/LittleEndian.hs @@ -5,7 +5,7 @@ import File.Binary.Classes (Field(..), Binary(..), pop, push) import Data.ByteString.Lazy (pack, unpack) -import Data.Word (Word8) +import Data.Word (Word8, Word32) import Data.Bits (Bits, (.&.), (.|.), shiftL, shiftR) import Control.Arrow (first) import Control.Applicative @@ -15,6 +15,11 @@ fromBinary n = return . first (wordsToInt . unpack) . getBytes n toBinary n = makeBinary . pack . intToWords n +instance Field Word32 where + type FieldArgument Word32 = Int + fromBinary n = return . first (wordsToInt . unpack) . getBytes n + toBinary n = makeBinary . pack . intToWords n + instance Field Integer where type FieldArgument Integer = Int fromBinary n = return . first (wordsToInt . unpack) . getBytes n @@ -32,7 +37,7 @@ fromBits () ([], bin) = fromBits () $ pop bin fromBits () (b : bs, bin) = return (b, (bs, bin)) consToBits () b (bs, bin) - | length bs == 7 = ([], push ((b : bs), bin)) + | length bs == 7 = ([], push (b : bs, bin)) | otherwise = (b : bs, bin) data BitsInt = BitsInt { bitsInt :: Int } deriving Show @@ -43,7 +48,7 @@ fromBits n ([], bin) = fromBits n $ pop bin fromBits n (b : bs, bin) = first (BitsInt . (fromEnum b .|.) . (`shiftL` 1) . bitsInt) <$> - (fromBits (n - 1) (bs, bin)) + fromBits (n - 1) (bs, bin) consToBits 0 _ bb = bb consToBits n (BitsInt f) bb = let (bs, bin) = consToBits (n - 1) (BitsInt $ f `shiftR` 1) bb in diff --git a/src/File/Binary/Quote.hs b/src/File/Binary/Quote.hs --- a/src/File/Binary/Quote.hs +++ b/src/File/Binary/Quote.hs @@ -72,11 +72,11 @@ readf' size (Left val) = do (bin, rts2) <- get [rv, rest, bin'] <- liftQ $ mapM newName ["_rv", "_rst", "_bin'"] - put $ (varE bin', rts2) + put (varE bin', rts2) let lit = constant ((`sigE` conT ''Integer) . litE . integerL) (appE (varE 'pack) . litE . stringL) - (\b -> if b then conE 'True else conE 'False) + (\b -> conE (if b then 'True else 'False)) val return [bindS (tupP [varP rv, varP rest]) (appsE [varE 'fromBits, size rts2, bin]), @@ -88,7 +88,7 @@ readf' size (Right (var, _)) = do (bin, rts2) <- get [bin', tmp] <- liftQ $ mapM newName ["_bin'", "_tmp"] - put $ (varE bin', (var, VarE tmp) : rts2) + put (varE bin', (var, VarE tmp) : rts2) liftW $ tell [(var, VarE tmp)] return [bindS (tildeP $ tupP [varP tmp, varP bin']) $ appsE [varE 'fromBits, size rts2, bin]] @@ -96,7 +96,7 @@ writing :: [FieldExp] -> String -> [SItem] -> ClauseQ writing fe argn items = do [arg, dat, bin0] <- mapM newName ["_arg", "_dat", "bin0"] - let fe' = map (\n -> (n, VarE n `AppE` VarE dat)) $ map fst fe + let fe' = map ((\n -> (n, VarE n `AppE` VarE dat)) . fst) fe flip (clause [varP arg, varP dat, varP bin0]) [] $ normalB $ appE (appsE [varE 'foldr, varE '($), varE bin0]) $ listE $ (<$> items) $ writef dat @@ -107,7 +107,7 @@ writef _ size (Left val) = varE 'consToBits `appE` size `appE` constant ((`sigE` conT ''Integer) . litE . integerL) (appE (varE 'pack) . litE . stringL) - (\b -> if b then conE 'True else conE 'False) + (\b -> conE (if b then 'True else 'False)) val writef dat size (Right (rec, _)) = varE 'consToBits `appE` size `appE` (varE rec `appE` varE dat)