{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}

-- |Pre-value and post-value byte alignments
module Flat.Filler (
    Filler(..),
    fillerLength,
    PreAligned(..),
    preAligned,
    PostAligned(..),
    postAligned,
    preAlignedDecoder,
    postAlignedDecoder
    ) where

import Flat.Class ( Generic, Flat(..) )
import Flat.Encoder.Strict ( eFiller, sFillerMax )
import Flat.Decoder.Types ( Get )
import Control.DeepSeq ( NFData )
import Data.Typeable ( Typeable )

-- |A meaningless sequence of 0 bits terminated with a 1 bit (easier to implement than the reverse)
-- 
-- Used to align encoded values at byte/word boundaries.
data Filler = FillerBit !Filler
            | FillerEnd
  deriving (Int -> Filler -> ShowS
[Filler] -> ShowS
Filler -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Filler] -> ShowS
$cshowList :: [Filler] -> ShowS
show :: Filler -> String
$cshow :: Filler -> String
showsPrec :: Int -> Filler -> ShowS
$cshowsPrec :: Int -> Filler -> ShowS
Show, Filler -> Filler -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Filler -> Filler -> Bool
$c/= :: Filler -> Filler -> Bool
== :: Filler -> Filler -> Bool
$c== :: Filler -> Filler -> Bool
Eq, Eq Filler
Filler -> Filler -> Bool
Filler -> Filler -> Ordering
Filler -> Filler -> Filler
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 :: Filler -> Filler -> Filler
$cmin :: Filler -> Filler -> Filler
max :: Filler -> Filler -> Filler
$cmax :: Filler -> Filler -> Filler
>= :: Filler -> Filler -> Bool
$c>= :: Filler -> Filler -> Bool
> :: Filler -> Filler -> Bool
$c> :: Filler -> Filler -> Bool
<= :: Filler -> Filler -> Bool
$c<= :: Filler -> Filler -> Bool
< :: Filler -> Filler -> Bool
$c< :: Filler -> Filler -> Bool
compare :: Filler -> Filler -> Ordering
$ccompare :: Filler -> Filler -> Ordering
Ord, Typeable, forall x. Rep Filler x -> Filler
forall x. Filler -> Rep Filler x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Filler x -> Filler
$cfrom :: forall x. Filler -> Rep Filler x
Generic, Filler -> ()
forall a. (a -> ()) -> NFData a
rnf :: Filler -> ()
$crnf :: Filler -> ()
NFData)

-- |Use a special encoding for the filler
instance Flat Filler where
  encode :: Filler -> Encoding
encode Filler
_ = Encoding
eFiller
  size :: Filler -> Int -> Int
size = forall a. Size a
sFillerMax
  -- use generated decode

-- |A Post aligned value, a value followed by a filler
-- 
-- Useful to complete the encoding of a top-level value
data PostAligned a = PostAligned { forall a. PostAligned a -> a
postValue :: a, forall a. PostAligned a -> Filler
postFiller :: Filler }
#ifdef ETA_VERSION    
  deriving (Show, Eq, Ord, Typeable, Generic, NFData)

instance Flat a => Flat (PostAligned a) where
  encode (PostAligned val fill) = trampolineEncoding (encode val) <> encode fill

