content: -- Copyright (c) Microsoft. All rights reserved.
  -- Licensed under the MIT license. See LICENSE file in the project root for full license information.
  
  {-# LANGUAGE OverloadedStrings, RecordWildCards, TemplateHaskell, ScopedTypeVariables #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  module Tests.Syntax
      ( roundtripAST
      , compareAST
      , failBadSyntax
      , aliasResolution
      , verifySchemaDef
      ) where
  
  import Control.Exception
  import Data.Maybe
  import Data.List
  import Data.Aeson (encode, decode)
  import Data.Aeson.Encode.Pretty (Config(..), NumberFormat(..), Indent(..), encodePretty')
  import Test.QuickCheck.TH.Generators
  import qualified Data.ByteString as B
  import qualified Data.ByteString.Lazy as BL
  import System.FilePath
  import Test.QuickCheck
  import Test.HUnit
  import Test.Tasty
  import Test.Tasty.Golden
  import Language.Bond.Syntax.Types
  import Language.Bond.Syntax.Util
  import Language.Bond.Syntax.SchemaDef
  import IO
  
  makeArbitrary ''Attribute
  makeArbitrary ''Constant
  makeArbitrary ''Constraint
  makeArbitrary ''Default
  makeArbitrary ''Field
  makeArbitrary ''Declaration
  makeArbitrary ''Import
  makeArbitrary ''Language
  makeArbitrary ''Modifier
  makeArbitrary ''Namespace
  makeArbitrary ''Type
  makeArbitrary ''TypeParam
  makeArbitrary ''MethodType
  makeArbitrary ''Bond
  
  
  instance Arbitrary Attribute where
    arbitrary = arbitraryAttribute
  
  instance Arbitrary Field where
    arbitrary = arbitraryField
  
  instance Arbitrary Constant where
    arbitrary = arbitraryConstant
  
  instance Arbitrary Default where
    arbitrary = arbitraryDefault
  
  instance Arbitrary Declaration where
    arbitrary = arbitraryDeclaration
  
  instance Arbitrary Import where
    arbitrary = arbitraryImport
  
  instance Arbitrary Constraint where
    arbitrary = arbitraryConstraint
  
  instance Arbitrary Language where
    arbitrary = arbitraryLanguage
  
  instance Arbitrary Modifier where
    arbitrary = arbitraryModifier
  
  
  instance Arbitrary Namespace where
    arbitrary = arbitraryNamespace
  
  instance Arbitrary TypeParam where
    arbitrary = arbitraryTypeParam
  
  instance Arbitrary Type where
    arbitrary = arbitraryType
  
  instance Arbitrary MethodType where
    arbitrary = arbitraryMethodType
  
  instance Arbitrary Bond where
    arbitrary = arbitraryBond
  
  
  instance Arbitrary Method where
    arbitrary = oneof
      [ Function <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
      , Event <$> arbitrary <*> arbitrary <*> eventInput]
      where
        -- events cannot have streaming input, so we need to customize the
        -- arbitrary input to omit Streaming
        eventInput = oneof [return Void,  Unary <$> arbitrary]
  
  roundtripAST :: Bond -> Property
  roundtripAST x = (decode . encode) x === Just x
  
  assertException :: String -> IO a -> Assertion
  assertException errMsg action = do
      e <- try action
      case e of
          Left (_ :: SomeException) -> return ()
          Right _ -> assertFailure errMsg
  
  failBadSyntax :: String -> FilePath -> Assertion
  failBadSyntax errMsg file = assertException errMsg (parseBondFile [] $ "tests" </> "schema" </> "error" </> file <.> "bond")
  
  compareAST :: FilePath -> Assertion
  compareAST file = do
      bond <- parseBondFile [] $ "tests" </> "schema" </> file <.> "bond"
      json <- parseASTFile $ "tests" </> "schema" </> file <.> "json"
      assertEqual "" bond json
  
  aliasResolution :: Assertion
  aliasResolution = do
      let p1 = TypeParam "T" Nothing
      let p2 = TypeParam "U" Nothing
      let a1 = Alias [] "" [] BT_Bool
      let a2 = Alias [] "" [p1] $ BT_TypeParam p1
      let a3 = Alias [] "" [p1] $ BT_List $ BT_TypeParam p1
      let a4 = Alias [] "" [p1, p2] $ BT_Nullable $ BT_Map (BT_TypeParam p2) (BT_Nullable $ BT_TypeParam p1)
      let a5 = Alias [] "" [p1] $ BT_List $ BT_UserDefined a3 [BT_TypeParam p1]
      let a6 = Alias [] "" [p1, p2] $ BT_Vector $ BT_Vector $ BT_TypeParam p2
  
      assertEqual "" BT_Bool $
          resolveAlias a1 []
  
      assertEqual "" BT_Int32 $
          resolveAlias a2 [BT_Int32]
  
      assertEqual "" (BT_Set BT_Int32) $
          resolveAlias a2 [BT_Set BT_Int32]
  
      assertEqual "" (BT_TypeParam p2) $
          resolveAlias a2 [BT_TypeParam p2]
  
      assertEqual "" (BT_TypeParam p1) $
          resolveAlias a2 [BT_TypeParam p1]
  
      assertEqual "" (BT_List BT_Int32) $
          resolveAlias a3 [BT_Int32]
  
      assertEqual "" (BT_List $ BT_UserDefined a1 []) $
          resolveAlias a3 [BT_UserDefined a1 []]
  
      assertEqual "" (BT_Nullable $ BT_Map BT_Bool $ BT_Nullable BT_String) $
          resolveAlias a4 [BT_String, BT_Bool]
  
      assertEqual "" (BT_List $ BT_UserDefined a3 [BT_Set BT_Bool]) $
          resolveAlias a5 [BT_Set BT_Bool]
  
      assertEqual "" (BT_Vector $ BT_Vector $ BT_List BT_Double) $
          resolveAlias a6 [BT_IntTypeArg 10, BT_List BT_Double]
  
  verifySchemaDef :: FilePath -> String -> TestTree
  verifySchemaDef baseName schemaName =
      goldenVsString
          schemaName
          ("tests" </> "generated" </> "schemadef" </> baseName <.> schemaName <.> "json")
          schemaDef
    where
      schemaDef = do
          (Bond _ _ declarations) <- parseBondFile [] $ "tests" </> "schema" </> baseName <.> "bond"
          let schema = fromJust $ find ((schemaName ==) . declName) declarations
          return $
              BL.fromStrict $
              -- aeson-pretty-print prints anything above 1e19 in scientific notation
              replace "1.8446744073709551615e19" "18446744073709551615" $
              -- some versions aeson encode angle brackets
              replace "\\u003c" "<" $
              replace "\\u003e" ">" $
              BL.toStrict $ prettyEncode $ makeSchemaDef $ BT_UserDefined schema []
        where
          prettyEncode = encodePretty' (Config indentSpaces compare Generic False)
            where
              indentSpaces = Spaces 2
          replace s r bs = if B.null t then h else
              B.append h (B.append r $ replace s r (B.drop (B.length s) t))
            where
              (h, t) = B.breakSubstring s bs
  