content: {-# LANGUAGE DeriveAnyClass  #-}
  {-# LANGUAGE TemplateHaskell #-}
  module Test.Pos.Binary.BiSerialize
      ( tests
      ) where
  
  import           Universum
  
  import           Hedgehog (Property)
  import qualified Hedgehog as H
  
  import           Pos.Binary.Class (Cons (..), Field (..), cborError,
                       deriveIndexedBi)
  import           Test.Pos.Binary.Helpers.GoldenRoundTrip (goldenTestBi)
  import           Test.Pos.Util.Golden (discoverGolden)
  
  --------------------------------------------------------------------------------
  -- Since `deriveSimpleBi` no longer works on sum types, we cannot do a simple
  -- comparison property between `deriveSimpleBi` and `deriveIndexedBi`. Instead,
  -- this module contains golden tests. The tests were generated by the following
  -- process (done before sumtypes were disallowed from `deriveSimpleBi`):
  --
  -- 1. Generate values of type TestSimple (either by hand or via `genTestSimple`)
  -- 2. Use `deriveSimpleBi` Bi instance to serialize the value to a file
  -- 3. Translate the value to type TestIndexed via `simpleToIndexed`
  -- 4. Hardcode the result of (3.) into a golden test, which checks equivalence
  --    with the output of (2.)
  --
  -- This ensures that our encoding scheme was preserved, at least on a set of
  -- points which exercise all the constructors of `TestIndexed`.
  --------------------------------------------------------------------------------
  
  data TestIndexed
      = TiInt Int
      | TiIntList [Int]
      | TiChar2 Char Char
      | TiInteger Integer
      | TiMaybeInt (Maybe Int)
      | TiChar2Permuted Char Char
      | TiPair TestIndexed TestIndexed
      deriving (Eq, Show, Typeable)
  
  deriveIndexedBi ''TestIndexed [
      Cons 'TiInt [
          Field [| 0 :: Int         |]
          ],
      Cons 'TiIntList [
          Field [| 0 :: [Int]       |]
          ],
      Cons 'TiChar2 [
          Field [| 0 :: Char        |],
          Field [| 1 :: Char        |]
          ],
      Cons 'TiInteger [
          Field [| 0 :: Integer     |]
          ],
      Cons 'TiMaybeInt [
          Field [| 0 :: Maybe Int   |]
          ],
      Cons 'TiChar2Permuted [
          Field [| 1 :: Char        |],
          Field [| 0 :: Char        |]
          ],
      Cons 'TiPair [
          Field [| 0 :: TestIndexed |],
          Field [| 1 :: TestIndexed |]
          ]
      ]
  
  --------------------------------------------------------------------------------
  -- Golden tests
  --------------------------------------------------------------------------------
  
  golden_TestSimpleIndexed1 :: Property
  golden_TestSimpleIndexed1 = goldenTestBi ti "test/golden/TestSimpleIndexed1"
    where
        ti = TiPair
           (TiPair
               (TiChar2 '\154802' '\268555')
               (TiMaybeInt (Just 3110389958050278305)))
           (TiChar2 '\622348' '\696570')
  
  golden_TestSimpleIndexed2 :: Property
  golden_TestSimpleIndexed2 = goldenTestBi ti "test/golden/TestSimpleIndexed2"
    where
      ti = TiPair
         (TiPair
             (TiChar2 '\817168' '\1089248')
             (TiPair
                 (TiChar2 '\230385' '\1065928')
                 (TiIntList [518227513268840239,3102008451401682492
                            ,3028399834958998823,-1792258639827871709
                            ,-4045193945739409444])))
         (TiChar2Permuted '\427120' '\104794')
  
  golden_TestSimpleIndexed3 :: Property
  golden_TestSimpleIndexed3 = goldenTestBi ti "test/golden/TestSimpleIndexed3"
    where
      ti = TiPair (TiInteger (-515200628427138351744076))
                  (TiInt 4238472394723423)
  
  golden_TestSimpleIndexed4 :: Property
  golden_TestSimpleIndexed4 = goldenTestBi ti "test/golden/TestSimpleIndexed4"
    where
      ti = TiPair
          (TiChar2 '\118580' '\1076905')
          (TiPair
              (TiMaybeInt (Just 2108646761465188277))
              (TiPair
                  (TiInteger (-736109340637048771303587))
                  (TiPair
                      (TiInt 5991005317022714617)
                      (TiInt (-7567206666529693526)))))
  
  golden_TestSimpleIndexed5 :: Property
  golden_TestSimpleIndexed5 = goldenTestBi ti "test/golden/TestSimpleIndexed5"
    where
      ti = TiPair
          (TiPair
              (TiMaybeInt (Just 2108646761465188277))
              (TiPair
                  (TiInteger (-736109340637048771303587))
                  (TiPair
                      (TiInt 5991005317022714617)
                      (TiInt (-7567206666529693526)))))
          (TiPair
              (TiChar2Permuted 'a' 'q')
              (TiPair
                  (TiIntList [1..100])
                  (TiChar2 'f' 'z')))
  
  --------------------------------------------------------------------------------
  -- Main test export
  --------------------------------------------------------------------------------
  
  tests :: IO Bool
  tests =
    H.checkParallel $$discoverGolden
  
  
  --------------------------------------------------------------------------------
  -- Old code for TestSimple
  --------------------------------------------------------------------------------
  
  {-
  data TestSimple
      = TsInt
          { unTsInt :: Int }
      | TsIntList
          { unTsIntList :: [Int] }
      | TsChar2
          { unTsChar2L :: Char
          , unTsChar2R :: Char }
      | TsInteger
          { unTsInteger :: Integer }
      | TsMaybeInt
          { unTsMaybeInt :: Maybe Int }
      | TsChar2Permuted
          { unTsChar2PermutedL :: Char
          , unTsChar2PermutedR :: Char }
      | TsPair
          { unTsPairL :: TestSimple
          , unTsPairR :: TestSimple }
      deriving (Eq, Show, Typeable)
  
  deriveSimpleBi ''TestSimple [
      Cons 'TsInt [
          Field [| unTsInt            :: Int        |]
          ],
      Cons 'TsIntList [
          Field [| unTsIntList        :: [Int]      |]
          ],
      Cons 'TsChar2 [
          Field [| unTsChar2L         :: Char       |],
          Field [| unTsChar2R         :: Char       |]
          ],
      Cons 'TsInteger [
          Field [| unTsInteger        :: Integer    |]
          ],
      Cons 'TsMaybeInt [
          Field [| unTsMaybeInt       :: Maybe Int  |]
          ],
      Cons 'TsChar2Permuted [
          Field [| unTsChar2PermutedR :: Char       |],
          Field [| unTsChar2PermutedL :: Char       |]
          ],
      Cons 'TsPair [
          Field [| unTsPairL          :: TestSimple |],
          Field [| unTsPairR          :: TestSimple |]
          ]
      ]
  
  -- The validity of our comparison tests relies on this function. Fortunately,
  -- it's a pretty straightforward translation.
  simpleToIndexed :: TestSimple -> TestIndexed
  simpleToIndexed (TsInt i)             = TiInt i
  simpleToIndexed (TsIntList is)        = TiIntList is
  simpleToIndexed (TsChar2 l r)         = TiChar2 l r
  simpleToIndexed (TsInteger i)         = TiInteger i
  simpleToIndexed (TsMaybeInt mi)       = TiMaybeInt mi
  simpleToIndexed (TsChar2Permuted l r) = TiChar2Permuted l r
  simpleToIndexed (TsPair l r)          = TiPair (simpleToIndexed l)
                                                 (simpleToIndexed r)
  
  --------------------------------------------------------------------------------
  
  genTestSimple :: Range.Size -> Gen TestSimple
  genTestSimple sz
    | sz > 0    = Gen.choice (pairType : flatTypes)
    | otherwise = Gen.choice flatTypes
    where
      pairType  = TsPair <$> genTestSimple (sz `div` 2)
                         <*> genTestSimple (sz `div` 2)
      flatTypes =
          [ TsInt <$> Gen.int Range.constantBounded
          , TsIntList <$> Gen.list (Range.linear 0 20) (Gen.int Range.constantBounded)
          , TsChar2 <$> Gen.unicode <*> Gen.unicode
          , TsInteger <$> Gen.integral (Range.linear (- bignum) bignum)
          , TsMaybeInt <$> Gen.maybe (Gen.int Range.constantBounded)
          , TsChar2Permuted <$> Gen.unicode <*> Gen.unicode
          ]
      bignum = 2 ^ (80 :: Integer)
  -}
  