#else
  deriving (Int -> PostAligned a -> ShowS
forall a. Show a => Int -> PostAligned a -> ShowS
forall a. Show a => [PostAligned a] -> ShowS
forall a. Show a => PostAligned a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostAligned a] -> ShowS
$cshowList :: forall a. Show a => [PostAligned a] -> ShowS
show :: PostAligned a -> String
$cshow :: forall a. Show a => PostAligned a -> String
showsPrec :: Int -> PostAligned a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PostAligned a -> ShowS
Show, PostAligned a -> PostAligned a -> Bool
forall a. Eq a => PostAligned a -> PostAligned a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAligned a -> PostAligned a -> Bool
$c/= :: forall a. Eq a => PostAligned a -> PostAligned a -> Bool
== :: PostAligned a -> PostAligned a -> Bool
$c== :: forall a. Eq a => PostAligned a -> PostAligned a -> Bool
Eq, PostAligned a -> PostAligned a -> Bool
PostAligned a -> PostAligned a -> Ordering
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
forall {a}. Ord a => Eq (PostAligned a)
forall a. Ord a => PostAligned a -> PostAligned a -> Bool
forall a. Ord a => PostAligned a -> PostAligned a -> Ordering
forall a. Ord a => PostAligned a -> PostAligned a -> PostAligned a
min :: PostAligned a -> PostAligned a -> PostAligned a
$cmin :: forall a. Ord a => PostAligned a -> PostAligned a -> PostAligned a
max :: PostAligned a -> PostAligned a -> PostAligned a
$cmax :: forall a. Ord a => PostAligned a -> PostAligned a -> PostAligned a
>= :: PostAligned a -> PostAligned a -> Bool
$c>= :: forall a. Ord a => PostAligned a -> PostAligned a -> Bool
> :: PostAligned a -> PostAligned a -> Bool
$c> :: forall a. Ord a => PostAligned a -> PostAligned a -> Bool
<= :: PostAligned a -> PostAligned a -> Bool
$c<= :: forall a. Ord a => PostAligned a -> PostAligned a -> Bool
< :: PostAligned a -> PostAligned a -> Bool
$c< :: forall a. Ord a => PostAligned a -> PostAligned a -> Bool
compare :: PostAligned a -> PostAligned a -> Ordering
$ccompare :: forall a. Ord a => PostAligned a -> PostAligned a -> Ordering
Ord, Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PostAligned a) x -> PostAligned a
forall a x. PostAligned a -> Rep (PostAligned a) x
$cto :: forall a x. Rep (PostAligned a) x -> PostAligned a
$cfrom :: forall a x. PostAligned a -> Rep (PostAligned a) x
Generic, forall a. NFData a => PostAligned a -> ()
forall a. (a -> ()) -> NFData a
rnf :: PostAligned a -> ()
$crnf :: forall a. NFData a => PostAligned a -> ()
NFData,forall a. Flat a => Get (PostAligned a)
forall a. Flat a => PostAligned a -> Encoding
forall a. Flat a => PostAligned a -> Int -> Int
forall a. (a -> Encoding) -> Get a -> (a -> Int -> Int) -> Flat a
size :: PostAligned a -> Int -> Int
$csize :: forall a. Flat a => PostAligned a -> Int -> Int
decode :: Get (PostAligned a)
$cdecode :: forall a. Flat a => Get (PostAligned a)
encode :: PostAligned a -> Encoding
$cencode :: forall a. Flat a => PostAligned a -> Encoding
Flat)
#endif
--  deriving (Show, Eq, Ord, Typeable, Generic, NFData,Flat)


