{-# LANGUAGE InstanceSigs              #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables       #-}

{- |
Wrapper type to decode a value to its size in bits.

See also "Flat.AsBin".

In 0.5.X this type was called @SizeOf@.

@since 0.6
-}
module Flat.AsSize(AsSize(..)) where

import           Flat.Class         (Flat (..))
import           Flat.Decoder.Prim  (sizeOf)
import           Flat.Decoder.Types (Get)
import           Flat.Types         (NumBits)

-- $setup
-- >>> :set -XScopedTypeVariables
-- >>> import Flat.Instances.Base
-- >>> import Flat.Instances.Text
-- >>> import Flat.Decoder.Types
-- >>> import Flat.Types
-- >>> import Flat.Run
-- >>> import Data.Word
-- >>> import qualified Data.Text as T

{- |
Useful to skip unnecessary values and to check encoding sizes.

Examples:

Ignore the second and fourth component of a tuple:

>>> let v = flat ('a',"abc",'z',True) in unflat v :: Decoded (Char,AsSize String,Char,AsSize Bool)
Right ('a',AsSize 28,'z',AsSize 1)

Notice the variable size encoding of Words:

>>> unflat (flat (1::Word16,1::Word64)) :: Decoded (AsSize Word16,AsSize Word64)
Right (AsSize 8,AsSize 8)

Text:

>>> unflat (flat (T.pack "",T.pack "a",T.pack "主",UTF8Text $ T.pack "主",UTF16Text $ T.pack "主",UTF16Text $ T.pack "a")) :: Decoded (AsSize T.Text,AsSize T.Text,AsSize T.Text,AsSize UTF8Text,AsSize UTF16Text,AsSize UTF16Text)
Right (AsSize 16,AsSize 32,AsSize 48,AsSize 48,AsSize 40,AsSize 40)

Various encodings:

>>> unflat (flat (False,[T.pack "",T.pack "a",T.pack "主"],'a')) :: Decoded (AsSize Bool,AsSize [T.Text],AsSize Char)
Right (AsSize 1,AsSize 96,AsSize 8)
-}
newtype AsSize a = AsSize NumBits deriving (AsSize a -> AsSize a -> Bool
forall a. AsSize a -> AsSize a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AsSize a -> AsSize a -> Bool
$c/= :: forall a. AsSize a -> AsSize a -> Bool
== :: AsSize a -> AsSize a -> Bool
$c== :: forall a. AsSize a -> AsSize a -> Bool
Eq,AsSize a -> AsSize a -> Bool
AsSize a -> AsSize a -> Ordering
AsSize a -> AsSize a -> AsSize a
forall a. Eq (AsSize a)
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. AsSize a -> AsSize a -> Bool
forall a. AsSize a -> AsSize a -> Ordering
forall a. AsSize a -> AsSize a -> AsSize a
min :: AsSize a -> AsSize a -> AsSize a
$cmin :: forall a. AsSize a -> AsSize a -> AsSize a
max :: AsSize a -> AsSize a -> AsSize a
$cmax :: forall a. AsSize a -> AsSize a -> AsSize a
>= :: AsSize a -> AsSize a -> Bool
$c>= :: forall a. AsSize a -> AsSize a -> Bool
> :: AsSize a -> AsSize a -> Bool
$c> :: forall a. AsSize a -> AsSize a -> Bool
<= :: AsSize a -> AsSize a -> Bool
$c<= :: forall a. AsSize a -> AsSize a -> Bool
< :: AsSize a -> AsSize a -> Bool
$c< :: forall a. AsSize a -> AsSize a -> Bool
compare :: AsSize a -> AsSize a -> Ordering
$ccompare :: forall a. AsSize a -> AsSize a -> Ordering
Ord,NumBits -> AsSize a -> ShowS
forall a. NumBits -> AsSize a -> ShowS
forall a. [AsSize a] -> ShowS
forall a. AsSize a -> String
forall a.
(NumBits -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AsSize a] -> ShowS
$cshowList :: forall a. [AsSize a] -> ShowS
show :: AsSize a -> String
$cshow :: forall a. AsSize a -> String
showsPrec :: NumBits -> AsSize a -> ShowS
$cshowsPrec :: forall a. NumBits -> AsSize a -> ShowS
Show)

instance Flat a => Flat (AsSize a) where
    size :: Flat a => AsSize a -> NumBits -> NumBits
    size :: Flat a => AsSize a -> NumBits -> NumBits
size = forall a. HasCallStack => String -> a
error String
"unused"

    encode :: AsSize a -> Encoding
encode = forall a. HasCallStack => String -> a
error String
"unused"

    decode :: Flat a => Get (AsSize a)
    decode :: Flat a => Get (AsSize a)
decode = forall a. NumBits -> AsSize a
AsSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Get a -> Get NumBits
sizeOf (forall a. Flat a => Get a
decode :: Get a)