#lang scheme
(require "typeclass-units.ss")

;; A class of things that have a distinguished "head".
(define-signature headable^
  (head))

;; The head of a list is its car.
(define-instance headable^ list-instance@
  (define (head x) (car x)))

;; The head of a vector is the item at index zero.
(define-instance headable^ vec-instance@
  (define (head x) (vector-ref x 0)))

;; A safe-head operation is defined for all things that support a, potentially 
;; unsafe, head operation. The "safety" property here is just an exception 
;; handler.
(define-constrained (safe-head (headable^) => lst)
  (with-handlers ([exn:fail? (λ(_) 'no-head)])
    (head lst)))
  
;; Taking the safe-head of a list.
(define (test-list lst)
  ((safe-head list-instance@) lst))

;; Taking the safe-head of a vector.
(define (test-vec v)
  ((safe-head vec-instance@) v))

;; Some other, dummy, signature.
(define-signature dummy^ (dummy))
(define-instance dummy^ dummy@ 
  (define (dummy) 'dummy))

;; Try providing an implementation that doesn't match the required signature.
;; Doesn't work.
(define (bad-instance)
  ((safe-head dummy@) '(4 5 6)))