Binary pattern-matching on bytestrings

Binary.hs

{-# LANGUAGE
    ScopedTypeVariables,
    ViewPatterns,
    PatternSynonyms #-}

import Data.Bits (Bits, shift)
import Data.Word
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import GHC.Float (castWord32ToFloat)

class Binary a where
  fromBS :: ByteString -> Maybe (a, ByteString)

instance Binary Word8 where
  fromBS = BS.uncons

f8 :: (Num a, Bits a) => Word8 -> Int -> a
f8 n i = shift (fromIntegral n) i

newtype Little32 = Little32 { unLittle32 :: Word32 }

instance Binary Little32 where
  fromBS
    (fromBS -> Just (a0,
     fromBS -> Just (a1,
     fromBS -> Just (a2,
     fromBS -> Just (a3, rest))))) =
     Just (Little32 (f8 a0 0 + f8 a1 8 + f8 a2 16 + f8 a3 24), rest)
  fromBS _ = Nothing

newtype Little64 = Little64 { unLittle64 :: Word64 }

instance Binary Little64 where
  fromBS
    (fromBS -> Just (a0,
     fromBS -> Just (a1,
     fromBS -> Just (a2,
     fromBS -> Just (a3,
     fromBS -> Just (a4,
     fromBS -> Just (a5,
     fromBS -> Just (a6,
     fromBS -> Just (a7, rest))))))))) =
     let n = f8 a0 0 + f8 a1 8 + f8 a2 16 + f8 a3 24 + f8 a4 32 + f8 a5 40 + f8 a6 48 + f8 a7 56
     in Just (Little64 n, rest)
  fromBS _ = Nothing

word32ToFloat :: Word32 -> Float
word32ToFloat = castWord32ToFloat

newtype LittleFloat32 = LittleFloat32 { unLittleFloat32 :: Float }

instance Binary LittleFloat32 where
  fromBS v = do
    (Little32 a0, rest) <- fromBS v
    pure (LittleFloat32 (word32ToFloat a0), rest)

pattern (:.) :: Binary a => a -> ByteString -> ByteString
pattern x :. y <- (fromBS -> Just (x, y))

infixr 1 :.

f :: ByteString -> (Word32, Word8, ByteString)
f myData =
  case myData of
    (1 :: Word8) :.
      (44 :: Word8) :.
      (a :: Little32) :.
      (b :: Little64) :.
      (c :: Word8) :.
      (d :: Little64) :.
      (e :: LittleFloat32) :.
      rest ->
      {- using a, b, c, d, e, rest -}
      (unLittle32 a, c, rest)
    _ -> undefined

main :: IO ()
main = print (f (BS.pack [1, 44, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]))