module Data.Accessor.BinaryRead (
Stream,
C(any),
ByteSource(readWord8),
ByteStream(getWord8),
ByteCompatible(toByte),
Parser(Parser, runParser),
field,
record,
) where
import qualified Data.Accessor.Basic as Accessor
import Data.Accessor.ByteSource
(ByteSource(..), ByteStream(..), ByteCompatible(..))
import qualified Control.Monad.Trans.State as State
import Control.Monad (liftM, )
import Data.Word (Word8, )
import Data.Char (chr, )
import Prelude hiding (any)
type Stream = [Word8]
class C a where
any :: ByteSource source => source a
instance C Word8 where
any :: source Word8
any = source Word8
forall (source :: * -> *). ByteSource source => source Word8
readWord8
instance C Char where
any :: source Char
any =
(Word8 -> Char) -> source Word8 -> source Char
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) source Word8
forall (source :: * -> *). ByteSource source => source Word8
readWord8
instance C Int where
any :: source Int
any =
do Word8
c0 <- source Word8
forall (source :: * -> *). ByteSource source => source Word8
readWord8
Word8
c1 <- source Word8
forall (source :: * -> *). ByteSource source => source Word8
readWord8
Word8
c2 <- source Word8
forall (source :: * -> *). ByteSource source => source Word8
readWord8
Word8
c3 <- source Word8
forall (source :: * -> *). ByteSource source => source Word8
readWord8
Int -> source Int
forall (m :: * -> *) a. Monad m => a -> m a
return
((Int -> Int -> Int) -> [Int] -> Int
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\Int
acc Int
d -> Int
accInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
256Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)
((Word8 -> Int) -> [Word8] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word8
c0,Word8
c1,Word8
c2,Word8
c3]))
newtype Parser s r = Parser {Parser s r -> (r, s) -> Maybe (r, s)
runParser :: (r, s) -> Maybe (r, s)}
field :: (ByteStream s, C a) =>
Accessor.T r a -> Parser s r
field :: T r a -> Parser s r
field T r a
f =
((r, s) -> Maybe (r, s)) -> Parser s r
forall s r. ((r, s) -> Maybe (r, s)) -> Parser s r
Parser (((r, s) -> Maybe (r, s)) -> Parser s r)
-> ((r, s) -> Maybe (r, s)) -> Parser s r
forall a b. (a -> b) -> a -> b
$
(r -> s -> Maybe (r, s)) -> (r, s) -> Maybe (r, s)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (\r
r -> StateT s Maybe r -> s -> Maybe (r, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.runStateT (StateT s Maybe r -> s -> Maybe (r, s))
-> StateT s Maybe r -> s -> Maybe (r, s)
forall a b. (a -> b) -> a -> b
$
(a -> r) -> StateT s Maybe a -> StateT s Maybe r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> T r a -> a -> r -> r
forall r a. T r a -> a -> r -> r
Accessor.set T r a
f a
x r
r) StateT s Maybe a
forall a (source :: * -> *). (C a, ByteSource source) => source a
any)
record :: [Parser s r] -> Parser s r
record :: [Parser s r] -> Parser s r
record [Parser s r]
ps =
((r, s) -> Maybe (r, s)) -> Parser s r
forall s r. ((r, s) -> Maybe (r, s)) -> Parser s r
Parser (((r, s) -> Maybe (r, s)) -> Parser s r)
-> ((r, s) -> Maybe (r, s)) -> Parser s r
forall a b. (a -> b) -> a -> b
$ (Maybe (r, s) -> [(r, s) -> Maybe (r, s)] -> Maybe (r, s))
-> [(r, s) -> Maybe (r, s)] -> Maybe (r, s) -> Maybe (r, s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Maybe (r, s) -> ((r, s) -> Maybe (r, s)) -> Maybe (r, s))
-> Maybe (r, s) -> [(r, s) -> Maybe (r, s)] -> Maybe (r, s)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Maybe (r, s) -> ((r, s) -> Maybe (r, s)) -> Maybe (r, s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)) ((Parser s r -> (r, s) -> Maybe (r, s))
-> [Parser s r] -> [(r, s) -> Maybe (r, s)]
forall a b. (a -> b) -> [a] -> [b]
map Parser s r -> (r, s) -> Maybe (r, s)
forall s r. Parser s r -> (r, s) -> Maybe (r, s)
runParser [Parser s r]
ps) (Maybe (r, s) -> Maybe (r, s))
-> ((r, s) -> Maybe (r, s)) -> (r, s) -> Maybe (r, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r, s) -> Maybe (r, s)
forall a. a -> Maybe a
Just