{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
module Flat.Decoder.Types
(
Get(..)
, S(..)
, GetResult(..)
, Decoded
, DecodeException(..)
, notEnoughSpace
, tooMuchSpace
, badEncoding
, badOp
) where
import Control.DeepSeq (NFData (..))
import Control.Exception (Exception, throwIO)
import Data.Word (Word8)
import Foreign (Ptr)
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
newtype Get a =
Get
{ forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet ::
Ptr Word8
-> S
-> IO (GetResult a)
}
instance Functor Get where
fmap :: forall a b. (a -> b) -> Get a -> Get b
fmap a -> b
f Get a
g =
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end S
s -> do
GetResult S
s' a
a <- forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet Get a
g Ptr Word8
end S
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult S
s' (a -> b
f a
a)
{-# INLINE fmap #-}
instance NFData (Get a) where
rnf :: Get a -> ()
rnf !Get a
_ = ()
instance Show (Get a) where
show :: Get a -> String
show Get a
_ = String
"Get"
instance Applicative Get where
pure :: forall a. a -> Get a
pure a
x = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get (\Ptr Word8
_ S
ptr -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult S
ptr a
x)
{-# INLINE pure #-}
Get Ptr Word8 -> S -> IO (GetResult (a -> b))
f <*> :: forall a b. Get (a -> b) -> Get a -> Get b
<*> Get Ptr Word8 -> S -> IO (GetResult a)
g =
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end S
ptr1 -> do
GetResult S
ptr2 a -> b
f' <- Ptr Word8 -> S -> IO (GetResult (a -> b))
f Ptr Word8
end S
ptr1
GetResult S
ptr3 a
g' <- Ptr Word8 -> S -> IO (GetResult a)
g Ptr Word8
end S
ptr2
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult S
ptr3 (a -> b
f' a
g')
{-# INLINE (<*>) #-}
Get Ptr Word8 -> S -> IO (GetResult a)
f *> :: forall a b. Get a -> Get b -> Get b
*> Get Ptr Word8 -> S -> IO (GetResult b)
g =
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end S
ptr1 -> do
GetResult S
ptr2 a
_ <- Ptr Word8 -> S -> IO (GetResult a)
f Ptr Word8
end S
ptr1
Ptr Word8 -> S -> IO (GetResult b)
g Ptr Word8
end S
ptr2
{-# INLINE (*>) #-}
instance Monad Get where
return :: forall a. a -> Get a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
>> :: forall a b. Get a -> Get b -> Get b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
{-# INLINE (>>) #-}
Get Ptr Word8 -> S -> IO (GetResult a)
x >>= :: forall a b. Get a -> (a -> Get b) -> Get b
>>= a -> Get b
f =
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end S
s -> do
GetResult S
s' a
x' <- Ptr Word8 -> S -> IO (GetResult a)
x Ptr Word8
end S
s
forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet (a -> Get b
f a
x') Ptr Word8
end S
s'
{-# INLINE (>>=) #-}
#if !(MIN_VERSION_base(4,13,0))
fail = failGet
#endif
#if MIN_VERSION_base(4,9,0)
instance Fail.MonadFail Get where
fail :: forall a. String -> Get a
fail = forall a. String -> Get a
failGet
#endif
{-# INLINE failGet #-}
failGet :: String -> Get a
failGet :: forall a. String -> Get a
failGet String
msg = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end S
s -> forall a. Ptr Word8 -> S -> String -> IO a
badEncoding Ptr Word8
end S
s String
msg
data S =
S
{ S -> Ptr Word8
currPtr :: {-# UNPACK #-}!(Ptr Word8)
, S -> Int
usedBits :: {-# UNPACK #-}!Int
}
deriving (Int -> S -> ShowS
[S] -> ShowS
S -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S] -> ShowS
$cshowList :: [S] -> ShowS
show :: S -> String
$cshow :: S -> String
showsPrec :: Int -> S -> ShowS
$cshowsPrec :: Int -> S -> ShowS
Show, S -> S -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S -> S -> Bool
$c/= :: S -> S -> Bool
== :: S -> S -> Bool
$c== :: S -> S -> Bool
Eq, Eq S
S -> S -> Bool
S -> S -> Ordering
S -> S -> S
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: S -> S -> S
$cmin :: S -> S -> S
max :: S -> S -> S
$cmax :: S -> S -> S
>= :: S -> S -> Bool
$c>= :: S -> S -> Bool
> :: S -> S -> Bool
$c> :: S -> S -> Bool
<= :: S -> S -> Bool
$c<= :: S -> S -> Bool
< :: S -> S -> Bool
$c< :: S -> S -> Bool
compare :: S -> S -> Ordering
$ccompare :: S -> S -> Ordering
Ord)
data GetResult a =
GetResult {-# UNPACK #-}!S !a
deriving (forall a b. a -> GetResult b -> GetResult a
forall a b. (a -> b) -> GetResult a -> GetResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GetResult b -> GetResult a
$c<$ :: forall a b. a -> GetResult b -> GetResult a
fmap :: forall a b. (a -> b) -> GetResult a -> GetResult b
$cfmap :: forall a b. (a -> b) -> GetResult a -> GetResult b
Functor)
type Decoded a = Either DecodeException a
data DecodeException
= NotEnoughSpace Env
| TooMuchSpace Env
| BadEncoding Env String
| BadOp String
deriving (Int -> DecodeException -> ShowS
[DecodeException] -> ShowS
DecodeException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodeException] -> ShowS
$cshowList :: [DecodeException] -> ShowS
show :: DecodeException -> String
$cshow :: DecodeException -> String
showsPrec :: Int -> DecodeException -> ShowS
$cshowsPrec :: Int -> DecodeException -> ShowS
Show, DecodeException -> DecodeException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecodeException -> DecodeException -> Bool
$c/= :: DecodeException -> DecodeException -> Bool
== :: DecodeException -> DecodeException -> Bool
$c== :: DecodeException -> DecodeException -> Bool
Eq, Eq DecodeException
DecodeException -> DecodeException -> Bool
DecodeException -> DecodeException -> Ordering
DecodeException -> DecodeException -> DecodeException
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DecodeException -> DecodeException -> DecodeException
$cmin :: DecodeException -> DecodeException -> DecodeException
max :: DecodeException -> DecodeException -> DecodeException
$cmax :: DecodeException -> DecodeException -> DecodeException
>= :: DecodeException -> DecodeException -> Bool
$c>= :: DecodeException -> DecodeException -> Bool
> :: DecodeException -> DecodeException -> Bool
$c> :: DecodeException -> DecodeException -> Bool
<= :: DecodeException -> DecodeException -> Bool
$c<= :: DecodeException -> DecodeException -> Bool
< :: DecodeException -> DecodeException -> Bool
$c< :: DecodeException -> DecodeException -> Bool
compare :: DecodeException -> DecodeException -> Ordering
$ccompare :: DecodeException -> DecodeException -> Ordering
Ord)
type Env = (Ptr Word8, S)
notEnoughSpace :: Ptr Word8 -> S -> IO a
notEnoughSpace :: forall a. Ptr Word8 -> S -> IO a
notEnoughSpace Ptr Word8
endPtr S
s = forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Env -> DecodeException
NotEnoughSpace (Ptr Word8
endPtr, S
s)
tooMuchSpace :: Ptr Word8 -> S -> IO a
tooMuchSpace :: forall a. Ptr Word8 -> S -> IO a
tooMuchSpace Ptr Word8
endPtr S
s = forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Env -> DecodeException
TooMuchSpace (Ptr Word8
endPtr, S
s)
badEncoding :: Ptr Word8 -> S -> String -> IO a
badEncoding :: forall a. Ptr Word8 -> S -> String -> IO a
badEncoding Ptr Word8
endPtr S
s String
msg = forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Env -> String -> DecodeException
BadEncoding (Ptr Word8
endPtr, S
s) String
msg
badOp :: String -> IO a
badOp :: forall a. String -> IO a
badOp String
msg = forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> DecodeException
BadOp String
msg
instance Exception DecodeException