{-
  Copyright (c) Meta Platforms, Inc. and affiliates.
  All rights reserved.

  This source code is licensed under the BSD-style license found in the
  LICENSE file in the root directory of this source tree.
-}

{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Schema.Evolves (main) where

import Control.Exception
import Data.Default (def)
import Data.Maybe (fromMaybe)
import Data.List
import qualified Data.Map as Map
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (encodeUtf8)
import Test.HUnit

import TestRunner
import Util.String.Quasi

import Glean.Angle.Types (latestAngleVersion, Type_(..))
import Glean.Database.Schema.Types
import Glean.Init
import Glean (userQuery, userQueryFacts)
import qualified Glean.RTS.Term as RTS
import qualified Glean.RTS.Types as RTS
import Glean.Schema.Util
import Glean.Types as Thrift

import Schema.Lib

schemaEvolves :: Test
schemaEvolves = TestList
  [ TestLabel "cycles are errors" $ TestCase $ do
    -- no cycles created by evolves
    withSchema latestAngleVersion
      [s|
        schema test.1 {}
        schema test.2 {}
        schema test.2 evolves test.1
        schema test.1 evolves test.2
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "throws cycle error" $
        case r of
          Left err -> "cycle" `isInfixOf` show err
          Right _ -> False

  , TestLabel "many may not evolve one" $ TestCase $ do
    -- multiple schemas cannot evolve the same schema
    withSchema latestAngleVersion
      [s|
        schema test.1 {}
        schema test.2 {}
        schema test.3 {}
        schema test.2 evolves test.1
        schema test.3 evolves test.1
        schema all.1 : test.1, test.2, test.3 {}
      |]
      $ \r ->
      assertBool "throws multiple schemas evolve error" $
        case r of
          Left err -> "multiple schemas evolve test.1" `isInfixOf` show err
          Right _ -> False

  , TestLabel "one may evolve many" $ TestCase $ do
    -- one schema can evolve multiple other schemas
    withSchema latestAngleVersion
      [s|
        schema test.1 {}
        schema test.2 {}
        schema test.3 {}
        schema test.3 evolves test.1
        schema test.3 evolves test.2
        schema all.1 : test.1, test.2, test.3 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "can add optional field" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          predicate P : { a : nat }
        }
        schema test.2 {
          predicate P : { a : nat, b: maybe string }
        }
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "can add defaultable field" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          predicate P : { a : nat }
        }
        schema test.2 {
          predicate P : { a : nat, b: { c : string, d : bool } }
        }
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "cannot remove required field" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          predicate R : string
          predicate P : { a : nat, b: R }
        }
        schema test.2 {
          predicate R : string
          predicate P : { a : nat }
        }
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "throws error stating missing field" $
        case r of
          Left err ->
            ("cannot evolve predicate test.P.1 " <>
              "into test.P.2: missing required field: b")
            `isInfixOf` show err
          Right _ -> False

  , TestLabel "can remove optional field" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          predicate P : { a : nat, b: maybe string }
        }
        schema test.2 {
          predicate P : { a : nat }
        }
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "can remove defaultable field" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          predicate P : { a : nat, b: { c: string, d: bool } }
        }
        schema test.2 {
          predicate P : { a : nat }
        }
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "can change order of fields" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          predicate P : { a : nat, b: string }
        }
        schema test.2 {
          predicate P : { b: string, a : nat }
        }
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

   , TestLabel "can add predicate" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          predicate P : { a : nat }
        }
        schema test.2 {
          predicate P : { a : nat }
          predicate Q : { a : nat }
        }
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "can remove a predicate" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          predicate P : { a : nat, b: string }
        }
        schema test.2 {}
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "can add option" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          predicate P : enum { a | b }
        }
        schema test.2 {
          predicate P : enum { a | b | c }
        }
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating the schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "can add alternative" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          predicate P : { a : nat | }
        }
        schema test.2 {
          predicate P : { a : nat | b : string | }
        }
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating the schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "can remove option" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          predicate P : enum { a | b | c }
        }
        schema test.2 {
          predicate P : enum { a | b }
        }
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False


  , TestLabel "can change order of options" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          predicate P : enum { a | b }
        }
        schema test.2 {
          predicate P : enum { b | a }
        }
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "types are transparent" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema test.1 {
          type T = { a : nat }
          predicate P : T
        }
        schema test.2 {
          predicate P : { a : nat }
        }
        schema test.2 evolves test.1
        schema all.1 : test.1, test.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "can evolve field types" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema x.1 {
          predicate P: { a : nat }
        }

        schema y.1 {
          import x.1
          predicate Q: { a : x.P }
        }

        schema x.2 {
          predicate P: { a : nat, b : maybe nat }
        }

        schema y.2 {
          import x.2
          predicate Q: { a : x.P }
        }

        schema x.2 evolves x.1
        schema y.2 evolves y.1
        schema all.1 : x.1, x.2, y.1, y.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "can evolve field types transitively" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema x.1 {
          predicate P: { a : nat }
        }

        schema x.2 {
          predicate P: { a : nat, b : maybe nat }
        }

        schema x.3 {
          predicate P: { a : nat, b : maybe nat, c : maybe nat }
        }

        schema y.1 {
          import x.1
          predicate Q: { a : x.P }
        }

        schema y.2 {
          import x.3
          predicate Q: { a : x.P }
        }

        schema x.2 evolves x.1
        schema x.3 evolves x.2
        schema y.2 evolves y.1
        schema all.1 : x.1, x.2, x.3, y.1, y.2 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "handles type imports" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema base.1 {
          predicate P : nat
          type T = { a : P }
        }

        schema x.2  {
          import base.1
          predicate Q : { x: base.T }
        }

        schema x.3 : x.2 {
          import base.1
          predicate Q : { x: base.T, y: maybe base.T }
        }

        schema x.3 evolves x.2
        schema all.1 : base.1, x.2, x.3 {}
      |]
      $ \r ->
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False

  , TestLabel "re-exported predicates" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema x.1 {
          predicate P : { a : string }
        }

        schema x.2 : x.1  {
        }
        schema x.2 evolves x.1

        schema x.3 {
          predicate P : { a: nat }
        }
        schema x.3 evolves x.2
        schema all.1 : x.1, x.2, x.3 {}
      |]
      $ \r ->
      -- should try to make x.P.3 evolve x.P.1
      assertBool "throws error stating missing field" $
        case r of
          Left err ->
            ("cannot evolve predicate x.P.1 into x.P.3: " <>
              "in field 'a', type changed")
            `isInfixOf` show err
          Right _ -> False

  , TestLabel "re-exported predicates reverse" $ TestCase $ do
    withSchema latestAngleVersion
      [s|
        schema x.1 {
          predicate Q : nat
          predicate P : { ref : Q }
        }

        schema x.2 {
          predicate Q : nat
          predicate P : { ref : Q }
        }

        schema x.3 : x.2 {
          predicate P : { ref : Q }
        }
        schema x.3 evolves x.1
        schema all.1 : x.1, x.2, x.3 {}
      |]
      $ \r ->
      -- x.Q.2 should evolve x.Q.1
      assertBool "succeeds creating schema" $
        case r of
          Right _ -> True
          Left _ -> False
  ]

