Flat.hs

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

module Test.Data.Flat
  ( module Test.Data
  )
where

import           Flat
-- import           Flat.Encoder
-- import           Flat.Decoder
import           Test.Data
import           Test.Data2.Flat                ( )
-- import           Data.Word
-- import           Data.Foldable
-- import           Data.Int
-- import           GHC.Generics

{-
Compilation times:
           encoderS specials cases |
| 7.10.3 | NO                      | 0:44 |
| 7.10.3 | YES                     | 0:39 |
| 8.0.1  | NO                      | 1:30 |
| 8.0.1  | YES                     | 1:30 |
| 8.0.2  | NO                      | 4:18 |
| 8.0.2  | YES                     | 4:18 |
-}
-- GHC 8.0.2 chokes on this
-- instance Flat A0
-- instance Flat B0
-- instance Flat C0
-- instance Flat D0
-- instance Flat E0
#if MIN_VERSION_base(4,9,0) && ! MIN_VERSION_base(4,16,0)
deriving instance Generic (a, b, c, d, e, f, g, h)

deriving instance Generic (a, b, c, d, e, f, g, h, i)
#endif

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

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

instance Flat N

instance Flat Unit

instance Flat a => Flat (List a)

instance Flat a => Flat (Tree a)

instance Flat Direction

instance Flat Words

instance Flat Ints

instance Flat Void

instance Flat N3

instance Flat Un

instance Flat a => Flat (ListS a)

instance Flat A

instance Flat B

instance Flat D2

instance Flat D4

instance Flat a => Flat (Phantom a)

-- Slow to compile
instance Flat Various
-- Custom instances
-- instance {-# OVERLAPPING #-} Flat (Tree (N,N,N)) --where
--   size (Node t1 t2) = 1 + size t1 + size t2
--   size (Leaf a) = 1 + size a
-- -57%
-- instance {-# OVERLAPPING #-} Flat [N] -- where size = foldl' (\s n -> s + 1 + size n) 1
-- instance {-# OVERLAPPING #-} Flat (N,N,N) -- where
-- {-# INLINE size #-}
-- size (n1,n2,n3) = size n1 + size n2 + size n3
-- -50%
-- instance {-# OVERLAPPING #-} Flat (N,N,N) where
--    {-# INLINE encode #-}
--    encode (n1,n2,n3) = wprim $ (Step 9) (encodeN n1 >=> encodeN n2 >=> encodeN n3)
-- {-# INLINE encodeN #-}
-- encodeN = \case
--     One -> eBitsF 2 0
--     Two ->  eBitsF 2 1
--     Three -> eBitsF 2 2
--     Four -> eBitsF 3 6
--     Five -> eBitsF 3 7
-- instance (Flat a, Flat b, Flat c) => Flat (RR a b c)
-- instance Flat a => Flat (Perfect a)
-- instance Flat a => Flat (Fork a)
-- instance Flat a => Flat (Nest a)
--instance   Flat a => Flat (Stream a) where decode = Stream <$> decode <*> decode
-- instance Flat Expr
--instance (Flat a,Flat (f a),Flat (f (f a))) => Flat (PerfectF f a)
-- instance Flat a => Flat (Stream a)
{-
              |
    |
One Two               |
                Three     |
                      Four Five
 -}
-- instance {-# OVERLAPPABLE #-} Flat a => Flat (Tree a) where
--   encode (Node t1 t2) = eFalse <> encode t1 <> encode t2
--   encode (Leaf a) = eTrue <> encode a
-- instance {-# OVERLAPPING #-} Flat (Tree N) where
--   encode (Node t1 t2) = eFalse <> encode t1 <> encode t2
--   encode (Leaf a) = eTrue <> encode a
-- -- -34% (why?)
-- instance Flat N where
--   {-# INLINE encode #-}
--   encode = \case
--     One -> eBits 2 0
--     Two -> eBits 2 1
--     Three -> eBits 2 2
--     Four -> eBits 3 6
--     Five -> eBits 3 7
-- instance  {-# OVERLAPPING #-}  Flat (Tree N)
-- where
--  {-# INLINE decode #-}
--  decode = do
--    tag <- dBool
--    if tag
--      then Leaf <$> decode
--      else Node <$> decode <*> decode
-- instance Flat N
-- where
--  {-# INLINE decode #-}
--  decode = do
--    tag <- dBool
--    if tag
--      then do
--       tag <- dBool
--       if tag
--         then do
--          tag <- dBool
--          if tag
--            then return Five
--            else return Four
--         else return Three
--      else do
--       tag <- dBool
--       if tag
--         then return Two
--         else return One
-- {-# INLINE size #-}
-- size n s = s + case n of
--   One -> 2 
--   Two -> 2
--   Three -> 2
--   Four -> 3
--   Five -> 3
-- instance Flat N where
-- instance {-# OVERLAPPING #-} Flat (Tree N) -- where
-- --   {-# INLINE encode #-}
--   encode (Node t1 t2) = Writer $ \s -> do
--     !s1 <- runWriter eFalse s
--     !s2 <- runWriter (encode t1) s1
--     s3 <- runWriter (encode t2) s2
--     return s3
-- encode (Leaf a) = Writer $ \s -> do
--   s1 <- runWriter eTrue s
--   runWriter (encode a) s1
--   size (Node t1 t2) = 1 + size t1 + size t2
--   size (Leaf a) = 1 + size a
--instance Flat N