{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE BlockArguments        #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE ImplicitParams        #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE OverloadedLists       #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Main where

import           ArbitraryGeneratedTestTypes ()
import qualified Data.ByteString             as B
import qualified Data.ByteString.Char8       as BC
import qualified Data.ByteString.Lazy        as BL
import qualified Data.ByteString.Short       as BS
import           Data.Either                 (isRight)
import           Data.Functor.Identity       (Identity(..))
import           Data.Int                    (Int8, Int16, Int32, Int64)
import qualified Data.List.NonEmpty          as NE
import           Data.Proxy                  (Proxy(..))
import           Data.String
import qualified Data.Text.Short
import           Data.Typeable               (Typeable, showsTypeRep, typeRep)
import           Data.Word                   (Word8, Word16, Word32, Word64)
import qualified Data.Vector                 as V
import           GHC.Exts                    (fromList, Proxy#)
import           GHC.TypeLits                (Nat, SomeNat(..), Symbol, TypeError, someNatVal)
import           Proto3.Suite
import qualified Proto3.Suite.Form           as Form
import qualified Proto3.Suite.Form.Encode    as FormE
import           Proto3.Suite.Haskell.Parser (Logger, initLogger)
import qualified Proto3.Suite.JSONPB.Class   as JSONPB
import           Proto3.Wire.Decode          (ParseError)
import qualified Proto3.Wire.Decode          as Decode
import qualified Proto3.Wire.Reverse         as RB
import           Proto3.Wire.Types           as P
import qualified Test.DocTest
import           Test.QuickCheck             (Arbitrary, Property, (.&&.), arbitrary, choose,
                                              counterexample, forAll, oneof, property)
import           Test.Tasty
import           Test.Tasty.HUnit            (Assertion, assertBool, assertEqual,
                                              testCase, (@=?), (@?=))
import           Test.Tasty.QuickCheck       (testProperty, (===))
import           TestCodeGen
import qualified TestProto                   as TP
import qualified TestProtoOneof              as TPO
import qualified TestProtoOneofImport        as TPOI

#ifdef DHALL
import           TestDhall
#endif

import qualified Test.Proto.Generate.Name
import qualified Test.Proto.Parse.Option
import qualified Test.Proto.Interval
import           Test.Proto.ToEncoder        (Iterator(Forward, Vector),
                                              Stripping(Keep, Strip), ToEncoder(..))

-- -----------------------------------------------------------------------------

main :: IO ()
main = do
  logger <- initLogger
  defaultMain (tests logger)

tests :: Logger -> TestTree
tests logger = testGroup "Tests"
  [ docTests
  , qcProperties
  , encodeUnitTests
  , decodeUnitTests
  , parserUnitTests
  , dotProtoUnitTests
  , codeGenTests logger
  , Test.Proto.Generate.Name.testTree
  , Test.Proto.Parse.Option.testTree
  , Test.Proto.Interval.testTree

#ifdef DHALL
  , dhallTests
#endif
  ]

-- -----------------------------------------------------------------------------
-- Doctests

docTests :: TestTree
docTests = testCase "doctests" $ do
  putStrLn "Running all doctests..."
  Test.DocTest.doctest
    [ "--verbose"
    , "-package"
    , "ghc-lib-parser"
    , "-isrc"
    , "-XBlockArguments"
#ifdef SWAGGER
#ifdef SWAGGER_WRAPPER_FORMAT
    , "-isrc/swagger-wrapper-format"
    , "-DSWAGGER_WRAPPER_FORMAT"
#else
    , "-isrc/no-swagger-wrapper-format"
#endif
    , "-DSWAGGER"
#endif
#ifdef DHALL
    , "-DDHALL"
#endif
#ifdef LARGE_RECORDS
    , "-DLARGE_RECORDS"
#endif
    , "src/Proto3/Suite/DotProto/Internal.hs"
    , "src/Proto3/Suite/DotProto/Generate.hs"
    , "src/Proto3/Suite/JSONPB/Class.hs"
    , "src/Proto3/Suite/Tutorial.hs"
    ]

--------------------------------------------------------------------------------
-- QuickCheck properties

type MsgProp a = a -> Property

qcProperties :: TestTree
qcProperties = testGroup "QuickCheck properties"
  [ qcPropDecEncId
  ]

-- | Verifies that @decode . encode = id@ for various message types
qcPropDecEncId :: TestTree
qcPropDecEncId = testGroup "Property: (decode . encode = id) for various message types"
  [ testProperty "Trivial"             (prop :: MsgProp TP.Trivial)
  , testProperty "MultipleFields"      (prop :: MsgProp TP.MultipleFields)
  , testProperty "WithEnum"            (prop :: MsgProp TP.WithEnum)
  , testProperty "WithNesting"         (prop :: MsgProp TP.WithNesting)
  , testProperty "WithRepetition"      (prop :: MsgProp TP.WithRepetition)
  , testProperty "WithRepeatedSigned"  (prop :: MsgProp TP.WithRepeatedSigned)
  , testProperty "WithFixed"           (prop :: MsgProp TP.WithFixed)
  , testProperty "WithBytes"           (prop :: MsgProp TP.WithBytes)
  , testProperty "AllPackedTypes"      (prop :: MsgProp TP.AllPackedTypes)
  , testProperty "SignedInts"          (prop :: MsgProp TP.SignedInts)
  , testProperty "WithNestingRepeated" (prop :: MsgProp TP.WithNestingRepeated)
  , deeplyNest prop 1000
  ]
  where
    prop :: (Message a, Arbitrary a, Eq a, Show a) => MsgProp a
    prop msg = msg === (dec . enc) msg
      where
        dec = either (error . ("error parsing: " <>) . show) id . fromByteString
        enc = BL.toStrict . toLazyByteString

    deeplyNest :: MsgProp TP.Wrapped -> Int -> TestTree
    deeplyNest pf 0 = testProperty "Deeply nested" pf
    deeplyNest pf n = deeplyNest (pf . TP.Wrapped . Just) (n-1)


--------------------------------------------------------------------------------
-- Encoding

encodeUnitTests :: TestTree
encodeUnitTests = testGroup "Encoder unit tests"
  [ encoderMatchesGoldens
  , encoderPromotionsAndAuto
  , encodeBytesFromBuilder
  , encodeMessageReflection
  , encodeCachedSubmessage
  , testShowMessageEncoder
  , testShowMessageEncoding
  , testToJSONPBMessageEncoder
  , testToJSONPBMessageEncoding
  , testFromJSONPBMessageEncoder
  , testFromJSONPBMessageEncoding
  ]

-- TODO: We should consider generating the reference encodings
-- (test-files/make_reference_encodings.py) as a part of running the test suite
-- rather than having them in the repository.
encoderMatchesGoldens :: TestTree
encoderMatchesGoldens = testGroup "Encoder matches golden encodings"
  [ check "trivial.bin"               $ TP.Trivial 123
  , check "trivial_negative.bin"      $ TP.Trivial (-1)
  , check "multiple_fields.bin"       $ TP.MultipleFields 1.23 (-0.5) 123 1234567890 "Hello, world!" True
  , check "signedints.bin"            $ TP.SignedInts (-42) (-84)
  , check "with_nesting.bin"          $ TP.WithNesting $ Just $ TP.WithNesting_Nested "123abc" 123456 [] []
  , check "with_enum0.bin"            $ TP.WithEnum $ Enumerated $ Right $ TP.WithEnum_TestEnumENUM1
  , check "with_enum1.bin"            $ TP.WithEnum $ Enumerated $ Right $ TP.WithEnum_TestEnumENUM2
  , check "with_repetition.bin"       $ TP.WithRepetition [1..5]
  , check "with_repeated_signed.bin"  $ TP.WithRepeatedSigned
      [ 0, -1, 1, -2, 2,
        0x3FFFFFFF, -0x40000000, 0x40000000, -0x40000001,
        0x7FFFFFFF, -0x7FFFFFFF - 1 ]
      [ 0, -1, 1, -2, 2,
        0x3FFFFFFFFFFFFFFF, -0x4000000000000000, 0x4000000000000000, -0x4000000000000001,
        0x7FFFFFFFFFFFFFFF, -0x7FFFFFFFFFFFFFFF - 1 ]
  , check "with_bytes.bin"            $ TP.WithBytes (BC.pack "abc") (fromList $ map BC.pack ["abc","123"])
  , check "with_nesting_repeated.bin" $ TP.WithNestingRepeated
                                          [ TP.WithNestingRepeated_Nested "123abc" 123456 [1,2,3,4] [5,6,7,8]
                                          , TP.WithNestingRepeated_Nested "abc123" 654321 [0,9,8,7] [6,5,4,3]
                                          ]
  ]
  where
    check fp v = testCase fp $ do
      goldenEncoding <- BL.readFile (testFilesPfx <> fp)
      assertEqual (show fp ++ ": encoding from intermediate representation")
        goldenEncoding (toLazyByteString v)
      -- NOTE: We skip the 'Identity' iterator in this test because we expect it
      -- will create longer output for packed fields than the golden result when
      -- there is more than one element of the repetition--in which case our test
      -- code misuses 'Identity' by using it repeatedly, once for each element.
      -- Though suboptimal, the resulting encoding remains decodable by parsers
      -- that adhere to the protobuf specification.  We check that decodability
      -- in other tests that pair a Haskell encoder with a Python decoder.
      assertEqual (show fp ++ ": direct encoding, Forward iterator, keep wrappers")
        goldenEncoding $ FormE.messageEncoderToLazyByteString $
          let ?iterator = Forward
              ?stripping = Keep
          in toEncoder v
      assertEqual (show fp ++ ": direct encoding, Forward iterator, strip wrappers")
        goldenEncoding $ FormE.messageEncoderToLazyByteString $
          let ?iterator = Forward
              ?stripping = Strip
          in toEncoder v
      assertEqual (show fp ++ ": direct encoding, Vector iterator, keep wrappers")
        goldenEncoding $ FormE.messageEncoderToLazyByteString $
          let ?iterator = Vector
              ?stripping = Keep
          in toEncoder v
      assertEqual (show fp ++ ": direct encoding, Vector iterator, strip wrappers")
        goldenEncoding $ FormE.messageEncoderToLazyByteString $
          let ?iterator = Vector
              ?stripping = Strip
          in toEncoder v

-- Simulated protobuf message type having a single field named @myBytes@ of
-- type @bytes@ with field number @8@ and the specified 'Form.Cardinality'.
data MyWithBytes (r :: Form.Cardinality)

type instance Form.NamesOf (MyWithBytes r) = '["x"]

type instance Form.NumberOf (MyWithBytes r) name = MyWithBytes_NumberOf r name

type family MyWithBytes_NumberOf (r :: Form.Cardinality) (name :: Symbol) :: Nat
  where
    MyWithBytes_NumberOf _ "myBytes" = 8
    MyWithBytes_NumberOf r name = TypeError (Form.FieldNotFound (MyWithBytes r) name)

type instance Form.ProtoTypeOf (MyWithBytes r) name = MyWithBytes_ProtoTypeOf r name

type family MyWithBytes_ProtoTypeOf (r :: Form.Cardinality) (name :: Symbol) :: Form.ProtoType
  where
    MyWithBytes_ProtoTypeOf _ "myBytes" = 'Form.Bytes
    MyWithBytes_ProtoTypeOf r name = TypeError (Form.FieldNotFound (MyWithBytes r) name)

type instance Form.OneOfOf (MyWithBytes r) name = MyWithBytes_OneOfOf r name

type family MyWithBytes_OneOfOf (r :: Form.Cardinality) (name :: Symbol) :: Symbol
  where
    MyWithBytes_OneOfOf 'Form.Optional "myBytes" = "pickOne"
    MyWithBytes_OneOfOf 'Form.Optional "pickOne" = "pickOne"
    MyWithBytes_OneOfOf r "myBytes" = ""
    MyWithBytes_OneOfOf r name = TypeError (Form.FieldOrOneOfNotFound (MyWithBytes r) name)

type instance Form.CardinalityOf (MyWithBytes r) name = MyWithBytes_CardinalityOf r name

type family MyWithBytes_CardinalityOf (r :: Form.Cardinality) (name :: Symbol) :: Form.Cardinality
  where
    MyWithBytes_CardinalityOf r "myBytes" = r
    MyWithBytes_CardinalityOf 'Form.Optional "pickOne" = 'Form.Optional
    MyWithBytes_CardinalityOf r name = TypeError (Form.FieldOrOneOfNotFound (MyWithBytes r) name)

encodeBytesFromBuilder :: TestTree
encodeBytesFromBuilder = testCase "bytes from builder" $ do
    assertEqual "implicitly empty"
      (enc @'Form.Implicit (mempty :: RB.BuildR)) ""
    assertEqual "implicit but nonempty"
      (enc @'Form.Implicit (RB.byteString "xyz")) "B\ETXxyz"
    assertEqual "unset optional"
      (enc @'Form.Optional (Nothing :: Maybe RB.BuildR)) ""
    assertEqual "set empty optional"
      (enc @'Form.Optional (Just (mempty :: RB.BuildR))) "B\NUL"
    assertEqual "set nonempty optional"
      (enc @'Form.Optional (Just (RB.byteString "xyz"))) "B\ETXxyz"
    assertEqual "zero repetitions"
      (enc @('Form.Repeated 'Form.Unpacked)
           ([] :: [RB.BuildR]))
      ""
    assertEqual "single empty"
      (enc @('Form.Repeated 'Form.Unpacked)
           ([mempty] :: [RB.BuildR]))
      "B\NUL"
    assertEqual "double empty"
      (enc @('Form.Repeated 'Form.Unpacked)
           ([mempty, mempty] :: [RB.BuildR]))
      "B\NULB\NUL"
    assertEqual "empty nonempty"
      (enc @('Form.Repeated 'Form.Unpacked)
           ([mempty, RB.byteString "xyz"] :: [RB.BuildR]))
      "B\NULB\ETXxyz"
    assertEqual "nonempty empty"
      (enc @('Form.Repeated 'Form.Unpacked)
           (V.fromList [RB.byteString "uv", mempty]))
      "B\STXuvB\NUL"
    assertEqual "double nonempty"
      (enc @('Form.Repeated 'Form.Unpacked)
           (V.fromList [RB.byteString "uv", RB.byteString "xyz"]))
      "B\STXuvB\ETXxyz"
  where
    enc ::
      forall r a .
      ( FormE.Distinct (MyWithBytes r) (FormE.Occupy (MyWithBytes r) "myBytes" '[])
      , FormE.Field "myBytes" a (MyWithBytes r)
      ) =>
      a ->
      BL.ByteString
    enc =
      FormE.messageEncoderToLazyByteString .
      FormE.fieldsToMessage .
      FormE.field @"myBytes" @a @(MyWithBytes r)

encodeMessageReflection :: TestTree
encodeMessageReflection = testCase "messageReflection" $ do
  let msg = TP.Trivial 123
  FormE.messageEncoderToLazyByteString (FormE.messageReflection msg) @?= toLazyByteString msg

encodeCachedSubmessage :: TestTree
encodeCachedSubmessage = testGroup "Cached Submessages"
  [ testOptional
  , testRepeated
  , testOneof
  ]
  where
    testOptional :: TestTree
    testOptional = testCase "cached optional submessage" $ do
      let trivial = TP.Trivial 123
          wrappedTrivial = FormE.fieldsToMessage @TP.WrappedTrivial $
            FormE.field @"trivial" (Just (FormE.messageCache trivial))
      FormE.messageEncoderToLazyByteString wrappedTrivial @?=
        toLazyByteString (TP.WrappedTrivial (Just trivial))

    testRepeated :: TestTree
    testRepeated = testCase "cached repeated submessage" $ do
      let trivials :: V.Vector TP.MapTestEmulation_Trivial
          trivials =
            [ TP.MapTestEmulation_Trivial 15 (Just (TP.WrappedTrivial (Just (TP.Trivial 465))))
            , TP.MapTestEmulation_Trivial 25 (Just (TP.WrappedTrivial (Just (TP.Trivial 789))))
            ]
          mapTestEmulation = FormE.fieldsToMessage @TP.MapTestEmulation $
            FormE.field @"trivial" (V.map FormE.messageCache trivials)
      FormE.messageEncoderToLazyByteString mapTestEmulation @?=
        toLazyByteString (TP.MapTestEmulation mempty trivials mempty)

    testOneof :: TestTree
    testOneof = testCase "cached submessage within oneof" $ do
      let withOneof = TPOI.WithOneof (Just (TPOI.WithOneofPickOneB 123))
          withImported = FormE.fieldsToMessage @TPO.WithImported $
            FormE.field @"withOneof" (Just (FormE.messageCache withOneof))
      FormE.messageEncoderToLazyByteString withImported @?=
        toLazyByteString (TPO.WithImported (Just (TPO.WithImportedPickOneWithOneof withOneof)))

testShowMessageEncoding :: TestTree
testShowMessageEncoding = testCase "Show MessageEncoding" $ do
  let trivial = TP.Trivial 123
      badForm = "abc"
      encoding :: FormE.MessageEncoding TP.Trivial
      encoding = FormE.messageCache trivial
      bogus :: FormE.MessageEncoding TP.Trivial
      bogus = FormE.unsafeByteStringToMessageEncoding badForm
  -- Test desired behavior for valid encoding:
  show (Just encoding) @?=
    "Just (Proto3.Suite.Form.Encode.messageCache " ++ showsPrec 11 trivial ")"
  -- Test fallback behavior for invalid encoding:
  show (Just bogus) @?=
    "Just (Proto3.Suite.Form.Encode.unsafeByteStringToMessageEncoding " ++ showsPrec 11 badForm ")"

testShowMessageEncoder :: TestTree
testShowMessageEncoder = testCase "Show MessageEncoder" $ do
  let trivial = TP.Trivial 123
      badForm = "abc"
      encoder :: FormE.MessageEncoder TP.Trivial
      encoder = FormE.messageReflection trivial
      bogus :: FormE.MessageEncoder TP.Trivial
      bogus = FormE.unsafeByteStringToMessageEncoder badForm
  -- Test desired behavior for valid encoder:
  show (Just encoder) @?=
    "Just (Proto3.Suite.Form.Encode.messageReflection " ++ showsPrec 11 trivial ")"
  -- Test fallback behavior for invalid encoder:
  show (Just bogus) @?=
    "Just (Proto3.Suite.Form.Encode.unsafeByteStringToMessageEncoder " ++ showsPrec 11 badForm ")"

testToJSONPBMessageEncoding :: TestTree
testToJSONPBMessageEncoding = testProperty "ToJSONPB MessageEncoding" $ \opts ->
  let trivial = TP.Trivial 123
      badForm = "abc"
      encoding :: FormE.MessageEncoding TP.Trivial
      encoding = FormE.messageCache trivial
      bogus :: FormE.MessageEncoding TP.Trivial
      bogus = FormE.unsafeByteStringToMessageEncoding badForm
  in
    -- Test desired behavior for valid encoding:
    JSONPB.toJSONPB encoding opts === JSONPB.toJSONPB trivial opts
    .&&.
    JSONPB.toEncodingPB encoding opts === JSONPB.toEncodingPB trivial opts
    .&&.
    -- Test fallback behavior for invalid encoding:
    JSONPB.toJSONPB bogus opts === JSONPB.toJSONPB badForm opts
    .&&.
    JSONPB.toEncodingPB bogus opts === JSONPB.toEncodingPB badForm opts

testToJSONPBMessageEncoder :: TestTree
testToJSONPBMessageEncoder = testProperty "ToJSONPB MessageEncoder" $ \opts ->
  let trivial = TP.Trivial 123
      badForm = "abc"
      encoder :: FormE.MessageEncoder TP.Trivial
      encoder = FormE.messageReflection trivial
      bogus :: FormE.MessageEncoder TP.Trivial
      bogus = FormE.unsafeByteStringToMessageEncoder badForm
  in
    -- Test desired behavior for valid encoder:
    JSONPB.toJSONPB encoder opts === JSONPB.toJSONPB trivial opts
    .&&.
    JSONPB.toEncodingPB encoder opts === JSONPB.toEncodingPB trivial opts
    .&&.
    -- Test fallback behavior for invalid encoder:
    JSONPB.toJSONPB bogus opts === JSONPB.toJSONPB badForm opts
    .&&.
    JSONPB.toEncodingPB bogus opts === JSONPB.toEncodingPB badForm opts

testFromJSONPBMessageEncoding :: TestTree
testFromJSONPBMessageEncoding = testProperty "FromJSONPB MessageEncoding" $ \opts ->
  let trivial = TP.Trivial 123
      badForm = "abc"
      encoding :: FormE.MessageEncoding TP.Trivial
      encoding = FormE.messageCache trivial
      bogus :: FormE.MessageEncoding TP.Trivial
      bogus = FormE.unsafeByteStringToMessageEncoding badForm
      edec :: BL.ByteString -> Either String (FormE.MessageEncoding TP.Trivial)
      edec = JSONPB.eitherDecode
  in
    -- Test desired behavior for valid encoder:
    fmap (fromByteString . FormE.messageEncodingToByteString) (edec (JSONPB.encode opts encoding))
      === Right (Right trivial)
    .&&.
    -- Test fallback behavior for invalid encoder:
    fmap FormE.messageEncodingToByteString (edec (JSONPB.encode opts bogus)) === Right badForm

testFromJSONPBMessageEncoder :: TestTree
testFromJSONPBMessageEncoder = testProperty "FromJSONPB MessageEncoder" $ \opts ->
  let trivial = TP.Trivial 123
      badForm = "abc"
      encoder :: FormE.MessageEncoder TP.Trivial
      encoder = FormE.messageReflection trivial
      bogus :: FormE.MessageEncoder TP.Trivial
      bogus = FormE.unsafeByteStringToMessageEncoder badForm
      edec :: BL.ByteString -> Either String (FormE.MessageEncoder TP.Trivial)
      edec = JSONPB.eitherDecode
  in
    -- Test desired behavior for valid encoder:
    fmap (fromByteString . FormE.messageEncoderToByteString) (edec (JSONPB.encode opts encoder))
      === Right (Right trivial)
    .&&.
    -- Test fallback behavior for invalid encoder:
    fmap FormE.messageEncoderToByteString (edec (JSONPB.encode opts bogus)) === Right badForm

data TestMessage
       (num :: Nat)
       (repetition :: Maybe Form.Cardinality)
       (protoType :: Form.ProtoType)
  -- ^ Omitting the repetition means that field @"name"@ is in a @oneof@ named @"pickOne"@.

type instance Form.NamesOf (TestMessage num maybeRepetition protoType) = '[ "name" ]

type instance Form.NumberOf (TestMessage num maybeRepetition protoType) "name" = num

type instance Form.ProtoTypeOf (TestMessage num maybeRepetition protoType) "name" = protoType

type instance Form.OneOfOf (TestMessage num 'Nothing protoType) "name" = "pickOne"
type instance Form.OneOfOf (TestMessage num 'Nothing protoType) "pickOne" = "pickOne"
type instance Form.OneOfOf (TestMessage num ('Just _) protoType) "name" = ""

type instance Form.CardinalityOf (TestMessage num 'Nothing protoType) "name" = 'Form.Optional
type instance Form.CardinalityOf (TestMessage num 'Nothing protoType) "pickOne" = 'Form.Optional
type instance Form.CardinalityOf (TestMessage num ('Just repetition) protoType) "name" = repetition

encoderPromotionsAndAuto :: TestTree
encoderPromotionsAndAuto = testGroup "Encoder promotes types correctly and Auto-selection works"
  [ testGroup "Encoder promotes types correctly"
      [ check @'Form.Int32 @Int8 @Int32 "int32" (fromIntegral @Int8 @Int32)
      , check @'Form.Int32 @Word8 @Int32 "int32" (fromIntegral @Word8 @Int32)
      , check @'Form.Int32 @Int16 @Int32 "int32" (fromIntegral @Int16 @Int32)
      , check @'Form.Int32 @Word16 @Int32 "int32" (fromIntegral @Word16 @Int32)
      , check @'Form.Int64 @Int8 @Int64 "int64" (fromIntegral @Int8 @Int64)
      , check @'Form.Int64 @Word8 @Int64 "int64" (fromIntegral @Word8 @Int64)
      , check @'Form.Int64 @Int16 @Int64 "int64"(fromIntegral @Int16 @Int64)
      , check @'Form.Int64 @Word16 @Int64 "int64"(fromIntegral @Word16 @Int64)
      , check @'Form.Int64 @Int32 @Int64 "int64"(fromIntegral @Int32 @Int64)
      , check @'Form.Int64 @Word32 @Int64 "int64"(fromIntegral @Word32 @Int64)
      , check @'Form.SInt32 @Int8 @Int32 "sint32" (fromIntegral @Int8 @Int32)
      , check @'Form.SInt32 @Word8 @Int32 "sint32" (fromIntegral @Word8 @Int32)
      , check @'Form.SInt32 @Int16 @Int32 "sint32" (fromIntegral @Int16 @Int32)
      , check @'Form.SInt32 @Word16 @Int32 "sint32" (fromIntegral @Word16 @Int32)
      , check @'Form.SInt64 @Int8 @Int64 "sint64" (fromIntegral @Int8 @Int64)
      , check @'Form.SInt64 @Word8 @Int64 "sint64" (fromIntegral @Word8 @Int64)
      , check @'Form.SInt64 @Int16 @Int64 "sint64" (fromIntegral @Int16 @Int64)
      , check @'Form.SInt64 @Word16 @Int64 "sint64" (fromIntegral @Word16 @Int64)
      , check @'Form.SInt64 @Int32 @Int64 "sint64" (fromIntegral @Int32 @Int64)
      , check @'Form.SInt64 @Word32 @Int64 "sint64" (fromIntegral @Word32 @Int64)
      , check @'Form.UInt32 @Word8 @Word32 "uint32" (fromIntegral @Word8 @Word32)
      , check @'Form.UInt32 @Word16 @Word32 "uint32" (fromIntegral @Word16 @Word32)
      , check @'Form.UInt64 @Word8 @Word64 "uint64" (fromIntegral @Word8 @Word64)
      , check @'Form.UInt64 @Word16 @Word64 "uint64" (fromIntegral @Word16 @Word64)
      , check @'Form.UInt64 @Word32 @Word64 "uint64" (fromIntegral @Word32 @Word64)
      , check @'Form.Fixed32 @Word8 @Word32 "fixed32" (fromIntegral @Word8 @Word32)
      , check @'Form.Fixed32 @Word16 @Word32 "fixed32" (fromIntegral @Word16 @Word32)
      , check @'Form.Fixed64 @Word8 @Word64 "fixed64" (fromIntegral @Word8 @Word64)
      , check @'Form.Fixed64 @Word16 @Word64 "fixed64" (fromIntegral @Word16 @Word64)
      , check @'Form.Fixed64 @Word32 @Word64 "fixed64" (fromIntegral @Word32 @Word64)
      , check @'Form.SFixed32 @Int8 @Int32 "sfixed32" (fromIntegral @Int8 @Int32)
      , check @'Form.SFixed32 @Word8 @Int32 "sfixed32" (fromIntegral @Word8 @Int32)
      , check @'Form.SFixed32 @Int16 @Int32 "sfixed32" (fromIntegral @Int16 @Int32)
      , check @'Form.SFixed32 @Word16 @Int32 "sfixed32" (fromIntegral @Word16 @Int32)
      , check @'Form.SFixed64 @Int8 @Int64 "sfixed64" (fromIntegral @Int8 @Int64)
      , check @'Form.SFixed64 @Word8 @Int64 "sfixed64" (fromIntegral @Word8 @Int64)
      , check @'Form.SFixed64 @Int16 @Int64 "sfixed64" (fromIntegral @Int16 @Int64)
      , check @'Form.SFixed64 @Word16 @Int64 "sfixed64" (fromIntegral @Word16 @Int64)
      , check @'Form.SFixed64 @Int32 @Int64 "sfixed64" (fromIntegral @Int32 @Int64)
      , check @'Form.SFixed64 @Word32 @Int64 "sfixed64" (fromIntegral @Word32 @Int64)
      , check @'Form.Double @Float @Double "double" (realToFrac @Float @Double)
      ]
  , testGroup "Encoder Auto wrapper does not change format"
      [ check @'Form.Int32 @Int32 @(FormE.Auto Int32) "int32" FormE.Auto
      , check @'Form.Int64 @Int64 @(FormE.Auto Int64) "int64" FormE.Auto
      , check @'Form.SInt32 @Int32 @(FormE.Auto Int32) "sint32" FormE.Auto
      , check @'Form.SInt64 @Int64 @(FormE.Auto Int64) "sint64" FormE.Auto
      , check @'Form.UInt32 @Word32 @(FormE.Auto Word32) "uint32" FormE.Auto
      , check @'Form.UInt64 @Word64 @(FormE.Auto Word64) "uint64" FormE.Auto
      , check @'Form.Fixed32 @Word32 @(FormE.Auto Word32) "fixed32" FormE.Auto
      , check @'Form.Fixed64 @Word64 @(FormE.Auto Word64) "fixed64" FormE.Auto
      , check @'Form.SFixed32 @Int32 @(FormE.Auto Int32) "sfixed32" FormE.Auto
      , check @'Form.SFixed64 @Int64 @(FormE.Auto Int64) "sfixed64" FormE.Auto
      , check @'Form.Bool @Bool @(FormE.Auto Bool) "bool" FormE.Auto
      , check @'Form.Float @Float @(FormE.Auto Float) "float" FormE.Auto
      , check @'Form.Double @Double @(FormE.Auto Double) "double" FormE.Auto
      , checkNotPacked @'Form.String @Data.Text.Short.ShortText @(FormE.Auto Data.Text.Short.ShortText) "string" FormE.Auto
      , checkNotPacked @'Form.Bytes @BS.ShortByteString @(FormE.Auto BS.ShortByteString) "bytes" FormE.Auto
      ]
  ]
  where
    check ::
      forall (protoType :: Form.ProtoType) a b .
      ( Typeable a
      , Typeable b
      , Arbitrary a
      , Show a
      , FormE.FieldForm 'Form.Implicit protoType a
      , FormE.FieldForm 'Form.Implicit protoType b
      , FormE.FieldForm 'Form.Optional protoType (Maybe a)
      , FormE.FieldForm 'Form.Optional protoType (Maybe b)
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType (Identity a)
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType (Identity b)
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType [a]
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType [b]
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType (V.Vector a)
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType (V.Vector b)
      , FormE.FieldForm ('Form.Repeated 'Form.Packed) protoType (Identity a)
      , FormE.FieldForm ('Form.Repeated 'Form.Packed) protoType (Identity b)
      , FormE.FieldForm ('Form.Repeated 'Form.Packed) protoType [a]
      , FormE.FieldForm ('Form.Repeated 'Form.Packed) protoType [b]
      , FormE.FieldForm ('Form.Repeated 'Form.Packed) protoType (V.Vector a)
      , FormE.FieldForm ('Form.Repeated 'Form.Packed) protoType (V.Vector b)
      ) =>
      String ->
      (a -> b) ->
      TestTree
    check protoTypeName convert =
      testProperty (showString protoTypeName $ showString ": " $
                    showsType @a $ showString " -> " $ showsType @b "") $
        propNotPacked @protoType convert .&&.
        propPacked @protoType convert

    checkNotPacked ::
      forall (protoType :: Form.ProtoType) a b .
      ( Typeable a
      , Typeable b
      , Arbitrary a
      , Show a
      , FormE.FieldForm 'Form.Implicit protoType a
      , FormE.FieldForm 'Form.Implicit protoType b
      , FormE.FieldForm 'Form.Optional protoType (Maybe a)
      , FormE.FieldForm 'Form.Optional protoType (Maybe b)
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType (Identity a)
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType (Identity b)
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType [a]
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType [b]
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType (V.Vector a)
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType (V.Vector b)
      ) =>
      String ->
      (a -> b) ->
      TestTree
    checkNotPacked protoTypeName convert =
      testProperty (showString protoTypeName $ showString ": " $
                    showsType @a $ showString " -> " $ showsType @b "") $
        propNotPacked @protoType convert

    propNotPacked ::
      forall (protoType :: Form.ProtoType) a b .
      ( Typeable a
      , Typeable b
      , Arbitrary a
      , Show a
      , FormE.FieldForm 'Form.Implicit protoType a
      , FormE.FieldForm 'Form.Implicit protoType b
      , FormE.FieldForm 'Form.Optional protoType (Maybe a)
      , FormE.FieldForm 'Form.Optional protoType (Maybe b)
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType (Identity a)
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType (Identity b)
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType [a]
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType [b]
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType (V.Vector a)
      , FormE.FieldForm ('Form.Repeated 'Form.Unpacked) protoType (V.Vector b)
      ) =>
      (a -> b) ->
      Property
    propNotPacked convert =
      forAll (choose (1, 536870911)) $ \fieldNum ->
      case someNatVal fieldNum of
        Nothing ->
          property False  -- Should never happen.
        Just (SomeNat (_ :: Proxy num)) ->
          forAll arbitrary $ \a ->
          forAll arbitrary $ \(as :: [a])->
          let b :: b
              b = convert a
              bs :: [b]
              bs = map convert as
              asVec :: V.Vector a
              asVec = V.fromList as
              bsVec :: V.Vector b
              bsVec = V.fromList bs
          in
          counterexample "Implicit"
            (check1 @num @('Just 'Form.Implicit) @protoType a b) .&&.
          counterexample "Optional - Nothing"
            (check1 @num @('Just 'Form.Optional) @protoType (Nothing @a) (Nothing @b)) .&&.
          counterexample "Optional - Just"
            (check1 @num @('Just 'Form.Optional) @protoType (Just a) (Just b)) .&&.
          counterexample "inside oneof"
            (check1 @num @'Nothing @protoType (Just a) (Just b)) .&&.
          counterexample "Unpacked Identity"
            (check1 @num @('Just ('Form.Repeated 'Form.Unpacked)) @protoType (Identity a) (Identity b)) .&&.
          counterexample "Unpacked Forward"
            (check1 @num @('Just ('Form.Repeated 'Form.Unpacked)) @protoType as bs) .&&.
          counterexample "Unpacked Vector"
            (check1 @num @('Just ('Form.Repeated 'Form.Unpacked)) @protoType asVec bsVec)

    propPacked ::
      forall (protoType :: Form.ProtoType) a b .
      ( Typeable a
      , Typeable b
      , Arbitrary a
      , Show a
      , FormE.FieldForm ('Form.Repeated 'Form.Packed) protoType (Identity a)
      , FormE.FieldForm ('Form.Repeated 'Form.Packed) protoType (Identity b)
      , FormE.FieldForm ('Form.Repeated 'Form.Packed) protoType [a]
      , FormE.FieldForm ('Form.Repeated 'Form.Packed) protoType [b]
      , FormE.FieldForm ('Form.Repeated 'Form.Packed) protoType (V.Vector a)
      , FormE.FieldForm ('Form.Repeated 'Form.Packed) protoType (V.Vector b)
      ) =>
      (a -> b) ->
      Property
    propPacked convert =
      forAll (choose (1, 536870911)) $ \fieldNum ->
      case someNatVal fieldNum of
        Nothing ->
          property False  -- Should never happen.
        Just (SomeNat (_ :: Proxy num)) ->
          forAll arbitrary $ \a ->
          forAll arbitrary $ \(as :: [a])->
          let b :: b
              b = convert a
              bs :: [b]
              bs = map convert as
              asVec :: V.Vector a
              asVec = V.fromList as
              bsVec :: V.Vector b
              bsVec = V.fromList bs
          in
          counterexample "Packed Identity"
            (check1 @num @('Just ('Form.Repeated 'Form.Packed)) @protoType (Identity a) (Identity b)) .&&.
          counterexample "Packed Forward"
            (check1 @num @('Just ('Form.Repeated 'Form.Packed)) @protoType as bs) .&&.
          counterexample "Packed Vector"
            (check1 @num @('Just ('Form.Repeated 'Form.Packed)) @protoType asVec bsVec)

    check1 ::
      forall (num :: Nat) (maybeRepetition :: Maybe Form.Cardinality)
             (protoType :: Form.ProtoType) a b .
      ( FormE.Field "name" a (TestMessage num maybeRepetition protoType)
      , FormE.Field "name" b (TestMessage num maybeRepetition protoType)
      , FormE.Distinct (TestMessage num maybeRepetition protoType)
                       (FormE.Occupy (TestMessage num maybeRepetition protoType) "name" '[])
      ) =>
      a ->
      b ->
      Property
    check1 a b =
      FormE.messageEncoderToLazyByteString
        (FormE.fieldsToMessage (FormE.field @"name" @a @(TestMessage num maybeRepetition protoType) a))
      ===
      FormE.messageEncoderToLazyByteString
        (FormE.fieldsToMessage (FormE.field @"name" @b @(TestMessage num maybeRepetition protoType) b))

    showsType :: forall a . Typeable a => ShowS
    showsType = showsTypeRep (typeRep (Proxy :: Proxy a))

--------------------------------------------------------------------------------
-- Decoding

decodeUnitTests :: TestTree
decodeUnitTests = testGroup "Decoder unit tests"
  [ decodeFromGoldens
  ]

decodeFromGoldens :: TestTree
decodeFromGoldens = testGroup "Decode golden encodings into key/value lists"
  [ check "trivial.bin"
  , check "trivial_negative.bin"
  , check "multiple_fields.bin"
  , check "signedints.bin"
  , check "with_nesting.bin"
  , check "with_enum0.bin"
  , check "with_enum1.bin"
  , check "with_repetition.bin"
  , check "with_bytes.bin"
  , check "with_nesting_repeated.bin"
  ]
  where
    check fp = testCase fp $ do
      kvs <- Decode.decodeWire <$> B.readFile (testFilesPfx <> fp)
      assertBool ("parsing " <> fp <> " into a key-value list succeeds") (isRight kvs)

--------------------------------------------------------------------------------
-- Parser

parserUnitTests :: TestTree
parserUnitTests = testGroup "Parser unit tests"
  [ parseFromGoldens
  ]

parseFromGoldens :: TestTree
parseFromGoldens = testGroup "Parse golden encodings"
  [ check "trivial.bin"               $ TP.Trivial 123
  , check "multiple_fields.bin"       $ TP.MultipleFields 1.23 (-0.5) 123 1234567890 "Hello, world!" True
  , check "signedints.bin"            $ TP.SignedInts (-42) (-84)
  , check "with_nesting.bin"          $ TP.WithNesting $ Just $ TP.WithNesting_Nested "123abc" 123456 [] []
  , check "with_enum0.bin"            $ TP.WithEnum $ Enumerated $ Right $ TP.WithEnum_TestEnumENUM1
  , check "with_enum1.bin"            $ TP.WithEnum $ Enumerated $ Right $ TP.WithEnum_TestEnumENUM2
  , check "with_repetition.bin"       $ TP.WithRepetition [1..5]
  , check "with_repeated_signed.bin"  $ TP.WithRepeatedSigned
      [ 0, -1, 1, -2, 2,
        0x3FFFFFFF, -0x40000000, 0x40000000, -0x40000001,
        0x7FFFFFFF, -0x7FFFFFFF - 1 ]
      [ 0, -1, 1, -2, 2,
        0x3FFFFFFFFFFFFFFF, -0x4000000000000000, 0x4000000000000000, -0x4000000000000001,
        0x7FFFFFFFFFFFFFFF, -0x7FFFFFFFFFFFFFFF - 1 ]
  , check "with_fixed.bin"            $ TP.WithFixed 16 (-123) 4096 (-4096)
  , check "with_bytes.bin"            $ TP.WithBytes (BC.pack "abc") (fromList $ map BC.pack ["abc","123"])
  , check "with_packing.bin"          $ TP.WithPacking [1,2,3] [1,2,3]
  , check "all_packed_types.bin"      $ TP.AllPackedTypes
                                          [1,2,3]
                                          [1,2,3]
                                          [-1,-2,-3]
                                          [-1,-2,-3]
                                          (fromList [1..3])
                                          (fromList [1..3])
                                          [1.0,2.0]
                                          [1.0,-1.0]
                                          (fromList [1,2,3])
                                          (fromList [1,2,3])
                                          [False,True]
                                          (Enumerated . Right <$> [TP.EFLD0, TP.EFLD1])
                                          (Enumerated . Right <$> [TP.EFLD0, TP.EFLD1])
  , check "with_nesting_repeated.bin" $ TP.WithNestingRepeated
                                          [ TP.WithNestingRepeated_Nested "123abc" 123456 [1,2,3,4] [5,6,7,8]
                                          , TP.WithNestingRepeated_Nested "abc123" 654321 [0,9,8,7] [6,5,4,3]
                                          ]
  , -- Checks parsing repeated embedded messages when one is expected (i.e.,
    -- this tests correct merging; this value was encoded as a
    -- WithNestingRepeated).
    check "with_nesting_repeated.bin" $ TP.WithNesting $ Just $ TP.WithNesting_Nested "abc123" 654321 [1,2,3,4,0,9,8,7] [5,6,7,8,6,5,4,3]
  , -- Checks that embedded message merging works correctly when fields have
    -- default values; this value was encoded as a WithNestingRepeatedInts
    check "with_nesting_ints.bin"     $ TP.WithNestingInts $ Just $ TP.NestedInts 2 2
  ]
  where
    check fp = testCase fp . testParser (testFilesPfx <> fp) fromByteString

testParser :: (Show a, Eq a)
           => FilePath -> (B.ByteString -> Either ParseError a) -> a -> IO ()
testParser fp p reference = do
  bs <- B.readFile fp
  case p bs of
    Left err        -> error $ "Got error: " ++ show err
    Right ourResult -> ourResult @?= reference

testDotProtoParse :: FilePath -> DotProto -> Assertion
testDotProtoParse file ast = do
  contents <- readFile file
  let path = metaModulePath $ protoMeta ast
  case parseProto path contents of
    Left err     -> error $ show err
    Right result -> ast @=? result

testDotProtoPrint :: DotProto -> String -> Assertion
testDotProtoPrint ast expected = expected @=? toProtoFileDef ast

testDotProtoRoundtrip :: DotProto -> Assertion
testDotProtoRoundtrip ast =
  let path = metaModulePath $ protoMeta ast in
  Right ast @=? parseProto path (toProtoFileDef ast)

dotProtoUnitTests :: TestTree
dotProtoUnitTests = testGroup ".proto parsing tests"
  [ dotProtoParseTrivial
  , dotProtoPrintTrivial
  , dotProtoParseEmptyStatement
  , dotProtoRoundtripTrivial
  , dotProtoRoundtripSimpleMessage
  , dotProtoRoundtripExtend
  , qcDotProtoRoundtrip
  ]

trivialDotProto :: DotProto
trivialDotProto = DotProto [] [] DotProtoNoPackage [] (DotProtoMeta (Path $ "test-files" NE.:| ["test_trivial"]))

dotProtoParseTrivial :: TestTree
dotProtoParseTrivial = testCase
  "Parse a content-less file" $
  testDotProtoParse (testFilesPfx <> "trivial.proto") trivialDotProto

dotProtoPrintTrivial :: TestTree
dotProtoPrintTrivial = testCase
  "Print a content-less DotProto" $
  testDotProtoPrint trivialDotProto "syntax = \"proto3\";"

dotProtoParseEmptyStatement :: TestTree
dotProtoParseEmptyStatement =
  testCase "Parse empty statements" (testDotProtoParse filePath dotProtoAST)
  where
    filePath :: FilePath
    filePath = testFilesPfx <> "test_proto_empty_field.proto"

    dotProtoAST :: DotProto
    dotProtoAST =
      DotProto [] []
        (DotProtoPackageSpec (Single "TestProtoEmptyField"))
        [ DotProtoEnum
            ""
            (Single "EnumWithEmptyField")
            [ DotProtoEnumField (Single "enum_foo") 0 []
            , DotProtoEnumField (Single "enum_bar") 1 []
            ]
        , DotProtoMessage
            ""
            (Single "MessageWithEmptyField")
            [ DotProtoMessageField (DotProtoField
                { dotProtoFieldNumber = 1
                , dotProtoFieldType = Prim UInt32
                , dotProtoFieldName = Single "foo"
                , dotProtoFieldOptions = []
                , dotProtoFieldComment = ""
                })
            , DotProtoMessageField (DotProtoField
                { dotProtoFieldNumber = 2
                , dotProtoFieldType = Prim UInt32
                , dotProtoFieldName = Single "bar"
                , dotProtoFieldOptions = []
                , dotProtoFieldComment = ""
                })
            ]
        ]
        (DotProtoMeta (Path (testFilesPfx NE.:| ["test_proto_empty_field.proto"])))

dotProtoRoundtripTrivial :: TestTree
dotProtoRoundtripTrivial = testCase
  "Printing then parsing a content-less DotProto yields an empty DotProto" $
  testDotProtoRoundtrip trivialDotProto

dotProtoSimpleMessage :: DotProto
dotProtoSimpleMessage = DotProto [] [] DotProtoNoPackage
  [ DotProtoMessage "" (Single "MessageTest")
      [ DotProtoMessageField $
          DotProtoField (fieldNumber 1) (Prim Int32) (Single "testfield") [] ""
      ]
  ]
  (DotProtoMeta (Path ("test-files" NE.:| ["simple"])))

dotProtoRoundtripSimpleMessage :: TestTree
dotProtoRoundtripSimpleMessage = testCase
  "Round-trip for a single flat message" $
  testDotProtoRoundtrip dotProtoSimpleMessage

qcDotProtoRoundtrip :: TestTree
qcDotProtoRoundtrip = testProperty
  "Round-trip for a randomly-generated .proto AST" roundtrip
  where
    roundtrip :: DotProto -> Property
    roundtrip ast = let generated = toProtoFileDef ast
                    in case parseProto fakePath generated of
                      Left err     -> error $ formatParseError err generated
                      Right result -> counterexample (formatMismatch ast generated result ) (ast == result)

    formatMismatch initial generated result = "AST changed during reparsing\n\nInitial AST:\n\n"
                                           ++ show initial
                                           ++ "\n\nGenerated .proto file:\n\n"
                                           ++ generated
                                           ++ "\n\nReparsed AST:\n\n"
                                           ++ show result
                                           ++ "\n\nRegenerated .proto file:\n\n"
                                           ++ (toProtoFileDef result)
    formatParseError err generated = "Parsec error:\n\n"
                                  ++ show err
                                  ++ "\n\nWhen attempting to parse:\n\n"
                                  ++ generated
                                  ++ "\n\nInitial AST:\n\n"

dotProtoRoundtripExtend :: TestTree
dotProtoRoundtripExtend =
  let expected :: DotProto
      expected = DotProto [] [] DotProtoNoPackage [] (DotProtoMeta (Path ("test-files" NE.:| ["test_proto_extend"])))
   in testCase
        "Round-trip for a message extension"
        (testDotProtoRoundtrip expected)

--------------------------------------------------------------------------------
-- Helpers

dotProtoFor :: (Named a, Message a) => Proxy# a -> DotProto
dotProtoFor proxy = DotProto [] [] DotProtoNoPackage
  [ DotProtoMessage
      "" (Single (nameOf proxy)) (DotProtoMessageField <$> dotProto proxy)
  ]
  (DotProtoMeta (Path $ "mypath" NE.:| []))

showDotProtoFor :: (Named a, Message a) => Proxy# a -> IO ()
showDotProtoFor proxy = putStrLn . toProtoFileDef $ dotProtoFor proxy

instance Arbitrary WireType where
  arbitrary = oneof $ map return [Varint, P.Fixed32, P.Fixed64, LengthDelimited]

testFilesPfx :: IsString a => a
testFilesPfx = "test-files/"