{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE StandaloneDeriving #-}

-- | Flat instances for the base library
module Flat.Instances.Base () where

import           Control.Monad         (liftM2)
import           Data.Bool
import           Data.Char
import           Data.Complex          (Complex (..))
import           Data.Fixed
-- #if MIN_VERSION_base(4,9,0)
import qualified Data.List.NonEmpty    as B
-- #endif

#if ! MIN_VERSION_base(4,8,0)
import           Control.Applicative
import           Data.Monoid           (mempty)
#endif

#if MIN_VERSION_base(4,9,0)
import qualified Data.Semigroup        as Semigroup
#endif

import qualified Data.Monoid           as Monoid
import           Data.Ratio
import           Flat.Instances.Util
import           Prelude               hiding (mempty)

-- #if !MIN_VERSION_base(4,9,0)
-- import           Data.Monoid           ((<>))
-- #endif

#if MIN_VERSION_base(4,9,0)
import           Data.Functor.Identity (Identity (..))
#endif

-- #if !MIN_VERSION_base(4,9,0)
-- deriving instance Generic (Complex a)
-- #endif

{- ORMOLU_DISABLE -}
-- $setup
-- >>> :set -XNegativeLiterals -XTypeApplications
-- >>> import Flat.Instances.Test
-- >>> import Data.Fixed
-- >>> import Data.Int
-- >>> import Data.Complex(Complex(..))
-- >>> import Numeric.Natural
-- >>> import Data.Word
-- >>> import Data.Ratio
-- >>> import Flat.Run
-- >>> import Data.Monoid
-- >>> import qualified Data.List.NonEmpty as B
-- >>> let test = tstBits
-- >>> let y = 33
{- ORMOLU_ENABLE -}

-- >>> y

-- | @since 0.4.4
#if MIN_VERSION_base(4,8,0)
instance Flat Monoid.All where
    encode :: All -> Encoding
encode (Monoid.All Bool
a) = forall a. Flat a => a -> Encoding
encode Bool
a
    size :: All -> NumBits -> NumBits
size (Monoid.All Bool
a) = forall a. Flat a => a -> NumBits -> NumBits
size Bool
a
    decode :: Get All
decode = Bool -> All
Monoid.All forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode

{- |

>>> let w = Just (11::Word8); a = Alt w <> Alt (Just 24) in tst a == tst w
True

>>> let w = Just (11::Word8); a = Alt Nothing <> Alt w in tst a == tst w
True

@since 0.4.4
-}
instance Flat (f a) => Flat (Monoid.Alt f a) where
    encode :: Alt f a -> Encoding
encode (Monoid.Alt f a
a) = forall a. Flat a => a -> Encoding
encode f a
a
    size :: Alt f a -> NumBits -> NumBits
size (Monoid.Alt f a
a) = forall a. Flat a => a -> NumBits -> NumBits
size f a
a
    decode :: Get (Alt f a)
decode = forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Monoid.Alt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode
#endif

#if MIN_VERSION_base(4,9,0)
-- | @since 0.4.4
instance Flat a => Flat (Identity a) where
    encode :: Identity a -> Encoding
encode (Identity a
a) = forall a. Flat a => a -> Encoding
encode a
a
    size :: Identity a -> NumBits -> NumBits
size (Identity a
a) = forall a. Flat a => a -> NumBits -> NumBits
size a
a
    decode :: Get (Identity a)
decode = forall a. a -> Identity a
Identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode
#endif

-- | @since 0.4.4
instance Flat a => Flat (Monoid.Dual a) where
    encode :: Dual a -> Encoding
encode (Monoid.Dual a
a) = forall a. Flat a => a -> Encoding
encode a
a
    size :: Dual a -> NumBits -> NumBits
size (Monoid.Dual a
a) = forall a. Flat a => a -> NumBits -> NumBits
size a
a
    decode :: Get (Dual a)
decode = forall a. a -> Dual a
Monoid.Dual forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode

-- | @since 0.4.4
instance Flat Monoid.Any where
    encode :: Any -> Encoding
encode (Monoid.Any Bool
a) = forall a. Flat a => a -> Encoding
encode Bool
a
    size :: Any -> NumBits -> NumBits
size (Monoid.Any Bool
a) = forall a. Flat a => a -> NumBits -> NumBits
size Bool
a
    decode :: Get Any
decode = Bool -> Any
Monoid.Any forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode

-- | @since 0.4.4
instance Flat a => Flat (Monoid.Sum a) where
    encode :: Sum a -> Encoding
encode (Monoid.Sum a
a) = forall a. Flat a => a -> Encoding
encode a
a
    size :: Sum a -> NumBits -> NumBits
size (Monoid.Sum a
a) = forall a. Flat a => a -> NumBits -> NumBits
size a
a
    decode :: Get (Sum a)
decode = forall a. a -> Sum a
Monoid.Sum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode

-- | @since 0.4.4
instance Flat a => Flat (Monoid.Product a) where
    encode :: Product a -> Encoding
encode (Monoid.Product a
a) = forall a. Flat a => a -> Encoding
encode a
a
    size :: Product a -> NumBits -> NumBits
size (Monoid.Product a
a) = forall a. Flat a => a -> NumBits -> NumBits
size a
a
    decode :: Get (Product a)
decode = forall a. a -> Product a
Monoid.Product forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode

#if MIN_VERSION_base(4,9,0)
-- | @since 0.4.4
instance Flat a => Flat (Semigroup.Min a) where
    encode :: Min a -> Encoding
encode (Semigroup.Min a
a) = forall a. Flat a => a -> Encoding
encode a
a
    size :: Min a -> NumBits -> NumBits
size (Semigroup.Min a
a) = forall a. Flat a => a -> NumBits -> NumBits
size a
a
    decode :: Get (Min a)
decode = forall a. a -> Min a
Semigroup.Min forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode

-- | @since 0.4.4
instance Flat a => Flat (Semigroup.Max a) where
    encode :: Max a -> Encoding
encode (Semigroup.Max a
a) = forall a. Flat a => a -> Encoding
encode a
a
    size :: Max a -> NumBits -> NumBits
size (Semigroup.Max a
a) = forall a. Flat a => a -> NumBits -> NumBits
size a
a
    decode :: Get (Max a)
decode = forall a. a -> Max a
Semigroup.Max forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode

-- | @since 0.4.4
instance Flat a => Flat (Semigroup.First a) where
    encode :: First a -> Encoding
encode (Semigroup.First a
a) = forall a. Flat a => a -> Encoding
encode a
a
    size :: First a -> NumBits -> NumBits
size (Semigroup.First a
a) = forall a. Flat a => a -> NumBits -> NumBits
size a
a
    decode :: Get (First a)
decode = forall a. a -> First a
Semigroup.First forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode

-- | @since 0.4.4
instance Flat a => Flat (Semigroup.Last a) where
    encode :: Last a -> Encoding
encode (Semigroup.Last a
a) = forall a. Flat a => a -> Encoding
encode a
a
    size :: Last a -> NumBits -> NumBits
size (Semigroup.Last a
a) = forall a. Flat a => a -> NumBits -> NumBits
size a
a
    decode :: Get (Last a)
decode = forall a. a -> Last a
Semigroup.Last forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode
#endif

{- |
`()`, as all data types with a single constructor, has a zero-length encoding.

>>> test ()
(True,0,"")
-}
instance Flat () where
    encode :: () -> Encoding
encode ()
_ = forall a. Monoid a => a
mempty

    size :: () -> NumBits -> NumBits
size ()
_ = forall a. a -> a
id

    decode :: Get ()
decode = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{- |
One bit is plenty for a Bool.

>>> test False
(True,1,"0")

>>> test True
(True,1,"1")
-}
instance Flat Bool where
    encode :: Bool -> Encoding
encode = Bool -> Encoding
eBool

    size :: Bool -> NumBits -> NumBits
size = Bool -> NumBits -> NumBits
sBool

    decode :: Get Bool
decode = Get Bool
dBool

{- |
Char's are mapped to Word32 and then encoded.

For ascii characters, the encoding is standard ascii.

>>> test 'a'
(True,8,"01100001")

For unicode characters, the encoding is non standard.

>>> test 'È'
(True,16,"11001000 00000001")

>>> test '不'
(True,24,"10001101 10011100 00000001")

#ifndef ETA
>>> test "\x1F600"
(True,26,"11000000 01110110 00000011 10")
#endif
-}
instance Flat Char where
    size :: Char -> NumBits -> NumBits
size = Char -> NumBits -> NumBits
sChar

    encode :: Char -> Encoding
encode = Char -> Encoding
eChar

    decode :: Get Char
decode = Get Char
dChar

{- |
>>> test (Nothing::Maybe Bool)
(True,1,"0")

>>> test (Just False::Maybe Bool)
(True,2,"10")
-}
instance Flat a => Flat (Maybe a)

{- |
>>> test (Left False::Either Bool ())
(True,2,"00")

>>> test (Right ()::Either Bool ())
(True,1,"1")
-}
instance (Flat a, Flat b) => Flat (Either a b)

{- |
>>> test (MkFixed 123 :: Fixed E0)
(True,16,"11110110 00000001")

>>> test (MkFixed 123 :: Fixed E0) == test (MkFixed 123 :: Fixed E2)
True
-}
instance Flat (Fixed a) where
    encode :: Fixed a -> Encoding
encode (MkFixed Integer
n) = forall a. Flat a => a -> Encoding
encode Integer
n

    size :: Fixed a -> NumBits -> NumBits
size (MkFixed Integer
n) = forall a. Flat a => a -> NumBits -> NumBits
size Integer
n

    decode :: Get (Fixed a)
decode = forall k (a :: k). Integer -> Fixed a
MkFixed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode

{- |
Word8 always take 8 bits.

>>> test (0::Word8)
(True,8,"00000000")

>>> test (255::Word8)
(True,8,"11111111")
-}
instance Flat Word8 where
    encode :: Word8 -> Encoding
encode = Word8 -> Encoding
eWord8

    decode :: Get Word8
decode = Get Word8
dWord8

    size :: Word8 -> NumBits -> NumBits
size = Word8 -> NumBits -> NumBits
sWord8

{- |
Natural, Word, Word16, Word32 and Word64 are encoded as a non empty list of 7 bits chunks (least significant chunk first and most significant bit first in every chunk).

Words are always encoded in a whole number of bytes, as every chunk is 8 bits long (1 bit for the List constructor, plus 7 bits for the value).

The actual definition is:

@
Word64 ≡   Word64 Word

Word32 ≡   Word32 Word

Word16 ≡   Word16 Word

Word ≡   Word (LeastSignificantFirst (NonEmptyList (MostSignificantFirst Word7)))

LeastSignificantFirst a ≡   LeastSignificantFirst a

NonEmptyList a ≡   Elem a
                 | Cons a (NonEmptyList a)

MostSignificantFirst a ≡   MostSignificantFirst a

Word7 ≡   V0
        | V1
        | V2
        ...
        | V127
@

Values between as 0 and 127 fit in a single byte.

127 (0b1111111) is represented as Elem V127 and encoded as: Elem=0 127=1111111

>>> test (127::Word)
(True,8,"01111111")

254 (0b11111110) is represented as Cons V126 (Elem V1) (254=128+126) and encoded as: Cons=1 V126=1111110 (Elem=0 V1=0000001):

>>> test (254::Word)
(True,16,"11111110 00000001")

Another example, 32768 (Ob1000000000000000 = 0000010 0000000 0000000):

>>> test (32768::Word32)
(True,24,"10000000 10000000 00000010")

As this is a variable length encoding, values are encoded in the same way, whatever their type:

>>> all (test (3::Word) ==) [test (3::Word16),test (3::Word32),test (3::Word64)]
True


Word/Int decoders return an error if the encoded value is outside their valid range:

>>> unflat @Word16 (flat @Word32 $ fromIntegral @Word16 maxBound)
Right 65535

>>> unflat @Word16 (flat @Word32 $ fromIntegral @Word16 maxBound + 1)
Left (BadEncoding ...

>>> unflat @Word32 (flat @Word64 $ fromIntegral @Word32 maxBound)
Right 4294967295

>>> unflat @Word32 (flat @Word64 $ fromIntegral @Word32 maxBound + 1)
Left (BadEncoding ...

>>> unflat @Word64 (flat @Natural $ fromIntegral @Word64 maxBound)
Right 18446744073709551615

>>> unflat @Word64 (flat @Natural $ fromIntegral @Word64 maxBound + 1)
Left (BadEncoding ...



>>> unflat @Int16 (flat @Int32 $ fromIntegral @Int16 maxBound)
Right 32767

>>> unflat @Int16 (flat @Int32 $ fromIntegral @Int16 maxBound + 1)
Left (BadEncoding ...

>>> unflat @Int32 (flat @Int64 $ fromIntegral @Int32 maxBound)
Right 2147483647

>>> unflat @Int32 (flat @Int64 $ fromIntegral @Int32 maxBound + 1)
Left (BadEncoding ...

>>> unflat @Int64 (flat @Integer $ fromIntegral @Int64 maxBound)
Right 9223372036854775807

>>> unflat @Int64 (flat @Integer $ fromIntegral @Int64 maxBound + 1)
Left (BadEncoding ...


>>> unflat @Int16 (flat @Int32 $ fromIntegral @Int16 minBound)
Right (-32768)

>>> unflat @Int16 (flat @Int32 $ fromIntegral @Int16 minBound - 1)
Left (BadEncoding ...

>>> unflat @Int32 (flat @Int64 $ fromIntegral @Int32 minBound)
Right (-2147483648)

>>> unflat @Int32 (flat @Int64 $ fromIntegral @Int32 minBound - 1)
Left (BadEncoding ...

>>> unflat @Int64 (flat @Integer $ fromIntegral @Int64 minBound)
Right (-9223372036854775808)

>>> unflat @Int64 (flat @Integer $ fromIntegral @Int64 minBound - 1)
Left (BadEncoding ...
-}
instance Flat Word where
    size :: Word -> NumBits -> NumBits
size = Word -> NumBits -> NumBits
sWord

    encode :: Word -> Encoding
encode = Word -> Encoding
eWord

    decode :: Get Word
decode = Get Word
dWord

{- |
Naturals are encoded just as the fixed size Words.

>>> test (0::Natural)
(True,8,"00000000")

>>> test (2^120::Natural)
(True,144,"10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000010")
-}
instance Flat Natural where
    size :: Nat -> NumBits -> NumBits
size = Nat -> NumBits -> NumBits
sNatural

    encode :: Nat -> Encoding
encode = Nat -> Encoding
eNatural

    decode :: Get Nat
decode = Get Nat
dNatural

instance Flat Word16 where
    encode :: Word16 -> Encoding
encode = Word16 -> Encoding
eWord16

    decode :: Get Word16
decode = Get Word16
dWord16

    size :: Word16 -> NumBits -> NumBits
size = Word16 -> NumBits -> NumBits
sWord16

instance Flat Word32 where
    encode :: Word32 -> Encoding
encode = Word32 -> Encoding
eWord32

    decode :: Get Word32
decode = Get Word32
dWord32

    size :: Word32 -> NumBits -> NumBits
size = Word32 -> NumBits -> NumBits
sWord32

instance Flat Word64 where
    encode :: Word64 -> Encoding
encode = Word64 -> Encoding
eWord64

    decode :: Get Word64
decode = Get Word64
dWord64

    size :: Word64 -> NumBits -> NumBits
size = Word64 -> NumBits -> NumBits
sWord64

{- |
Integer, Int, Int16, Int32 and Int64 are defined as the <https://developers.google.com/protocol-buffers/docs/encoding#signed-integers ZigZag> encoded version of the equivalent unsigned Word:

@
Int   ≡  Int   (ZigZag Word)

Int64 ≡  Int64 (ZigZag Word64)

Int32 ≡  Int32 (ZigZag Word32)

Int16 ≡  Int16 (ZigZag Word16)

Int8  ≡  Int8  (ZigZag Word8)

ZigZag a ≡ ZigZag a
@

ZigZag encoding alternates between positive and negative numbers, so that numbers whose absolute value is small can be encoded efficiently:

>>> test (0::Int)
(True,8,"00000000")

>>> test (-1::Int)
(True,8,"00000001")

>>> test (1::Int)
(True,8,"00000010")

>>> test (-2::Int)
(True,8,"00000011")

>>> test (2::Int)
(True,8,"00000100")
-}
instance Flat Int where
    size :: NumBits -> NumBits -> NumBits
size = NumBits -> NumBits -> NumBits
sInt

    encode :: NumBits -> Encoding
encode = NumBits -> Encoding
eInt

    decode :: Get NumBits
decode = Get NumBits
dInt

{- |
Integers are encoded just as the fixed size Ints.

>>> test (0::Integer)
(True,8,"00000000")

>>> test (-1::Integer)
(True,8,"00000001")

>>> test (1::Integer)
(True,8,"00000010")

>>> test (-(2^4)::Integer)
(True,8,"00011111")

>>> test (2^4::Integer)
(True,8,"00100000")

>>> test (-(2^120)::Integer)
(True,144,"11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000011")

>>> test (2^120::Integer)
(True,144,"10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000100")
-}
instance Flat Integer where
    size :: Integer -> NumBits -> NumBits
size = Integer -> NumBits -> NumBits
sInteger

    encode :: Integer -> Encoding
encode = Integer -> Encoding
eInteger

    decode :: Get Integer
decode = Get Integer
dInteger

{- |
>>> test (0::Int8)
(True,8,"00000000")

>>> test (127::Int8)
(True,8,"11111110")

>>> test (-128::Int8)
(True,8,"11111111")
-}
instance Flat Int8 where
    encode :: Int8 -> Encoding
encode = Int8 -> Encoding
eInt8

    decode :: Get Int8
decode = Get Int8
dInt8

    size :: Int8 -> NumBits -> NumBits
size = Int8 -> NumBits -> NumBits
sInt8

{- |
>>> test (0::Int16)
(True,8,"00000000")

>>> test (1::Int16)
(True,8,"00000010")

>>> test (-1::Int16)
(True,8,"00000001")

>>> test (minBound::Int16)
(True,24,"11111111 11111111 00000011")

equivalent to 0b1111111111111111

>>> test (maxBound::Int16)
(True,24,"11111110 11111111 00000011")

equivalent to 0b1111111111111110
-}
instance Flat Int16 where
    size :: Int16 -> NumBits -> NumBits
size = Int16 -> NumBits -> NumBits
sInt16

    encode :: Int16 -> Encoding
encode = Int16 -> Encoding
eInt16

    decode :: Get Int16
decode = Get Int16
dInt16

{- |
>>> test (0::Int32)
(True,8,"00000000")

>>> test (minBound::Int32)
(True,40,"11111111 11111111 11111111 11111111 00001111")

>>> test (maxBound::Int32)
(True,40,"11111110 11111111 11111111 11111111 00001111")
-}
instance Flat Int32 where
    size :: Int32 -> NumBits -> NumBits
size = Int32 -> NumBits -> NumBits
sInt32

    encode :: Int32 -> Encoding
encode = Int32 -> Encoding
eInt32

    decode :: Get Int32
decode = Get Int32
dInt32

{- |
>>> test (0::Int64)
(True,8,"00000000")

>>> test (minBound::Int64)
(True,80,"11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000001")

>>> test (maxBound::Int64)
(True,80,"11111110 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000001")
-}
instance Flat Int64 where
    size :: Int64 -> NumBits -> NumBits
size = Int64 -> NumBits -> NumBits
sInt64

    encode :: Int64 -> Encoding
encode = Int64 -> Encoding
eInt64

    decode :: Get Int64
decode = Get Int64
dInt64

{- |
Floats are encoded as standard IEEE binary32 values:

@
IEEE_754_binary32 ≡ IEEE_754_binary32 {sign :: Sign,
                                        exponent :: MostSignificantFirst Bits8,
                                        fraction :: MostSignificantFirst Bits23}
@

>>> test (0::Float)
(True,32,"00000000 00000000 00000000 00000000")

>>> test (1.4012984643E-45::Float)
(True,32,"00000000 00000000 00000000 00000001")

>>> test (1.1754942107E-38::Float)
(True,32,"00000000 01111111 11111111 11111111")
-}
instance Flat Float where
    size :: Float -> NumBits -> NumBits
size = Float -> NumBits -> NumBits
sFloat

    encode :: Float -> Encoding
encode = Float -> Encoding
eFloat

    decode :: Get Float
decode = Get Float
dFloat

{- |
Doubles are encoded as standard IEEE binary64 values:

@
IEEE_754_binary64 ≡ IEEE_754_binary64 {sign :: Sign,
                                        exponent :: MostSignificantFirst Bits11,
                                        fraction :: MostSignificantFirst Bits52}
@
-}
instance Flat Double where
    size :: Double -> NumBits -> NumBits
size = Double -> NumBits -> NumBits
sDouble

    encode :: Double -> Encoding
encode = Double -> Encoding
eDouble

    decode :: Get Double
decode = Get Double
dDouble

{- |
>>> test (4 :+ 2 :: Complex Word8)
(True,16,"00000100 00000010")
-}
instance Flat a => Flat (Complex a)

{- |
Ratios are encoded as tuples of (numerator,denominator)

>>> test (3%4::Ratio Word8)
(True,16,"00000011 00000100")
-}
instance (Integral a, Flat a) => Flat (Ratio a) where
    size :: Ratio a -> NumBits -> NumBits
size Ratio a
a = forall a. Flat a => a -> NumBits -> NumBits
size (forall a. Ratio a -> a
numerator Ratio a
a, forall a. Ratio a -> a
denominator Ratio a
a)

    encode :: Ratio a -> Encoding
encode Ratio a
a = forall a. Flat a => a -> Encoding
encode (forall a. Ratio a -> a
numerator Ratio a
a, forall a. Ratio a -> a
denominator Ratio a
a)

    -- decode = uncurry (%) <$> decode
    decode :: Get (Ratio a)
decode = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. Integral a => a -> a -> Ratio a
(%) forall a. Flat a => Get a
decode forall a. Flat a => Get a
decode

{- |
>>> test ([]::[Bool])
(True,1,"0")

>>> test [False,False]
(True,5,"10100")

This instance and other similar ones are declared as @OVERLAPPABLE@, because for better encoding/decoding
performance it can be useful to declare instances of concrete types, such as @[Char]@ (not provided out of the box).
-}
instance {-# OVERLAPPABLE #-} Flat a => Flat [a]

{-
>>> import Weigh
>>> flat [1..10::Int]
-}


-- Generic list instance (stack overflows with ETA, see https://github.com/typelead/eta/issues/901)
-- where
--size [] n = n+1
--size (h:t) n = trampoline size t (trampoline size h (n+1))
-- size = sizeListWith size -- foldl' (\n e -> ) n
-- encode = error "BAD"
-- encode = trampoline . encodeListWith encode
-- decode = decodeListWith decode
-- sizeListWith siz l n = foldl' (\n e -> 1 + n + siz e 0) n l
-- #ifdef ETA_VERSION
-- import Data.Function(trampoline)
-- import GHC.IO(trampolineIO)
-- #else
-- trampoline = id
-- trampolineIO = id
-- #endif

-- #if MIN_VERSION_base(4,9,0)

{- |
>>> test (B.fromList [True])
(True,2,"10")

>>> test (B.fromList [False,False])
(True,4,"0100")
-}
instance {-# OVERLAPPABLE #-} Flat a => Flat (B.NonEmpty a)

-- #endif

{- |
Tuples are supported up to 7 elements.

>>> test (False,())
(True,1,"0")

>>> test ((),())
(True,0,"")

"7 elements tuples ought to be enough for anybody" (Bill Gates - apocryphal)

>>> test (False,True,True,True,False,True,True)
(True,7,"0111011")

tst (1::Int,"2","3","4","5","6","7","8")
...error
-}

-- Not sure if these should be OVERLAPPABLE
instance {-# OVERLAPPABLE #-} (Flat a, Flat b) => Flat (a, b)

instance {-# OVERLAPPABLE #-} (Flat a, Flat b, Flat c) => Flat (a, b, c)

instance
    {-# OVERLAPPABLE #-}
    (Flat a, Flat b, Flat c, Flat d) =>
    Flat (a, b, c, d)

instance
    {-# OVERLAPPABLE #-}
    (Flat a, Flat b, Flat c, Flat d, Flat e) =>
    Flat (a, b, c, d, e)

instance
    {-# OVERLAPPABLE #-}
    (Flat a, Flat b, Flat c, Flat d, Flat e, Flat f) =>
    Flat (a, b, c, d, e, f)

instance
    {-# OVERLAPPABLE #-}
    ( Flat a
    , Flat b
    , Flat c
    , Flat d
    , Flat e
    , Flat f
    , Flat g
    ) =>
    Flat (a, b, c, d, e, f, g)