1module Ptr.Peek
2where
3
4import Ptr.Prelude hiding (take)
5import qualified Ptr.PokeAndPeek as B
6import qualified Ptr.Parse as C
7import qualified Ptr.ParseUnbound as D
8import qualified Ptr.IO as A
9
10
11data Peek output =
12  Peek {-# UNPACK #-} !Int !(Ptr Word8 -> IO output)
13
14instance Functor Peek where
15  {-# INLINE fmap #-}
16  fmap fn (Peek size io) =
17    Peek size (fmap fn . io)
18
19instance Applicative Peek where
20  {-# INLINE pure #-}
21  pure x =
22    Peek 0 (const (pure x))
23  {-# INLINE (<*>) #-}
24  (<*>) (Peek leftSize leftIO) (Peek rightSize rightIO) =
25    Peek (leftSize + rightSize) io
26    where
27      io ptr =
28        leftIO ptr <*> rightIO (plusPtr ptr leftSize)
29
30
31{-# INLINE word8 #-}
32word8 :: Peek Word8
33word8 =
34  {-# SCC "word8" #-}
35  Peek 1 A.peekWord8
36
37{-# INLINE beWord16 #-}
38beWord16 :: Peek Word16
39beWord16 =
40  {-# SCC "beWord16" #-}
41  Peek 2 A.peekBEWord16
42
43{-# INLINE beWord32 #-}
44beWord32 :: Peek Word32
45beWord32 =
46  {-# SCC "beWord32" #-}
47  Peek 4 A.peekBEWord32
48
49{-# INLINE beWord64 #-}
50beWord64 :: Peek Word64
51beWord64 =
52  {-# SCC "beWord64" #-}
53  Peek 8 A.peekBEWord64
54
55{-# INLINE bytes #-}
56bytes :: Int -> Peek ByteString
57bytes !amount =
58  {-# SCC "bytes" #-}
59  Peek amount (\ ptr -> A.peekBytes ptr amount)
60
61{-# INLINE shortByteString #-}
62shortByteString :: Int -> Peek ShortByteString
63shortByteString !amount =
64  {-# SCC "shortByteString" #-}
65  Peek amount (\ ptr -> A.peekShortByteString ptr amount)
66
67{-# INLINE pokeAndPeek #-}
68pokeAndPeek :: B.PokeAndPeek input output -> Peek output
69pokeAndPeek (B.PokeAndPeek size _ io) =
70  {-# SCC "pokeAndPeek" #-}
71  Peek size io
72
73{-|
74Given the length of the data and a specification of its sequential consumption,
75produces Peek, which results in Just the successfully taken value,
76or Nothing, if the specified length of data wasn't enough.
77-}
78{-# INLINE parse #-}
79parse :: Int -> C.Parse a -> (Int -> a) -> (Text -> a) -> Peek a
80parse amount (C.Parse parseIO) eoi error =
81  {-# SCC "parse" #-}
82  Peek amount $ \ ptr ->
83  parseIO amount ptr (return . eoi) (return . error) (\result _ _ -> return result)
84
85{-|
86Given the length of the data and a specification of its sequential consumption,
87produces Peek, which results in Just the successfully taken value,
88or Nothing, if the specified length of data wasn't enough.
89-}
90{-# INLINE parseUnbound #-}
91parseUnbound :: Int -> D.ParseUnbound a -> (Int -> a) -> (Text -> a) -> Peek a
92parseUnbound sizeBound (D.ParseUnbound parseIO) eoi error =
93  {-# SCC "parse" #-}
94  Peek sizeBound $ \ ptr ->
95  parseIO ptr (return . error)
96    (\ result size -> if size <= sizeBound
97      then return (eoi (size - sizeBound))
98      else return result)
99
100{-|
101A standard idiom, where a header specifies the length of the body.
102
103Produces Peek, which itself produces another Peek, which is the same as the result of the 'parse' function.
104-}
105{-# INLINE peekAmountAndParse #-}
106peekAmountAndParse :: Peek Int -> C.Parse a -> (Int -> a) -> (Text -> a) -> Peek (Peek a)
107peekAmountAndParse peekAmount parse_ eoi error =
108  {-# SCC "peekAmountAndParse" #-}
109  flip fmap peekAmount $ \amount ->
110  parse amount parse_ eoi error
111