-- |A Pre aligned value, a value preceded by a filler
-- 
-- Useful to prealign ByteArrays, Texts and any structure that can be encoded more efficiently when byte aligned.  
data PreAligned a = PreAligned { forall a. PreAligned a -> Filler
preFiller :: Filler, forall a. PreAligned a -> a
preValue :: a }
  deriving (Int -> PreAligned a -> ShowS
forall a. Show a => Int -> PreAligned a -> ShowS
forall a. Show a => [PreAligned a] -> ShowS
forall a. Show a => PreAligned a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreAligned a] -> ShowS
$cshowList :: forall a. Show a => [PreAligned a] -> ShowS
show :: PreAligned a -> String
$cshow :: forall a. Show a => PreAligned a -> String
showsPrec :: Int -> PreAligned a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PreAligned a -> ShowS
Show, PreAligned a -> PreAligned a -> Bool
forall a. Eq a => PreAligned a -> PreAligned a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreAligned a -> PreAligned a -> Bool
$c/= :: forall a. Eq a => PreAligned a -> PreAligned a -> Bool
== :: PreAligned a -> PreAligned a -> Bool
$c== :: forall a. Eq a => PreAligned a -> PreAligned a -> Bool
Eq, PreAligned a -> PreAligned a -> Bool
PreAligned a -> PreAligned a -> Ordering
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
forall {a}. Ord a => Eq (PreAligned a)
forall a. Ord a => PreAligned a -> PreAligned a -> Bool
forall a. Ord a => PreAligned a -> PreAligned a -> Ordering
forall a. Ord a => PreAligned a -> PreAligned a -> PreAligned a
min :: PreAligned a -> PreAligned a -> PreAligned a
$cmin :: forall a. Ord a => PreAligned a -> PreAligned a -> PreAligned a
max :: PreAligned a -> PreAligned a -> PreAligned a
$cmax :: forall a. Ord a => PreAligned a -> PreAligned a -> PreAligned a
>= :: PreAligned a -> PreAligned a -> Bool
$c>= :: forall a. Ord a => PreAligned a -> PreAligned a -> Bool
> :: PreAligned a -> PreAligned a -> Bool
$c> :: forall a. Ord a => PreAligned a -> PreAligned a -> Bool
<= :: PreAligned a -> PreAligned a -> Bool
$c<= :: forall a. Ord a => PreAligned a -> PreAligned a -> Bool
< :: PreAligned a -> PreAligned a -> Bool
$c< :: forall a. Ord a => PreAligned a -> PreAligned a -> Bool
compare :: PreAligned a -> PreAligned a -> Ordering
$ccompare :: forall a. Ord a => PreAligned a -> PreAligned a -> Ordering
Ord, Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PreAligned a) x -> PreAligned a
forall a x. PreAligned a -> Rep (PreAligned a) x
$cto :: forall a x. Rep (PreAligned a) x -> PreAligned a
$cfrom :: forall a x. PreAligned a -> Rep (PreAligned a) x
Generic, forall a. NFData a => PreAligned a -> ()
forall a. (a -> ()) -> NFData a
rnf :: PreAligned a -> ()
$crnf :: forall a. NFData a => PreAligned a -> ()
NFData, forall a. Flat a => Get (PreAligned a)
forall a. Flat a => PreAligned a -> Encoding
forall a. Flat a => PreAligned a -> Int -> Int
forall a. (a -> Encoding) -> Get a -> (a -> Int -> Int) -> Flat a
size :: PreAligned a -> Int -> Int
$csize :: forall a. Flat a => PreAligned a -> Int -> Int
decode :: Get (PreAligned a)
$cdecode :: forall a. Flat a => Get (PreAligned a)
encode :: PreAligned a -> Encoding
$cencode :: forall a. Flat a => PreAligned a -> Encoding
Flat)

-- |Length of a filler in bits
fillerLength :: Num a => Filler -> a
fillerLength :: forall a. Num a => Filler -> a
fillerLength Filler
FillerEnd     = a
1
fillerLength (FillerBit Filler
f) = a
1 forall a. Num a => a -> a -> a
+ forall a. Num a => Filler -> a
fillerLength Filler
f

-- |Post align a value
postAligned :: a -> PostAligned a
postAligned :: forall a. a -> PostAligned a
postAligned a
a = forall a. a -> Filler -> PostAligned a
PostAligned a
a Filler
FillerEnd

-- |Pre align a value
preAligned :: a -> PreAligned a
preAligned :: forall a. a -> PreAligned a
preAligned = forall a. Filler -> a -> PreAligned a
PreAligned Filler
FillerEnd

-- |Decode a value assuming that is PostAligned
postAlignedDecoder :: Get b -> Get b
postAlignedDecoder :: forall b. Get b -> Get b
postAlignedDecoder Get b
dec = do
  b
v <- Get b
dec
  Filler
_::Filler <- forall a. Flat a => Get a
decode
  forall (m :: * -> *) a. Monad m => a -> m a
return b
v

-- |Decode a value assuming that is PreAligned
-- 
-- @since 0.5
preAlignedDecoder :: Get b -> Get b
preAlignedDecoder :: forall b. Get b -> Get b
preAlignedDecoder Get b
dec = do
  Filler
_::Filler <- forall a. Flat a => Get a
decode
  Get b
dec