Merge pull request #130 from AlexKnauth/iso

add isomorphism lenses

unstable/lens/isomorphism.rkt

@@ -0,0 +1,3 @@
+#lang racket/base
+(require "isomorphism/base.rkt" "isomorphism/data.rkt")
+(provide (all-from-out "isomorphism/base.rkt" "isomorphism/data.rkt"))

unstable/lens/isomorphism.scrbl

@@ -0,0 +1,54 @@
+#lang scribble/manual
+
+@(require lens/doc-util/main)
+
+@title{Isomorphisms}
+
+@defmodule[unstable/lens/isomorphism]
+
+@defproc[(isomorphism-lens [f (a/c . -> . b/c)] [inv (b/c . -> . a/c)]) lens?]{
+Creates a lens for an isomorphism. The @racket[f] argument should be a function
+with an inverse, and the @racket[inv] argument should be its inverse.
+The @racket[f] function converts targets to views, and the @racket[inv] function
+converts views to targets.
+
+So for instance a @racket[symbol->string-lens] could be defined with:
+@racketblock[
+  (define symbol->string-lens
+    (isomorphism-lens symbol->string string->symbol))
+]
+@lenses-unstable-examples[
+  (lens-view symbol->string-lens 'something)
+  (lens-transform symbol->string-lens 'something (λ (s) (string-append "make-" s)))
+]}
+
+@defproc[(isomorphism-lens? [v any/c]) boolean?]{
+A predicate that returns true when @racket[v] is a lens constructed with
+@racket[isomorphism-lens], @racket[isomorphism-lens-inverse], or
+@racket[isomorphism-lenses], and returns false otherwise.
+All isomorphism lenses are also lenses according to @racket[lens?].
+}
+
+@defproc[(isomorphism-lens-inverse [iso-lens isomorphism-lens?]) isomorphism-lens?]{
+Returns the inverse of @racket[iso-lens].
+}
+
+@defproc[(isomorphism-lenses [f (a/c . -> . b/c)] [inv (b/c . -> . a/c)])
+         (values isomorphism-lens? isomorphism-lens?)]{
+Returns two values. The first value is the result of
+@racket[(isomorphism-lens f inv)], and the second value is the inverse of that
+lens.
+
+The lenses @racket[symbol->string-lens] and @racket[string->symbol-lens], for
+example, are defined like this:
+@racketblock[
+  (define-values [string->symbol-lens symbol->string-lens]
+    (isomorphism-lenses string->symbol symbol->string))
+]}
+
+@deflenses[[string->symbol-lens symbol->string-lens
+            number->string-lens string->number-lens
+            list->vector-lens vector->list-lens
+            list->string-lens string->list-lens]]{
+Isomorphim lenses for @racket[string->symbol], @racket[number->string], and so on.
+}

unstable/lens/isomorphism/base.rkt

@@ -0,0 +1,64 @@
+#lang racket/base
+
+(provide isomorphism-lens
+         isomorphism-lens?
+         isomorphism-lens-inverse
+         isomorphism-lenses
+         )
+(module+ data
+  (provide string->symbol-lens symbol->string-lens
+           number->string-lens string->number-lens
+           list->vector-lens vector->list-lens
+           list->string-lens string->list-lens
+           ))
+
+(require racket/match
+         lens/base/main
+         )
+(module+ test
+  (require rackunit (submod ".." data)))
+
+(struct isomorphism-lens (f inv) #:transparent
+  #:methods gen:lens
+  [(define (lens-view lens tgt)
+     ((isomorphism-lens-f lens) tgt))
+   (define (lens-set lens tgt v)
+     ((isomorphism-lens-inv lens) v))])
+
+(define (isomorphism-lens-inverse lens)
+  (match lens
+    [(isomorphism-lens f inv)
+     (isomorphism-lens inv f)]))
+
+(define (isomorphism-lenses f inv)
+  (values (isomorphism-lens f inv)
+          (isomorphism-lens inv f)))
+
+(module+ data
+  (define-values [string->symbol-lens symbol->string-lens]
+    (isomorphism-lenses string->symbol symbol->string))
+  (define-values [number->string-lens string->number-lens]
+    (isomorphism-lenses number->string string->number))
+  (define-values [list->vector-lens vector->list-lens]
+    (isomorphism-lenses list->vector vector->list))
+  (define-values [list->string-lens string->list-lens]
+    (isomorphism-lenses list->string string->list))
+  )
+
+(module+ test
+  (test-case "string-symbol"
+    (check-equal? (lens-view string->symbol-lens "a") 'a)
+    (check-equal? (lens-set string->symbol-lens "a" 'b) "b")
+    (check-equal? (lens-view symbol->string-lens 'a) "a")
+    (check-equal? (lens-set symbol->string-lens 'a "b") 'b))
+  (test-case "number-string"
+    (check-equal? (lens-view number->string-lens 5) "5")
+    (check-equal? (lens-set number->string-lens 5 "6") 6)
+    (check-equal? (lens-view string->number-lens "5") 5)
+    (check-equal? (lens-set string->number-lens "5" 6) "6"))
+  (test-case "inverses"
+    (check-equal? (isomorphism-lens-inverse string->symbol-lens) symbol->string-lens)
+    (check-equal? (isomorphism-lens-inverse symbol->string-lens) string->symbol-lens)
+    (check-equal? (isomorphism-lens-inverse number->string-lens) string->number-lens)
+    (check-equal? (isomorphism-lens-inverse string->number-lens) number->string-lens))
+  )

unstable/lens/isomorphism/data.rkt

@@ -0,0 +1,3 @@
+#lang racket/base
+(require (submod "base.rkt" data))
+(provide (all-from-out (submod "base.rkt" data)))

unstable/lens/main.rkt

@@ -3,9 +3,13 @@
 (require "syntax.rkt"
          "view-set.rkt"
          "sublist.rkt"
-         "arrow.rkt")
+         "arrow.rkt"
+         "isomorphism.rkt"
+         )
 
 (provide (all-from-out "syntax.rkt"
                        "view-set.rkt"
                        "sublist.rkt"
-                       "arrow.rkt"))
+                       "arrow.rkt"
+                       "isomorphism.rkt"
+                       ))

unstable/lens/main.scrbl

@@ -13,3 +13,4 @@ this library being backwards-compatible.
 @include-section["syntax.scrbl"]
 @include-section["sublist.scrbl"]
 @include-section["arrow.scrbl"]
+@include-section["isomorphism.scrbl"]