binary-file 0.15.22 → 0.15.24
raw patch · 5 files changed
+46/−30 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- binary-file.cabal +4/−4
- examples/readBitmap.hs +4/−2
- examples/readPNG.hs +13/−7
- src/File/Binary/Instances.hs +19/−16
- src/File/Binary/Parse.hs +6/−1
binary-file.cabal view
@@ -2,7 +2,7 @@ cabal-version: >= 1.8 name: binary-file-version: 0.15.22+version: 0.15.24 stability: experimental author: Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer: Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -69,8 +69,8 @@ > 4: resolutionV > 4: color_num > 4: important_color_num- > ((), Just color_num)[OPENBRACKET](Int, Int, Int)[CLOSEBRACKET]: colors- > ((), image_size)[OPENBRACKET]String[CLOSEBRACKET]: image+ > replicate color_num ()[OPENBRACKET][(Int, Int, Int)][CLOSEBRACKET]: colors+ > replicate image_size ()[OPENBRACKET]String[CLOSEBRACKET]: image > > |] .@@ -92,7 +92,7 @@ source-repository this type: git location: git://github.com/YoshikuniJujo/binary-file.git- tag: 0.15.22+ tag: 0.15.24 library hs-source-dirs: src
examples/readBitmap.hs view
@@ -64,7 +64,9 @@ 4: resolutionV 4: color_num 4: important_colors_num-((), Just color_num){[(Int, Int, Int)]}: colors-((), Just image_size){String}: image+-- ((), Just color_num){[(Int, Int, Int)]}: colors+-- ((), Just image_size){String}: image+replicate color_num (){[(Int, Int, Int)]}: colors+replicate image_size (){String}: image |]
examples/readPNG.hs view
@@ -5,6 +5,7 @@ import File.Binary (binary, Field(..)) import File.Binary.Instances () import File.Binary.Instances.BigEndian ()+import File.Binary.Instances.MSB0 () import CRC (crc) import Codec.Compression.Zlib ( decompress, compressWith, defaultCompressParams, CompressParams(..),@@ -81,7 +82,8 @@ 2: "\r\n" 1: "\SUB" 1: "\n"-((), Nothing){[Chunk]}: chunks+-- ((), Nothing){[Chunk]}: chunks+repeat (){[Chunk]}: chunks |] @@ -90,7 +92,8 @@ Chunk deriving Show 4: chunkSize-((), Just 4){String}: chunkName+-- ((), Just 4){String}: chunkName+replicate 4 (){String}: chunkName (chunkSize, chunkName){ChunkBody}: chunkData 4{Word32}:chunkCRC @@ -120,7 +123,7 @@ toBinary (n, _) (ChunkIDAT c) = toBinary n c toBinary (n, _) (ChunkTEXT c) = toBinary n c toBinary _ (ChunkIEND c) = toBinary () c- toBinary (n, _) (Others str) = toBinary ((), Just n) str+ toBinary (n, _) (Others str) = toBinary (replicate n ()) str -- toBinary ((), Just n) str fromBinary (_, "IHDR") = fmap (first ChunkIHDR) . fromBinary () fromBinary (_, "gAMA") = fmap (first ChunkGAMA) . fromBinary () fromBinary (_, "sRGB") = fmap (first ChunkSRGB) . fromBinary ()@@ -130,7 +133,7 @@ fromBinary (n, "IDAT") = fmap (first ChunkIDAT) . fromBinary n fromBinary (n, "tEXt") = fmap (first ChunkTEXT) . fromBinary n fromBinary (_, "IEND") = fmap (first ChunkIEND) . fromBinary ()- fromBinary (n, _) = fmap (first Others) . fromBinary ((), Just n)+ fromBinary (n, _) = fmap (first Others) . fromBinary (replicate n ()) -- ((), Just n) [binary| @@ -177,7 +180,8 @@ arg :: Int -(4, Just (arg `div` 4)){[Int]}: chrms+-- (4, Just (arg `div` 4)){[Int]}: chrms+replicate (arg `div` 4) 4{[Int]}: chrms |] @@ -187,7 +191,8 @@ arg :: Int -((), Just (arg `div` 3)){[(Int, Int, Int)]}: colors+-- ((), Just (arg `div` 3)){[(Int, Int, Int)]}: colors+replicate (arg `div` 3) (){[(Int, Int, Int)]}: colors |] @@ -228,7 +233,8 @@ arg :: Int -((), Just arg){String}: text+-- ((), Just arg){String}: text+replicate arg (){String}: text |]
src/File/Binary/Instances.hs view
@@ -16,9 +16,9 @@ import qualified Data.ByteString.Lazy.Char8 as BSLC (pack, unpack) import qualified Data.ByteString as BS (ByteString, take, drop, concat, uncons, span) import qualified Data.ByteString.Char8 ()-import Control.Monad (replicateM, foldM)-import "monads-tf" Control.Monad.State (StateT(..), gets)-import Control.Applicative ((<$>), (<*>))+import Control.Monad (foldM)+import "monads-tf" Control.Monad.State (StateT(..))+import Control.Applicative ((<$>)) import Control.Arrow (first, (&&&)) import Data.Monoid (mempty) import Data.Char@@ -47,21 +47,24 @@ toBinary _ = return . makeBinary . pack . (: []) instance Field r => Field [r] where- type FieldArgument [r] = (FieldArgument r, Maybe Int)- fromBits (a, Just b) = b `times` fromBits a- fromBits (a, Nothing) = mempty `whole` fromBits a- consToBits (a, _) fs ret = foldM (flip $ consToBits a) ret $ reverse fs+ type FieldArgument [r] = [FieldArgument r]+ fromBits as = smap mempty as fromBits+ consToBits as fs ret = foldM (flip $ uncurry consToBits) ret $ reverse $ zip as fs -times :: Monad m => Int -> (s -> m (ret, s)) -> s -> m ([ret], s)-times n f- | n >= 0 = runStateT $ replicateM n (StateT f)- | otherwise = error "times: negative times?"+myMapM :: (Monad m, Functor m) => (a -> m (Maybe b)) -> [a] -> m [b]+myMapM _ [] = return []+myMapM f (x : xs) = do+ ret <- f x+ case ret of+ Just y -> (y :) <$> myMapM f xs+ Nothing -> return [] -whole :: (Functor m, Monad m, Eq s) => s -> (s -> m (ret, s)) -> s -> m ([ret], s)-whole e f = runStateT $ do- emp <- gets (== e)- if emp then return [] else- (:) <$> StateT f <*> (StateT $ whole e f)+smap :: (Monad m, Functor m, Eq s) =>+ s -> [a] -> (a -> s -> m (ret, s)) -> s -> m ([ret], s)+smap e xs f = runStateT $ myMapM (StateT . f') xs+ where+ f' x s | s == e = return (Nothing, s)+ | otherwise = first Just <$> f x s --------------------------------------------------------------------------------
src/File/Binary/Parse.hs view
@@ -18,7 +18,7 @@ import Text.Peggy (peggy, parseString, space, defaultDelimiter) import Language.Haskell.TH (- ExpQ, integerL, litE, varE, conE, tupE, appE, uInfixE, parensE,+ ExpQ, integerL, litE, varE, conE, listE, tupE, appE, uInfixE, parensE, TypeQ, conT, listT, tupleT, appT, Name, mkName, FieldExp) import "monads-tf" Control.Monad.Reader (Reader, runReader, ask) import Control.Applicative ((<$>), (<*>))@@ -115,6 +115,11 @@ / num { return $ litE $ integerL $1 } / lname { return $ conE $1 } / var { identify $1 <$> ask }+ / '[' list ']' { listE <$> $1 }++list :: Reader ([FieldExp], ExpQ, String) [ExpQ]+ = ex sp "," sp list { (:) <$> $1 <*> $4 }+ / ex { (: []) <$> $1 } op :: Expression = [!\\#$%&*+./<=>?@^|~\-]+ { return $ varE $ mkName $1 }