#lang at-exp racket/base
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2023-2024 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

(module+ test
  (require rackunit)
  (require syndicate/rewrite)
  (require syndicate/entity-ref)
  (require syndicate/schemas/sturdy)
  (require preserves)

  (define (C . strings) (parse-Caveat (string->preserve (apply string-append strings))))

  (define e0 (entity-ref 'dummy-facet 'dummy-entity '()))

  ;; Allows only 'yes, 'no, and (list x y) through.
  (define c1 @C{<or [<rewrite <and [<bind <_>> <lit yes>]> <ref 0>>
                     <rewrite <and [<bind <_>> <lit no>]> <ref 0>>
                     <rewrite <and [<bind <_>> <arr [<_> <_>]>]> <ref 0>>]>})

  ;; Changes (list x y) into (list 'swapped y x), leaves everything else alone.
  (define c2 @C{<or [<rewrite <arr [<bind <_>> <bind <_>>]> <arr [<lit swapped> <ref 1> <ref 0>]>>
                     <rewrite <bind <_>> <ref 0>>]>})

  ;; Rejects 'no.
  (define c3 @C{<reject <lit no>>})

  ;; An unknown caveat.
  (define c4 @C{<caveat-from-the-year-3000>})

  (define e1 (attenuate-entity-ref e0 c1))

  (check-equal? (run-rewrites (entity-ref-attenuation e1) 'yes) 'yes)
  (check-equal? (run-rewrites (entity-ref-attenuation e1) 'no) 'no)
  (check-equal? (run-rewrites (entity-ref-attenuation e1) '(1 2)) '(1 2))
  (check-equal? (run-rewrites (entity-ref-attenuation e1) '(1 2 3)) (void))
  (check-equal? (run-rewrites (entity-ref-attenuation e1) "yes") (void))

  (define e12 (attenuate-entity-ref e1 c2))

  (check-equal? (run-rewrites (entity-ref-attenuation e12) 'yes) 'yes)
  (check-equal? (run-rewrites (entity-ref-attenuation e12) 'no) 'no)
  (check-equal? (run-rewrites (entity-ref-attenuation e12) '(1 2)) (void))
  (check-equal? (run-rewrites (entity-ref-attenuation e12) '(1 2 3)) (void))
  (check-equal? (run-rewrites (entity-ref-attenuation e12) "yes") (void))

  (define e21 (attenuate-entity-ref e0 c2 c1))

  (check-equal? (run-rewrites (entity-ref-attenuation e21) 'yes) 'yes)
  (check-equal? (run-rewrites (entity-ref-attenuation e21) 'no) 'no)
  (check-equal? (run-rewrites (entity-ref-attenuation e21) '(1 2)) '(swapped 2 1))
  (check-equal? (run-rewrites (entity-ref-attenuation e21) '(1 2 3)) (void))
  (check-equal? (run-rewrites (entity-ref-attenuation e21) "yes") (void))

  (define e123 (attenuate-entity-ref e12 c3))

  (check-equal? (run-rewrites (entity-ref-attenuation e123) 'yes) 'yes)
  (check-equal? (run-rewrites (entity-ref-attenuation e123) 'no) (void))
  (check-equal? (run-rewrites (entity-ref-attenuation e123) '(1 2)) (void))
  (check-equal? (run-rewrites (entity-ref-attenuation e123) '(1 2 3)) (void))
  (check-equal? (run-rewrites (entity-ref-attenuation e123) "yes") (void))

  (define e4 (attenuate-entity-ref e0 c4))

  (check-equal? (run-rewrites (entity-ref-attenuation e4) 'yes) (void))
  (check-equal? (run-rewrites (entity-ref-attenuation e4) 'no) (void))
  (check-equal? (run-rewrites (entity-ref-attenuation e4) '(1 2)) (void))
  (check-equal? (run-rewrites (entity-ref-attenuation e4) '(1 2 3)) (void))
  (check-equal? (run-rewrites (entity-ref-attenuation e4) "yes") (void))

  )