module Data.PrimitiveSerial ( BSRead(..) , runWholeBSRead , bsRead , bsReadN , bsReadEverything , bsReadCount , decodeNative , encodeNative , FixedNumeric(..) , decodeLittleEndian , encodeLittleEndian , decodeBigEndian , encodeBigEndian ) where import Control.Applicative import Control.Monad import Data.ByteString import Data.ByteString.Internal import Data.Int import Data.Word import Foreign import Prelude hiding (drop, length, null, take) import System.Endian import System.IO.Unsafe newtype BSRead a = MkBSRead { forall a. BSRead a -> StrictByteString -> Maybe (StrictByteString, a) runBSRead :: StrictByteString -> Maybe (StrictByteString, a) } instance Functor BSRead where fmap :: forall a b. (a -> b) -> BSRead a -> BSRead b fmap a -> b ab (MkBSRead StrictByteString -> Maybe (StrictByteString, a) f) = forall a. (StrictByteString -> Maybe (StrictByteString, a)) -> BSRead a MkBSRead forall a b. (a -> b) -> a -> b $ \StrictByteString bs -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b ab) forall a b. (a -> b) -> a -> b $ StrictByteString -> Maybe (StrictByteString, a) f StrictByteString bs instance Applicative BSRead where pure :: forall a. a -> BSRead a pure a a = forall a. (StrictByteString -> Maybe (StrictByteString, a)) -> BSRead a MkBSRead forall a b. (a -> b) -> a -> b $ \StrictByteString bs -> forall a. a -> Maybe a Just (StrictByteString bs, a a) MkBSRead StrictByteString -> Maybe (StrictByteString, a -> b) fab <*> :: forall a b. BSRead (a -> b) -> BSRead a -> BSRead b <*> MkBSRead StrictByteString -> Maybe (StrictByteString, a) fa = forall a. (StrictByteString -> Maybe (StrictByteString, a)) -> BSRead a MkBSRead forall a b. (a -> b) -> a -> b $ \StrictByteString bs -> do (StrictByteString bs', a -> b ab) <- StrictByteString -> Maybe (StrictByteString, a -> b) fab StrictByteString bs (StrictByteString bs'', a a) <- StrictByteString -> Maybe (StrictByteString, a) fa StrictByteString bs' forall (m :: * -> *) a. Monad m => a -> m a return (StrictByteString bs'', a -> b ab a a) instance Alternative BSRead where MkBSRead StrictByteString -> Maybe (StrictByteString, a) fa <|> :: forall a. BSRead a -> BSRead a -> BSRead a <|> MkBSRead StrictByteString -> Maybe (StrictByteString, a) fb = forall a. (StrictByteString -> Maybe (StrictByteString, a)) -> BSRead a MkBSRead forall a b. (a -> b) -> a -> b $ \StrictByteString bs -> StrictByteString -> Maybe (StrictByteString, a) fa StrictByteString bs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> StrictByteString -> Maybe (StrictByteString, a) fb StrictByteString bs empty :: forall a. BSRead a empty = forall a. (StrictByteString -> Maybe (StrictByteString, a)) -> BSRead a MkBSRead forall a b. (a -> b) -> a -> b $ \StrictByteString _ -> forall a. Maybe a Nothing instance Monad BSRead where MkBSRead StrictByteString -> Maybe (StrictByteString, a) f >>= :: forall a b. BSRead a -> (a -> BSRead b) -> BSRead b >>= a -> BSRead b q = forall a. (StrictByteString -> Maybe (StrictByteString, a)) -> BSRead a MkBSRead forall a b. (a -> b) -> a -> b $ \StrictByteString bs -> do (StrictByteString bs', a a) <- StrictByteString -> Maybe (StrictByteString, a) f StrictByteString bs forall a. BSRead a -> StrictByteString -> Maybe (StrictByteString, a) runBSRead (a -> BSRead b q a a) StrictByteString bs' instance MonadPlus BSRead runWholeBSRead :: BSRead a -> StrictByteString -> Maybe a runWholeBSRead :: forall a. BSRead a -> StrictByteString -> Maybe a runWholeBSRead BSRead a ra StrictByteString bs = do (StrictByteString bs', a a) <- forall a. BSRead a -> StrictByteString -> Maybe (StrictByteString, a) runBSRead BSRead a ra StrictByteString bs if StrictByteString -> Bool null StrictByteString bs' then forall (m :: * -> *) a. Monad m => a -> m a return a a else forall a. Maybe a Nothing bsRead :: BSRead Word8 bsRead :: BSRead Word8 bsRead = forall a. (StrictByteString -> Maybe (StrictByteString, a)) -> BSRead a MkBSRead forall a b. (a -> b) -> a -> b $ \StrictByteString bs -> do Word8 w <- StrictByteString -> Int -> Maybe Word8 indexMaybe StrictByteString bs Int 0 forall (m :: * -> *) a. Monad m => a -> m a return (Int -> StrictByteString -> StrictByteString drop Int 1 StrictByteString bs, Word8 w) bsReadN :: Int -> BSRead StrictByteString bsReadN :: Int -> BSRead StrictByteString bsReadN Int n = forall a. (StrictByteString -> Maybe (StrictByteString, a)) -> BSRead a MkBSRead forall a b. (a -> b) -> a -> b $ \StrictByteString bs -> do if Int n forall a. Ord a => a -> a -> Bool > StrictByteString -> Int length StrictByteString bs then forall a. Maybe a Nothing else forall (m :: * -> *) a. Monad m => a -> m a return (Int -> StrictByteString -> StrictByteString drop Int n StrictByteString bs, Int -> StrictByteString -> StrictByteString take Int n StrictByteString bs) bsReadEverything :: BSRead StrictByteString bsReadEverything :: BSRead StrictByteString bsReadEverything = forall a. (StrictByteString -> Maybe (StrictByteString, a)) -> BSRead a MkBSRead forall a b. (a -> b) -> a -> b $ \StrictByteString bs -> forall a. a -> Maybe a Just (forall a. Monoid a => a mempty, StrictByteString bs) bsReadCount :: BSRead Int bsReadCount :: BSRead Int bsReadCount = forall a. (StrictByteString -> Maybe (StrictByteString, a)) -> BSRead a MkBSRead forall a b. (a -> b) -> a -> b $ \StrictByteString bs -> forall a. a -> Maybe a Just (StrictByteString bs, StrictByteString -> Int length StrictByteString bs) decodeNative :: forall a. Storable a => BSRead a decodeNative :: forall a. Storable a => BSRead a decodeNative = let typeSize :: Int typeSize :: Int typeSize = forall a. Storable a => a -> Int sizeOf (forall a. HasCallStack => a undefined :: a) in forall a. (StrictByteString -> Maybe (StrictByteString, a)) -> BSRead a MkBSRead forall a b. (a -> b) -> a -> b $ \bs :: StrictByteString bs@(BS ForeignPtr Word8 fptr Int len) -> if Int typeSize forall a. Ord a => a -> a -> Bool <= Int len then forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ (Int -> StrictByteString -> StrictByteString drop Int typeSize StrictByteString bs, forall a. IO a -> a unsafePerformIO forall a b. (a -> b) -> a -> b $ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr ForeignPtr Word8 fptr forall a b. (a -> b) -> a -> b $ \Ptr Word8 ptr -> forall a. Storable a => Ptr a -> IO a peek forall a b. (a -> b) -> a -> b $ forall a b. Ptr a -> Ptr b castPtr Ptr Word8 ptr) else forall a. Maybe a Nothing encodeNative :: forall a. Storable a => a -> StrictByteString encodeNative :: forall a. Storable a => a -> StrictByteString encodeNative a a = let typeSize :: Int typeSize :: Int typeSize = forall a. Storable a => a -> Int sizeOf (forall a. HasCallStack => a undefined :: a) in forall a. IO a -> a unsafePerformIO forall a b. (a -> b) -> a -> b $ Int -> (Ptr Word8 -> IO ()) -> IO StrictByteString create Int typeSize forall a b. (a -> b) -> a -> b $ \Ptr Word8 ptr -> forall a. Storable a => Ptr a -> a -> IO () poke (forall a b. Ptr a -> Ptr b castPtr Ptr Word8 ptr) a a unsafeStorableCoerce :: forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce :: forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce a a = forall a. IO a -> a unsafePerformIO forall a b. (a -> b) -> a -> b $ forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b with a a forall a b. (a -> b) -> a -> b $ \Ptr a ptr -> forall a. Storable a => Ptr a -> IO a peek forall a b. (a -> b) -> a -> b $ forall a b. Ptr a -> Ptr b castPtr Ptr a ptr class Storable a => FixedNumeric a where nativeToLittleEndian :: a -> a nativeToBigEndian :: a -> a instance FixedNumeric Word8 where nativeToLittleEndian :: Word8 -> Word8 nativeToLittleEndian = forall a. a -> a id nativeToBigEndian :: Word8 -> Word8 nativeToBigEndian = forall a. a -> a id instance FixedNumeric Word16 where nativeToLittleEndian :: Word16 -> Word16 nativeToLittleEndian = Word16 -> Word16 fromLE16 nativeToBigEndian :: Word16 -> Word16 nativeToBigEndian = Word16 -> Word16 fromBE16 instance FixedNumeric Word32 where nativeToLittleEndian :: Word32 -> Word32 nativeToLittleEndian = Word32 -> Word32 fromLE32 nativeToBigEndian :: Word32 -> Word32 nativeToBigEndian = Word32 -> Word32 fromBE32 instance FixedNumeric Word64 where nativeToLittleEndian :: Word64 -> Word64 nativeToLittleEndian = Word64 -> Word64 fromLE64 nativeToBigEndian :: Word64 -> Word64 nativeToBigEndian = Word64 -> Word64 fromBE64 instance FixedNumeric Int8 where nativeToLittleEndian :: Int8 -> Int8 nativeToLittleEndian = forall a. a -> a id nativeToBigEndian :: Int8 -> Int8 nativeToBigEndian = forall a. a -> a id instance FixedNumeric Int16 where nativeToLittleEndian :: Int16 -> Int16 nativeToLittleEndian = forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FixedNumeric a => a -> a nativeToLittleEndian @Word16 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce nativeToBigEndian :: Int16 -> Int16 nativeToBigEndian = forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FixedNumeric a => a -> a nativeToBigEndian @Word16 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce instance FixedNumeric Int32 where nativeToLittleEndian :: Int32 -> Int32 nativeToLittleEndian = forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FixedNumeric a => a -> a nativeToLittleEndian @Word32 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce nativeToBigEndian :: Int32 -> Int32 nativeToBigEndian = forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FixedNumeric a => a -> a nativeToBigEndian @Word32 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce instance FixedNumeric Int64 where nativeToLittleEndian :: Int64 -> Int64 nativeToLittleEndian = forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FixedNumeric a => a -> a nativeToLittleEndian @Word64 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce nativeToBigEndian :: Int64 -> Int64 nativeToBigEndian = forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FixedNumeric a => a -> a nativeToBigEndian @Word64 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce instance FixedNumeric Float where nativeToLittleEndian :: Float -> Float nativeToLittleEndian = forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FixedNumeric a => a -> a nativeToLittleEndian @Word32 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce nativeToBigEndian :: Float -> Float nativeToBigEndian = forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FixedNumeric a => a -> a nativeToBigEndian @Word32 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce instance FixedNumeric Double where nativeToLittleEndian :: Double -> Double nativeToLittleEndian = forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FixedNumeric a => a -> a nativeToLittleEndian @Word64 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce nativeToBigEndian :: Double -> Double nativeToBigEndian = forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FixedNumeric a => a -> a nativeToBigEndian @Word64 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Storable a, Storable b) => a -> b unsafeStorableCoerce decodeLittleEndian :: forall a. FixedNumeric a => BSRead a decodeLittleEndian :: forall a. FixedNumeric a => BSRead a decodeLittleEndian = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a. FixedNumeric a => a -> a nativeToLittleEndian forall a b. (a -> b) -> a -> b $ forall a. Storable a => BSRead a decodeNative encodeLittleEndian :: forall a. FixedNumeric a => a -> StrictByteString encodeLittleEndian :: forall a. FixedNumeric a => a -> StrictByteString encodeLittleEndian = forall a. Storable a => a -> StrictByteString encodeNative forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FixedNumeric a => a -> a nativeToLittleEndian decodeBigEndian :: forall a. FixedNumeric a => BSRead a decodeBigEndian :: forall a. FixedNumeric a => BSRead a decodeBigEndian = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a. FixedNumeric a => a -> a nativeToBigEndian forall a b. (a -> b) -> a -> b $ forall a. Storable a => BSRead a decodeNative encodeBigEndian :: forall a. FixedNumeric a => a -> StrictByteString encodeBigEndian :: forall a. FixedNumeric a => a -> StrictByteString encodeBigEndian = forall a. Storable a => a -> StrictByteString encodeNative forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FixedNumeric a => a -> a nativeToBigEndian