schemaEvolvesTransformations :: Test
schemaEvolvesTransformations =
  let nothing = RTS.Alt 0 unit
      unit = RTS.Tuple []
  in
  TestList
  [ TestLabel "backcompat - remove optional field" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: { a : nat }
        }
        schema x.2 {
          predicate P: { a : nat, b: maybe string }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": 2, "b": "val" } }|] ]
      ]
      [s| x.P.1 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 1 (length facts)

  , TestLabel "backcompat - fill optional field's default value" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: { a : nat, b: maybe string }
        }
        schema x.2 {
          predicate P: { a : nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": 2 } }|] ]
      ]
      [s| x.P.1 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 1 (length facts)

  , TestLabel "forwardcompat - maps new optional field to default value" $
    TestCase $
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { a : string }
        }
        schema x.2 {
          predicate P : { a : string, b : maybe string }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "a": "A" } }|]
          ]
      ]
      [s| x.P.2 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result content" [RTS.Tuple [RTS.String "A", nothing]] facts

  , TestLabel "forwardcompat - matches new field against default value" $
    TestCase $
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { a : string }
        }
        schema x.2 {
          predicate P : { a : string, b : maybe string }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "a": "A" } }|]
          , [s|{ "key": { "a": "B" } }|]
          ]
      ]
      -- should match { "A", nothing}, but not { "B", { just = "A" }}
      [s| x.P.2 { "A", nothing } |
          x.P.2 { "B", { just = "A" } }
      |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result content" [RTS.Tuple [RTS.String "A", nothing]] facts

  , TestLabel "forwardcompat - binds new field's default value" $
    TestCase $
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { a : string }
        }
        schema x.2 {
          predicate P : { a : string, b : maybe string }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "a": "A" } }|]
          ]
      ]
      [s| X where x.P.2 { _, X } |]
      $ \_ response _ -> do
        facts <- decodeResultsAsTy (MaybeTy StringTy) response
        assertEqual "result content" [nothing] facts

  , TestLabel "backcompat - change field order" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: { a : string, b: nat }
        }
        schema x.2 {
          predicate P: { b: nat, a : string }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": "one1", "b": 16 } }|]
          , [s|{ "key": { "a": "one2", "b": 32 } }|]
          ]
      ]
      [s| x.P.1 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 2 (length facts)

  , TestLabel "forwardcompat - change field order" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: { a : string, b: nat }
        }
        schema x.2 {
          predicate P: { b: nat, a : string }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "b": 16, "a": "one1" } }|]
          , [s|{ "key": { "b": 32, "a": "one2" } }|]
          ]
      ]
      [s| x.P.2 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result count" 2 (length facts)

  , TestLabel "backcompat - change alternative order" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: { a : string | b: nat }
        }
        schema x.2 {
          predicate P: { b: nat | a : string }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": "A" } }|]
          , [s|{ "key": { "b": 1 } }|]
          ]
      ]
      [s| x.P.1 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 2 (length facts)

  , TestLabel "forwardcompat - change alternative order" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: { a : string | b: nat }
        }
        schema x.2 {
          predicate P: { b: nat | a : string }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "a": "A" } }|]
          , [s|{ "key": { "b": 1 } }|]
          ]
      ]
      [s| x.P.2 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result count" 2 (length facts)

  , TestLabel "backcompat - maps new sum alternatives to unknown values" $
    TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { b : string | }
        }
        schema x.2 {
          predicate P : { a : nat | b : string | c : bool | }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": 1 } }|]
          , [s|{ "key": { "b": "A" } }|]
          , [s|{ "key": { "c": true } }|]
          ]
      ]
      [s| x.P.1 _ |]
      $ \byRef response _ -> do
        -- the unknown alternative has an index one greater than
        -- the last alternative index of x.P.1.
        let unknown = RTS.Alt 1 unit
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count"
          [unknown, RTS.Alt 0 (RTS.String "A"), unknown] facts

  , TestLabel "backcompat - maps new enum alternatives to unknown values" $
    TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { b | }
        }
        schema x.2 {
          predicate P : { a | b | c }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": {} } }|]
          , [s|{ "key": { "b": {} } }|]
          , [s|{ "key": { "c": {} } }|]
          ]
      ]
      [s| x.P.1 _ |]
      $ \byRef response _ -> do
        -- the unknown alternative has an index one greater than
        -- the last alternative index of x.P.1.
        let unknown = RTS.Alt 1 unit
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count"
          [unknown, RTS.Alt 0 (RTS.Tuple []), unknown] facts

  , TestLabel "transform nested facts" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: { a : Q }
          predicate Q: { x: string }
        }
        schema x.2 {
          predicate P: { a: Q, b: maybe string }
          predicate Q: { x: string, y: maybe nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.Q" 2)
          [ [s|{ "id": 1, "key": { "x": "A", "y": 1 } }|]
          , [s|{ "id": 2, "key": { "x": "B", "y": 2 } }|]
          ]
      , mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": 1, "b": "A" } }|]
          , [s|{ "key": { "a": 2, "b": "B" } }|]
          ]
      ]
      [s| x.P.1 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 2 (length facts)
        nested <- decodeNestedAs (SourceRef "x.Q" (Just 1)) byRef response
        assertEqual "nested count" 2 (length nested)

  , TestLabel "transform nested facts in userQueryFacts" $ TestCase $ do
    withSchemaAndFacts []
      [s|
        schema x.1 {
          predicate P: { a : Q }
          predicate Q: { x: string }
        }
        schema x.2 {
          predicate P: { a: Q, b: maybe string }
          predicate Q: { x: string, y: maybe nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.Q" 2)
          [ [s|{ "id": 1, "key": { "x": "A", "y": 1 } }|]
          , [s|{ "id": 2, "key": { "x": "B", "y": 2 } }|]
          ]
      , mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": 1, "b": "A" } }|]
          , [s|{ "key": { "a": 2, "b": "B" } }|]
          ]
      ]
      $ \env repo schema -> do
        -- get all P.2 facts
        response <- userQuery env repo $ def
          { userQuery_query = "x.P.2 _"
          , userQuery_options = Just def
            { userQueryOptions_syntax = QuerySyntax_ANGLE }
          , userQuery_encodings = [ UserQueryEncoding_bin def ]
          }
        fids <- factIds response

        -- ask for P.2 facts by Id as P.1
        response <- try $ userQueryFacts env repo $ def
          { userQueryFacts_facts =
              [ def
                  { factQuery_id = fromIntegral fid
                  , factQuery_predicate_version = Just 1
                  , factQuery_recursive = True
                  }
              | fid <- fids ]
          , userQueryFacts_encodings = [ UserQueryEncoding_bin def ]
          }

        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) schema response
        assertEqual "result count" 2 (length facts)
        nested <- decodeNestedAs (SourceRef "x.Q" (Just 1)) schema response
        assertEqual "nested count" 2 (length nested)

  , TestLabel "transform nested record" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          type T = { a: string }
          predicate P : { x: T, y: T  }
        }
        schema x.2 {
          type T = { a: string, b: maybe nat }
          predicate P : { x: T, y: T  }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "x": { "a": "A" }, "y": { "a": "B" }}}|]
          , [s|{ "key": { "x": { "a": "B" }, "y": { "a": "A" }}}|]
          ]
      ]
      [s| x.P.2 { X, Y };
          x.P.2 { Y, X }
      |]
      -- should add the 'maybe nat` field when binding X and Y, and then remove
      -- it again when matching X and Y against db values.
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result"
          [ RTS.Tuple
              [ RTS.Tuple [RTS.String "A", RTS.Alt 0 (RTS.Tuple [])]
              , RTS.Tuple [RTS.String "B", RTS.Alt 0 (RTS.Tuple [])]
              ]
          , RTS.Tuple
              [ RTS.Tuple [RTS.String "B", RTS.Alt 0 (RTS.Tuple [])]
              , RTS.Tuple [RTS.String "A", RTS.Alt 0 (RTS.Tuple [])]
              ]
          ] facts

  , TestLabel "transform deep nested record" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { x: nat, y: nat  }
        }

        schema x.2 {
          predicate P : { x: nat  }
        }
        schema x.2 evolves x.1

        schema y.1 {
          import x.2
          predicate P : x.P
            X where X = x.P _
        }

        schema z.1 {
          import y.1
          predicate P : y.P
            X where X = y.P _
        }

        schema all.1 : x.1, x.2, z.1, y.1 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "x": 1, "y": 2 }}|]
          ]
      ]
      [s| z.P _ |]
      -- should add the 'maybe nat` field when binding X and Y, and then remove
      -- it again when matching X and Y against db values.
      $ \schema response _ -> do
        _ <- decodeResultsAs (SourceRef "z.P" (Just 1)) schema response
        nested <- decodeNestedAs (SourceRef "x.P" (Just 2)) schema response
        assertEqual "nested" 1 (length nested)

  , TestLabel "uses transformed record for prefix search" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: {x: nat, y: { a: string, b: enum { One | Two | Three }}}
        }
        schema x.2 {
          predicate P: {y: {  b: enum { Two | One }, a: string, }, x: nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "x": 1, "y": { "a": "A", "b": 0 }}}|]
          , [s|{ "key": { "x": 1, "y": { "a": "A", "b": 1 }}}|]
          , [s|{ "key": { "x": 1, "y": { "a": "A", "b": 2 }}}|]
          ]
      ]
      [s| x.P.2 { { One, "A"}, 1 }
      |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result" 1 (length facts)
        let searched =
              sum $ Map.elems $ fromMaybe mempty $
              userQueryStats_facts_searched $ fromMaybe def $
              userQueryResults_stats $ either (error "request failure") id
              response
        assertEqual "facts searched" 1 searched

  , TestLabel "change within type" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: T
          type T = { a: string | b : TT }
          type TT = { x: nat | y: string }
        }
        schema x.2 {
          predicate P: T
          type T = { b: TT | a: string }
          type TT = { y: string | x: nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": "A" } }|]
          , [s|{ "key": { "b": { "x" : 1 } } }|]
          , [s|{ "key": { "b": { "y" : "B" } } }|]
          ]
      ]
      [s| x.P.1 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 3 (length facts)

  , TestLabel "no mapping when schema has facts" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { a : nat }
        }
        schema x.2 {
          predicate P : { a : nat, b: maybe string }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "a": 1 } }|]
          ]
      , mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": 1, "b": "A" } }|]
          , [s|{ "key": { "a": 2, "b": "B" } }|]
          ]
      ]
      [s| x.P.1 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 1 (length facts)

  , TestLabel "non-evolved derived predicate with imports" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { a : nat }
        }
        schema x.2 {
          predicate P : { a : nat, b: maybe string }
        }
        schema x.2 evolves x.1
        schema y.1 {
          import x.1
          predicate Q : { x : x.P }
            { x = V } where V = x.P _
        }
        schema all.1 : x.1, x.2, y.1 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": 1, "b": "A" } }|]
          ]
      ]
      [s| y.Q.1 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "y.Q" (Just 1)) byRef response
        assertEqual "result count" 1 (length facts)
        nested <- decodeNestedAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "nested count" 1 (length nested)

  , TestLabel "non-evolved derived predicate with inheritance" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { a : nat }
        }
        schema x.2 {
          predicate P : { a : nat, b: maybe string }
        }
        schema x.2 evolves x.1

        schema y.1 : x.1 {
          predicate Q : { x : x.P }
            { x = V } where V = x.P _
        }
        schema all.1 : x.1, x.2, y.1 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": 1, "b": "A" } }|]
          ]
      ]
      [s| y.Q.1 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "y.Q" (Just 1)) byRef response
        assertEqual "result count" 1 (length facts)
        nested <- decodeNestedAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "nested count" 1 (length nested)

  , TestLabel "dependency without facts" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 { predicate P : { a : nat } }
        schema x.2 { predicate P : { b : string } }
        schema x.2 evolves x.1

        schema y.1 {
          import x.1
          predicate Q : [x.P.1]
        }

        schema y.2 {
          import x.2
          predicate Q : [x.P.2]
        }
        schema y.2 evolves y.1
        schema all.1 : x.1, x.2, y.1, y.2 {}
      |]
      [ mkBatch (PredicateRef "y.Q" 1)
          [ [s|{ "key": [] }|]
          ]
      ]
      [s| y.Q.2 _ |]
      -- there are no facts of x.1 or x.2 so there will be no evolution
      -- of the x schema. Nonetheless we should be able to evolve y.1
      -- into y.2 even though there is no evolution for one of its option.
      -- This is only the case because there are no facts for the option
      -- or its evolved counterpart.
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "y.Q" (Just 2)) byRef response
        assertEqual "result count" 1 (length facts)

  , TestLabel "query matching order" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema base.1 {
          predicate N : nat
          predicate S : string
        }
        schema x.1 : base.1 {
          predicate P : { a : N, b : S }
        }
        schema x.2 : base.1 {
          predicate P : { b: S, a : N }
        }
        schema x.2 evolves x.1
        schema all.1 : base.1, x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "base.N" 1)
          [ [s|{ "id": 1, "key": 1 }|]
          ]
      , mkBatch (PredicateRef "base.S" 1)
          [ [s|{ "id": 2, "key": "A" }|]
          , [s|{ "id": 3, "key": "B" }|]
          ]
      , mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "b": 2, "a": 1 } }|]
          , [s|{ "key": { "b": 3, "a": 1 } }|]
          ]
      ]
      -- even though x.P.2 first field is base.S, X should be
      -- bound to the first field of x.P.1 which is base.N.
      [s| X where { X, _ } = x.P.1 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "base.N" (Just 1)) byRef response
        assertEqual "result count" 1 (length facts)

  , TestLabel "query variable" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : nat
          predicate Q : { a: P, b : string }
        }
        schema x.2 {
          predicate P : nat
          predicate Q : { b: string, a: P }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "id": 1, "key": 1 }|]
          , [s|{ "id": 2, "key": 2 }|]
          ]
      , mkBatch (PredicateRef "x.Q" 2)
          [ [s|{ "key": { "b": "A", "a": 1 } }|]
          , [s|{ "key": { "b": "A", "a": 2 } }|]
          ]
      ]
      [s| Y where
            X = x.P.1 _;
            Y = x.Q.1 { X, _ };
      |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.Q" (Just 1)) byRef response
        assertEqual "result count" 2 (length facts)
        nested <- decodeNestedAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "nested count" 2 (length nested)

  , TestLabel "whole key assigned to variable - remove fields" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { a : string }
        }
        schema x.2 {
          predicate P : { a: string, b: maybe nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "a": "A", "b": 1  }}|]
          , [s|{ "key": { "a": "B", "b": 2  }}|]
          ]
      ]
      [s| X where
            X = x.P.1 Y;
            { a = "A" } = Y;
      |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result" [RTS.Tuple [RTS.String "A"]] facts

  , TestLabel "whole key assigned to variable - fill defaults" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { a : string }
          predicate Q : { a: string, b: maybe nat }
        }
        schema x.2 {
          predicate P : { a: string, b: maybe nat }
          predicate Q : { a: string, b: maybe nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "a": "A" }}|]
          , [s|{ "key": { "a": "B" }}|]
          ]
      , mkBatch (PredicateRef "x.Q" 1)
          [ [s|{ "key": { "a": "A" }}|]
          , [s|{ "key": { "a": "A", "b": 1  }}|]
          , [s|{ "key": { "a": "B", "b": 2  }}|]
          ]
      ]
      [s| x.P.2 X;
          x.Q.2 X
      |]
      -- should bind 'nothing' as the default value of the second field of
      -- x.P.2, causing values from x.Q.2 with a second value of 'just' to
      -- not match.
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.Q" (Just 2)) byRef response
        assertEqual "result"
          [RTS.Tuple [RTS.String "A", RTS.Alt 0 (RTS.Tuple [])]]
          facts

  , TestLabel "predicate derivation" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : nat
          predicate Q : string
          predicate R : nat A where P A
        }
        schema x.2 {
          predicate P : nat
          predicate Q : string
          predicate R : string A where Q A
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": 1 }|]
          ]
      , mkBatch (PredicateRef "x.Q" 2)
          [ [s|{ "key": "A" }|]
          , [s|{ "key": "B" }|]
          ]
      ]
      [s| x.R.1 _ |]
      -- Derived predicates should not be substituted for their newest
      -- version but the query they flatten-out into should be evolved.
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.R" (Just 1)) byRef response
        assertEqual "result count" 1 (length facts)

  , TestLabel "predicate value" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { x : nat, y : string }
          predicate Q : nat -> P
        }
        schema x.2 {
          predicate P : { y : string, x : nat }
          predicate Q : nat -> P
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "id": 1, "key": { "y": "A", "x": 1 } }|]
          ]

      , mkBatch (PredicateRef "x.Q" 2)
          [ [s|{ "key": 1, "value" : 1 }|]
          ]
      ]
      [s| P where x.Q.1 _ -> P |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 1 (length facts)

  , TestLabel "derived predicate value" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { x : nat, y : string }
          predicate Q : nat -> P
            X -> Y where Y = P { X, _ }
        }
        schema x.2 {
          predicate P : { y : string, x : nat }
          predicate Q : nat -> P
            X -> Y where Y = P { _, X }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "y": "A", "x": 1 } }|]
          , [s|{ "key": { "y": "B", "x": 2 } }|]
          ]
      ]
      [s| P where x.Q.1 _ -> P |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 2 (length facts)

  , TestLabel "subquery in primcall" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { x : nat, y : string }
        }
        schema x.2 {
          predicate P : { y : string, x : nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "y": "A", "x": 1 } }|]
          , [s|{ "key": { "y": "B", "x": 2 } }|]
          ]
      ]
      [s| x.P.1 { X, _ } where
            X = (Y where x.P.1 { Y, _ }) + (Z where x.P.1 { Z, _ })
      |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 1 (length facts)

  , TestLabel "array elements" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { x : nat, y : string }
        }
        schema x.2 {
          predicate P : { y : string, x : nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "y": "A", "x": 1 } }|]
          , [s|{ "key": { "y": "B", "x": 2 } }|]
          ]
      ]
      -- check that not only the type of elements inside the array
      -- changed but also that the pattern matched against the array
      -- is changed.
      [s| x.P.1 { N, _ } where
            A = [ x.P.1 { 1, _ }, x.P.1 { 2, _ } ];
            { N, _ } = A[..]
      |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 2 (length facts)

  , TestLabel "named type inside alts" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          type T = { a: string, b: nat }
          predicate P : { x : maybe T }
        }
        schema x.2 {
          type T = { b: nat, a: string }
          predicate P : { x : maybe T }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "x": { "a": "A", "b": 1 } } }|]
          , [s|{ "key": { "x": { "a": "B", "b": 2 } } }|]
          ]
      ]
      [s| x.P.1 { x = { just = { a = _ } } }|]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 2 (length facts)

  , TestLabel "negation" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { x : nat, y : string }
        }
        schema x.2 {
          predicate P : { y : string, x : nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "key": { "y": "A", "x": 1 } }|]
          , [s|{ "key": { "y": "B", "x": 2 } }|]
          ]
      ]
      [s| X where
            X = x.P.1 _;
            !(X = x.P.1 { 1, _ })
      |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 1 (length facts)

  , TestLabel "multiple evolved, same pred" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate N : nat
        }
        schema x.2 {
          predicate N : nat
        }
        schema x.2 evolves x.1

        schema y.1 {
          import x.1
          import x.2

          predicate Q : { x: x.N.1, y: x.N.2 }
        }
        schema all.1 : x.1, x.2, y.1 {}
      |]
      [ mkBatch (PredicateRef "x.N" 2)
          [ [s|{ "key": 1 }|]
          ]
      ]
      [s| y.Q.1 _ |]
      $ \_ response _ ->
        case response of
          Right _ -> assertFailure "expected request to fail"
          Left badQuery ->
            assertBool "errors with multple versions of evolved predicate"
            ("multiple versions of evolved predicates"
              `isInfixOf` show badQuery)

  , TestLabel "explicit fact id" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { x: nat }
        }
        schema x.2 {
          predicate P : { x: nat, y: maybe nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "id": 1, "key": { "x": 1, "y": 2 } }|]
          ]
      ]
      [s| x.P.1 _ |]
      $ \byRef (Right results) runQuery -> do
        fids <- factIds results
        let factId = head fids

        response <- runQuery $ "$" <> pack (show factId) <> " : x.P.1"
        facts <- decodeResultsAs (SourceRef "x.P" (Just 1)) byRef response
        assertEqual "result count" 1 (length facts)

  , TestLabel "correct return type" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P : { x: nat }
        }
        schema x.2 {
          predicate P : { x: nat, y: maybe nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "id": 1, "key": { "x": 1, "y": 2 } }|]
          ]
      ]
      [s| x.P.1 _ |]
      $ \_ (Right results) _ -> do
        let Just ty = userQueryResults_type results
        assertEqual "result type" "x.P.1" ty

  , TestLabel "re-exported predicates" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate Q : nat
        }

        schema x.2 : x.1 {
          predicate P : { ref : Q.1 }
        }

        schema x.3 {
          predicate Q : nat
          predicate P : { ref : Q }
        }

        schema x.3 evolves x.2
        schema all.1 : x.1, x.2, x.3 {}
      |]
      [ mkBatch (PredicateRef "x.Q" 1)
          [ [s|{ "id": 1, "key": 1 }|]
          ]
      , mkBatch (PredicateRef "x.P" 2)
          [ [s|{ "id": 1, "key": { "ref": 1 } }|]
          ]
      ]
      -- should make x.Q.1, which is re-exported by x.3, evolve x.Q.3
      [s| x.P.3 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 3)) byRef response
        assertEqual "result count" 1 (length facts)

  , TestLabel "transform within array" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          type T = { a : nat }
          predicate P: { x : [T] }
        }
        schema x.2 {
          type T = { a : nat, b : maybe nat }
          predicate P: { x : [T] }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "x": [{ "a": 1 }, { "a": 2 }] } }|] ]
      ]
      [s| x.P.2 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result content"
          [ RTS.Tuple
            [ RTS.Array
              [ RTS.Tuple [RTS.Nat 1, nothing]
              , RTS.Tuple [RTS.Nat 2, nothing]
              ] ] ]
          facts
  , TestLabel "transform predicate within set" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          type T = { a : nat }
          predicate P: { x : set T }
        }
        schema x.2 {
          type T = { a : nat, b : maybe nat }
          predicate P: { x : set T }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
        [ [s|{ "key": { "x": [{ "a": 1 }, { "a": 2 }] } }|] ]
      ]
      [s| x.P.2 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result content"
          [ RTS.Tuple
            [ RTS.Array
              [ RTS.Tuple [RTS.Nat 1, nothing]
              , RTS.Tuple [RTS.Nat 2, nothing]
              ] ] ]
          facts
  , TestLabel "evolve array to set of nat" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: { x : [nat] }
        }
        schema x.2 {
          predicate P: { x : set nat }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
        [ [s|{ "key": { "x": [ 1 , 1, 2 ] } }|] ]
      ]
      [s| x.P.2 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result content"
          [ RTS.Tuple
            [ RTS.Array
              [ RTS.Nat 1
              , RTS.Nat 2
              ] ] ]
          facts
  , TestLabel "evolve set to array of nat" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: { x : set nat }
        }
        schema x.2 {
          predicate P: { x : [nat] }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
        [ [s|{ "key": { "x": [ 1 , 1, 2 ] } }|] ]
      ]
      [s| x.P.2 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result content"
          [ RTS.Tuple
            [ RTS.Array
              [ RTS.Nat 1
              , RTS.Nat 2
              ] ] ]
          facts
  , TestLabel "evolve set to array of byte" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: { x : set byte }
        }
        schema x.2 {
          predicate P: { x : [byte] }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
        [ [s|{ "key": { "x": [ 1 , 1, 2 ] } }|] ]
      ]
      [s| x.P.2 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result content"
          [ RTS.Tuple
            [ RTS.ByteArray "\SOH\STX" ] ]
          facts
  , TestLabel "evolve array to set of byte" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          predicate P: { x : [byte] }
        }
        schema x.2 {
          predicate P: { x : set byte }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
        [ [s|{ "key": { "x": [ 1 , 1, 2 ] } }|] ]
      ]
      [s| x.P.2 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result content"
          [ RTS.Tuple
            [ RTS.Array [RTS.Byte 1, RTS.Byte 2] ] ]
          facts
  , TestLabel "evolve array to set of pred" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          type T = { a : nat }
          predicate P: { x : [T] }
        }
        schema x.2 {
          type T = { a : nat, b : maybe nat }
          predicate P: { x : set T }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "x": [{ "a": 1 }, { "a": 2 }] } }|] ]

      ]
      [s| x.P.2 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result content"
          [ RTS.Tuple
            [ RTS.Array
              [ RTS.Tuple [RTS.Nat 1, nothing]
              , RTS.Tuple [RTS.Nat 2, nothing]
              ] ] ]
          facts
  , TestLabel "evolve set to array of pred" $ TestCase $ do
    withSchemaAndFactsQ
      [s|
        schema x.1 {
          type T = { a : nat }
          predicate P: { x : set T }
        }
        schema x.2 {
          type T = { a : nat, b : maybe nat }
          predicate P: { x : [T] }
        }
        schema x.2 evolves x.1
        schema all.1 : x.1, x.2 {}
      |]
      [ mkBatch (PredicateRef "x.P" 1)
          [ [s|{ "key": { "x": [{ "a": 1 }, { "a": 2 }] } }|] ]
      ]
      [s| x.P.2 _ |]
      $ \byRef response _ -> do
        facts <- decodeResultsAs (SourceRef "x.P" (Just 2)) byRef response
        assertEqual "result content"
          [ RTS.Tuple
            [ RTS.Array
              [ RTS.Tuple [RTS.Nat 1, nothing]
              , RTS.Tuple [RTS.Nat 2, nothing]
              ] ] ]
          facts
  ]
  where
    -- run a userQuery using the given schemas and facts
    withSchemaAndFactsQ
      :: String                  -- ^ schema
      -> [JsonFactBatch]         -- ^ db contents
      -> Text                    -- ^ initial query
      -> ( DbSchema
        -> Either BadQuery UserQueryResults                -- query response
        -> (Text -> IO (Either BadQuery UserQueryResults)) -- run more queries
        -> IO a )
      -> IO a
    withSchemaAndFactsQ schema facts query act =
      withSchemaAndFacts [] schema facts $ \env repo dbSchema -> do
      let run q = do
            response <- try $ runQuery env repo (encodeUtf8 q)
            print (response :: Either BadQuery UserQueryResults)
            return response
      res <- run query
      act dbSchema res run
      where
        runQuery env repo q = userQuery env repo $ def
          { userQuery_query = q
          , userQuery_options = Just def
            { userQueryOptions_syntax = QuerySyntax_ANGLE
            , userQueryOptions_recursive = True
            , userQueryOptions_collect_facts_searched = True
            , userQueryOptions_debug = def
              { queryDebugOptions_bytecode = False
              , queryDebugOptions_ir = False
              }
            }
          , userQuery_encodings = [ UserQueryEncoding_bin def ]
          }

    factIds :: UserQueryResults -> IO [Id]
    factIds results =
      case userQueryResults_results results of
        UserQueryEncodedResults_bin bin ->
          return $ Map.keys $ userQueryResultsBin_facts bin
        _ ->
          assertFailure "wrong encoding"

    decodeResultsAs
      :: SourceRef
      -> DbSchema
      -> Either BadQuery UserQueryResults
      -> IO [RTS.Value]
    decodeResultsAs ref schema eresults = do
      res <- decodeResults
        (keyType ref schema) userQueryResultsBin_facts eresults
      either assertFailure return res

    -- filter nested predicates by SourceRef before decoding
    decodeNestedAs ref schema eresults = do
      let hasPid (RTS.Pid pid) fact = fromIntegral pid == Thrift.fact_type fact
          factsOfType pid = Map.filterWithKey (const $ hasPid pid)
      pid <- either (assertFailure . unpack) (return . predicatePid) $
        lookupPredicateSourceRef ref LatestSchema schema
      putStrLn $ "Filtering for " <> show (showRef ref) <> " with Pid " <> show pid
      either assertFailure return =<< decodeResults
        (keyType ref schema)
        (factsOfType pid . userQueryResultsBin_nestedFacts)
        eresults


    decodeResultsAsTy ty eresults =  do
      res <- decodeResults ty userQueryResultsBin_facts eresults
      either assertFailure return res

    keyType
      :: SourceRef
      -> DbSchema
      -> RTS.Type
    keyType ref dbSchema =
      case lookupPredicateSourceRef ref LatestSchema dbSchema of
        Left err -> error $ "can't find predicate: " <>
          unpack (showRef ref) <> ": " <> unpack err
        Right details -> predicateKeyType details

main :: IO ()
main = withUnitTest $ testRunner $ TestList $
  [ TestLabel "schemaEvolves" schemaEvolves
  , TestLabel "schemaEvolvesTransformations" schemaEvolvesTransformations
  ]