binary-file 0.15.18 → 0.15.22

raw patch · 8 files changed

+116/−95 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• binary-file.cabal +8/−6
• src/File/Binary/Classes.hs +4/−4
• src/File/Binary/Instances.hs +3/−1
• src/File/Binary/Instances/BigEndian.hs +2/−46
• src/File/Binary/Instances/LSB0.hs +43/−0
• src/File/Binary/Instances/LittleEndian.hs +2/−37
• src/File/Binary/Instances/MSB0.hs +52/−0
• src/File/Binary/Parse.hs +2/−1

@@ -2,7 +2,7 @@ cabal-version:	>= 1.8  name:		binary-file-version:	0.15.18+version:	0.15.22 stability:	experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -92,18 +92,20 @@ source-repository	this     type:	git     location:	git://github.com/YoshikuniJujo/binary-file.git-    tag:	0.15.18+    tag:	0.15.22  library     hs-source-dirs:	src     exposed-modules:-        File.Binary,+        File.Binary         File.Binary.Instances-        File.Binary.Instances.LittleEndian,+        File.Binary.Instances.LittleEndian         File.Binary.Instances.BigEndian+        File.Binary.Instances.LSB0+        File.Binary.Instances.MSB0     other-modules:-        File.Binary.Classes,-        File.Binary.Parse,+        File.Binary.Classes+        File.Binary.Parse         File.Binary.Quote     build-depends:	base > 3 && < 5, template-haskell, peggy, bytestring,         monads-tf

@@ -15,11 +15,11 @@  class Field f where 	type FieldArgument f-	fromBinary :: (Binary b, Functor m, Monad m) => FieldArgument f -> b -> m (f, b)-	toBinary :: (Binary b, Functor m, Monad m) => FieldArgument f -> f -> m b-	fromBits :: (Binary b, Functor m, Monad m) =>+	fromBinary :: (Binary b, Applicative m, Monad m) => FieldArgument f -> b -> m (f, b)+	toBinary :: (Binary b, Applicative m, Monad m) => FieldArgument f -> f -> m b+	fromBits :: (Binary b, Applicative m, Monad m) => 		FieldArgument f -> AddBits b -> m (f, AddBits b)-	consToBits :: (Binary b, Functor m, Monad m) =>+	consToBits :: (Binary b, Applicative m, Monad m) => 		FieldArgument f -> f -> AddBits b -> m (AddBits b)  	fromBits a ([], b) = second ([] ,) `liftM` fromBinary a b

@@ -53,7 +53,9 @@ 	consToBits (a, _) fs ret = foldM (flip $ consToBits a) ret $ reverse fs  times :: Monad m => Int -> (s -> m (ret, s)) -> s -> m ([ret], s)-times n f = runStateT $ replicateM n (StateT f)+times n f+	| n >= 0 = runStateT $ replicateM n (StateT f)+	| otherwise = error "times: negative times?"  whole :: (Functor m, Monad m, Eq s) => s -> (s -> m (ret, s)) -> s -> m ([ret], s) whole e f = runStateT $ do

