From 0f2512ec9f618a0bce7eea6b1e3e82cf00b6f53d Mon Sep 17 00:00:00 2001
From: AlexKnauth <alexander@knauth.org>
Date: Mon, 20 Jul 2015 13:48:07 -0400
Subject: [PATCH] add isomorphism lenses

---
 unstable/lens/isomorphism.rkt      |  3 ++
 unstable/lens/isomorphism/base.rkt | 64 ++++++++++++++++++++++++++++++
 unstable/lens/isomorphism/data.rkt |  3 ++
 3 files changed, 70 insertions(+)
 create mode 100644 unstable/lens/isomorphism.rkt
 create mode 100644 unstable/lens/isomorphism/base.rkt
 create mode 100644 unstable/lens/isomorphism/data.rkt

diff --git a/unstable/lens/isomorphism.rkt b/unstable/lens/isomorphism.rkt
new file mode 100644
index 0000000..6d413a3
--- /dev/null
+++ b/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"))
diff --git a/unstable/lens/isomorphism/base.rkt b/unstable/lens/isomorphism/base.rkt
new file mode 100644
index 0000000..be8c779
--- /dev/null
+++ b/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))
+  )
diff --git a/unstable/lens/isomorphism/data.rkt b/unstable/lens/isomorphism/data.rkt
new file mode 100644
index 0000000..e558621
--- /dev/null
+++ b/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)))