content: {-# LANGUAGE OverloadedStrings #-}
  {-# OPTIONS_GHC -Wno-orphans #-}
  
  module SchemaSpec (spec) where
  
  import Data.Proxy
  import Servant.OpenApi
  import Test.Hspec
  import Test.QuickCheck (Arbitrary (..))
  import qualified Test.QuickCheck as Q
  import Test.QuickCheck.Instances ()
  
  import Backend.Api
  import qualified Data.Text as Text
  import Schema ()
  import Servant.API (FromHttpApiData (..))
  import Server
  import qualified Test.Hspec.QuickCheck as Hspec
  import Test.QuickCheck.Property
  import qualified Data.Map as Map
  
  spec :: Spec
  spec = do
    describe "Schema" do
      describe "json" do
        validateEveryToJSON (Proxy @Api)
      describe "Param Schema" do
        describe "FnLiteral" do
          Hspec.prop "Int" $ \(n :: Integer) ->
            parseQueryParam (Text.pack $ show n) === Right (FnLitInt n)
          Hspec.prop "Bool" $ \(n :: Bool) ->
            parseQueryParam (Text.pack $ show n) === Right (FnLitBool n)
  
  -- ----------------------------------------------------------------------------
  -- Arbitrary instances that allow us to verify that the JSON
  -- instances and OpenAPI documentation agree on the schema.
  -- ----------------------------------------------------------------------------
  
  instance Arbitrary FnLiteral where
    arbitrary =
      Q.frequency
        [ (1, FnLitBool <$> arbitrary)
        , (4, FnLitDouble <$> arbitrary)
        , (4, FnLitString <$> arbitrary)
        , (4, FnLitInt <$> arbitrary)
        , -- , (1, FnArray <$> arbitrary)
          -- , (1, FnObject <$> arbitrary)
          (1, pure FnUnknown)
        , (1, pure FnUncertain)
        ]
  
  instance Arbitrary Reasoning where
    arbitrary = Reasoning <$> arbitrary
  
  instance Arbitrary ReasonNode where
    arbitrary = ReasonNode <$> arbitrary <*> arbitrary
  
  -- | The code for this instance is taken from 'Arbitrary1 containers-Data.Tree.Tree'.
  -- See https://hackage.haskell.org/package/QuickCheck-2.15.0.1/docs/src/Test.QuickCheck.Arbitrary.html#line-901
  instance Arbitrary ReasoningTree where
    arbitrary = Q.sized $ \n -> do
      k <- Q.chooseInt (0, n)
      go k
     where
      go n = do
        -- n is the size of the trees.
        node <- arbitrary
        pars <- arbPartition (n - 1) -- can go negative!
        forest <- mapM go pars
        return $
          ReasoningTree
            { payload = node
            , children = forest
            }
  
      arbPartition :: Int -> Q.Gen [Int]
      arbPartition k = case compare k 1 of
        LT -> pure []
        EQ -> pure [1]
        GT -> do
          first <- Q.chooseInt (1, k)
          rest <- arbPartition $ k - first
          Q.shuffle (first : rest)
  
  instance Arbitrary ResponseWithReason where
    arbitrary = ResponseWithReason <$> arbitrary <*> pure emptyTree
  
  instance Arbitrary EvaluatorError where
    arbitrary = Q.oneof [InterpreterError <$> arbitrary]
  
  instance Arbitrary SimpleResponse where
    arbitrary =
      Q.oneof
        [ SimpleResponse <$> arbitrary
        , SimpleError <$> arbitrary
        ]
  
  instance Arbitrary Parameters where
    arbitrary = do
      params <- arbitrary
      pure $ MkParameters params (Map.keys params)
  
  instance Arbitrary Parameter where
    arbitrary = Parameter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
  
  instance Arbitrary Function where
    arbitrary = Server.Function <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
  
  instance Arbitrary EvalBackend where
    arbitrary = Q.chooseEnum (minBound, maxBound)
  
  instance Arbitrary FunctionImplementation where
    arbitrary =
      Server.FunctionImplementation <$> arbitrary <*> arbitrary
  
  instance Arbitrary FnArguments where
    arbitrary =
      Server.FnArguments <$> arbitrary <*> arbitrary
  
  instance Arbitrary SimpleFunction where
    arbitrary = SimpleFunction <$> arbitrary <*> arbitrary
  
  instance Arbitrary OutcomeStyle where
    arbitrary = Q.chooseEnum (ValueOnly, BaseAttributes)
  
  instance Arbitrary OutcomeObject where
    arbitrary =
      OutcomeObject
        <$> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
  
  instance Arbitrary BatchRequest where
    arbitrary =
      BatchRequest
        <$> arbitrary
        <*> arbitrary
  
  instance Arbitrary BatchResponse where
    arbitrary =
      BatchResponse
        <$> arbitrary
        <*> arbitrary
  
  instance Arbitrary Outcomes where
    arbitrary = Q.oneof [OutcomeAttribute <$> arbitrary, OutcomePropertyObject <$> arbitrary]
  
  instance Arbitrary InputCase where
    arbitrary = InputCase <$> arbitrary <*> arbitrary
  
  instance Arbitrary OutputCase where
    arbitrary =
      OutputCase
        <$> arbitrary
        <*> arbitrary
  
  instance Arbitrary OutputSummary where
    arbitrary =
      OutputSummary
        <$> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
  