@@ -1,9 +1,9 @@ {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module File.Binary.Instances.BigEndian (BitsInt) where+module File.Binary.Instances.BigEndian () where -import File.Binary.Classes (Field(..), Binary(..), pop, push)+import File.Binary.Classes (Field(..), Binary(..)) import Data.ByteString.Lazy (pack, unpack) import Data.Word (Word8, Word32) import Data.Bits (Bits, (.&.), (.|.), shiftL, shiftR)@@ -34,47 +34,3 @@ 	where 	itw r 0 _ = r 	itw r n i = itw (fromIntegral (i .&. 0xff) : r) (n - 1) (i `shiftR` 8)--instance Field Bool where-	type FieldArgument Bool = ()-	fromBits () ([], bin) = fromBits () $ pop bin-	fromBits () (bs, bin) = return (last bs, (init bs, bin))-	consToBits () b (bs, bin)-		| length bs == 7 = return ([], push (bs ++ [b], bin))-		| otherwise = return (bs ++ [b], bin)--data BitsInt = BitsInt { bitsInt :: Int } deriving Show--instance Eq BitsInt where-	BitsInt i1 == BitsInt i2 = i1 == i2--instance Num BitsInt where-	BitsInt i1 + BitsInt i2 = BitsInt $ i1 + i2-	BitsInt i1 * BitsInt i2 = BitsInt $ i1 * i2-	abs (BitsInt i) = BitsInt $ abs i-	signum (BitsInt i) = BitsInt $ signum i-	fromInteger i = BitsInt $ fromInteger i--instance Field BitsInt where-	type FieldArgument BitsInt = Int-	fromBits n = return . first BitsInt . fb n 0-	consToBits n = ctb n . bitsInt--fromEnum' :: (Enum e, Num i) => e -> i-fromEnum' = fromIntegral . fromEnum--toEnum' :: (Enum e, Integral i) => i -> e-toEnum' = toEnum . fromIntegral--fb :: (Bits f, Num 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)--ctb :: (Bits f, Integral f, Binary b, Functor m, Monad m) =>-	Int -> f -> ([Bool], b) -> m ([Bool], b)-ctb 0 _ r = return r-ctb n f (bs, b)-	| length bs == 7 = ctb (n - 1) (f `shiftR` 1) ([], push (bs ++ [bit], b))-	| otherwise = ctb (n - 1) (f `shiftR` 1) (bs ++ [bit], b)-	where bit = toEnum' $ f .&. 1

@@ -0,0 +1,43 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPtIONS_GHC -fno-warn-orphans #-}++module File.Binary.Instances.LSB0 (BitsInt, bitsInt) where++import File.Binary.Classes+import Data.Bits+import Control.Arrow+import Control.Monad++instance Field Bool where+	type FieldArgument Bool = ()+	fromBits () ([], bin) = fromBits () $ pop bin+	fromBits () (b : bs, bin) = return (b, (bs, bin))+	consToBits () b (bs, bin)+		| length bs == 7 = return ([], push (b : bs, bin))+		| otherwise = return (b : bs, bin)++newtype BitsInt = BitsInt { bitsInt :: Int } deriving Show++instance Eq BitsInt where+	BitsInt i1 == BitsInt i2 = i1 == i2++instance Num BitsInt where+	BitsInt i1 + BitsInt i2 = BitsInt $ i1 + i2+	BitsInt i1 * BitsInt i2 = BitsInt $ i1 * i2+	abs (BitsInt i) = BitsInt $ abs i+	signum (BitsInt i) = BitsInt $ signum i+	fromInteger i = BitsInt $ fromInteger i++instance Field BitsInt where+	type FieldArgument BitsInt = Int+	fromBits 0 bb = return (BitsInt 0, bb)+	fromBits n ([], bin) = fromBits n $ pop bin+	fromBits n (b : bs, bin) = first+		(BitsInt . (fromEnum b .|.) . (`shiftL` 1) . bitsInt) `liftM`+		fromBits (n - 1) (bs, bin)+	consToBits 0 _ bb = return bb+	consToBits n (BitsInt f) bb = do+		(bs, bin) <- consToBits (n - 1) (BitsInt $ f `shiftR` 1) bb+		return $ if length bs == 7+			then ([], push (toEnum (f .&. 1) : bs, bin))+			else (toEnum (f .&. 1) : bs, bin)

@@ -1,14 +1,13 @@ {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module File.Binary.Instances.LittleEndian (BitsInt) where+module File.Binary.Instances.LittleEndian () where -import File.Binary.Classes (Field(..), Binary(..), pop, push)+import File.Binary.Classes (Field(..), Binary(..)) import Data.ByteString.Lazy (pack, unpack) import Data.Word (Word8, Word32) import Data.Bits (Bits, (.&.), (.|.), shiftL, shiftR) import Control.Arrow (first)-import Control.Monad  instance Field Int where 	type FieldArgument Int = Int@@ -31,37 +30,3 @@ intToWords :: (Bits i, Integral i) => Int -> i -> [Word8] intToWords 0 _ = [] intToWords n i = fromIntegral (i .&. 0xff) : intToWords (n - 1) (i `shiftR` 8)--instance Field Bool where-	type FieldArgument Bool = ()-	fromBits () ([], bin) = fromBits () $ pop bin-	fromBits () (b : bs, bin) = return (b, (bs, bin))-	consToBits () b (bs, bin)-		| length bs == 7 = return ([], push (b : bs, bin))-		| otherwise = return (b : bs, bin)--newtype BitsInt = BitsInt { bitsInt :: Int } deriving Show--instance Eq BitsInt where-	BitsInt i1 == BitsInt i2 = i1 == i2--instance Num BitsInt where-	BitsInt i1 + BitsInt i2 = BitsInt $ i1 + i2-	BitsInt i1 * BitsInt i2 = BitsInt $ i1 * i2-	abs (BitsInt i) = BitsInt $ abs i-	signum (BitsInt i) = BitsInt $ signum i-	fromInteger i = BitsInt $ fromInteger i--instance Field BitsInt where-	type FieldArgument BitsInt = Int-	fromBits 0 bb = return (BitsInt 0, bb)-	fromBits n ([], bin) = fromBits n $ pop bin-	fromBits n (b : bs, bin) = first-		(BitsInt . (fromEnum b .|.) . (`shiftL` 1) . bitsInt) `liftM`-		fromBits (n - 1) (bs, bin)-	consToBits 0 _ bb = return bb-	consToBits n (BitsInt f) bb = do-		(bs, bin) <- consToBits (n - 1) (BitsInt $ f `shiftR` 1) bb-		return $ if length bs == 7-			then ([], push (toEnum (f .&. 1) : bs, bin))-			else (toEnum (f .&. 1) : bs, bin)

@@ -0,0 +1,52 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module File.Binary.Instances.MSB0 (BitsInt) where++import File.Binary.Classes+import Data.Bits (Bits, shiftL, shiftR, (.|.), (.&.))+import Control.Arrow++instance Field Bool where+	type FieldArgument Bool = ()+	fromBits () ([], bin) = fromBits () $ pop bin+	fromBits () (bs, bin) = return (last bs, (init bs, bin))+	consToBits () b (bs, bin)+		| length bs == 7 = return ([], push (bs ++ [b], bin))+		| otherwise = return (bs ++ [b], bin)++data BitsInt = BitsInt { bitsInt :: Int } deriving Show++instance Eq BitsInt where+	BitsInt i1 == BitsInt i2 = i1 == i2++instance Num BitsInt where+	BitsInt i1 + BitsInt i2 = BitsInt $ i1 + i2+	BitsInt i1 * BitsInt i2 = BitsInt $ i1 * i2+	abs (BitsInt i) = BitsInt $ abs i+	signum (BitsInt i) = BitsInt $ signum i+	fromInteger i = BitsInt $ fromInteger i++instance Field BitsInt where+	type FieldArgument BitsInt = Int+	fromBits n = return . first BitsInt . fb n 0+	consToBits n = ctb n . bitsInt++fromEnum' :: (Enum e, Num i) => e -> i+fromEnum' = fromIntegral . fromEnum++toEnum' :: (Enum e, Integral i) => i -> e+toEnum' = toEnum . fromIntegral++fb :: (Bits f, Num 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)++ctb :: (Bits f, Integral f, Binary b, Functor m, Monad m) =>+	Int -> f -> ([Bool], b) -> m ([Bool], b)+ctb 0 _ r = return r+ctb n f (bs, b)+	| length bs == 7 = ctb (n - 1) (f `shiftR` 1) ([], push (bs ++ [bit], b))+	| otherwise = ctb (n - 1) (f `shiftR` 1) (bs ++ [bit], b)+	where bit = toEnum' $ f .&. 1

@@ -85,7 +85,7 @@ 	= emp var sp '::' sp typ	{ ($2, $5) } 	/ ''				{ ("_", conT $ mkName "()") } -dat :: SItem = emp ex? sp typS sp ':' sp val+dat :: SItem = emp ex? spn typS sp ':' spn val 	{ SItem (fromMaybe (return $ conE $ mkName "()") $2) ($7, $4) } --	{ SItem (fromMaybe (return $ conE $ mkName "()") $2) $ --		either Left (Right . second (const $4)) $7 }@@ -152,6 +152,7 @@ ln :: String = [A-Z][_a-zA-Z0-9]*			{ $1 : $2 } sn :: String = [_a-z][_a-zA-Z0-9]*			{ $1 : $2 } +spn :: () = (comm / [ \t\n])*				{ () } sp :: () = (comm / [ \t])*				{ () } emp :: () = (comm / lcomm / [ \n])*			{ () } lcomm :: Char = '--' [^\n]* [\n]			{ ' ' }