fiddlerwoaroof/data-lens
1
0
Fork 0
mirror of https://github.com/fiddlerwoaroof/data-lens.git synced 2025-11-08 18:26:32 +00:00
Code Issues Releases Wiki Activity

chore: rearrange optics

Browse Source
This commit is contained in:
Ed Langley
2020-10-31 01:05:20 -07:00
parent 8b39d02344
commit befab03521
1 changed files with 39 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

78
optics.lisp
View File

@ -1,5 +1,42 @@
(in-package :data-lens.lenses) (in-package :data-lens.lenses)
#+fw.dev
(progn
;; maybe functor implementation
(defclass maybe ()
())
(defclass just (maybe)
((%v :initarg :value :reader value)))
(defclass nothing (maybe)
())
(defun just (value)
(make-instance 'just :value value))
(defun nothing (&optional value)
(declare (ignore value))
(make-instance 'nothing))
(defgeneric maybe (default value)
(:method (default (value just))
(value value))
(:method (default (value nothing))
default))
(defgeneric maybe-apply (function value)
(:method (function (value just))
(just (funcall function (value value))))
(:method (function (value nothing))
value))
(defmethod print-object ((o just) s)
(format s "#.(~s ~s)"
'just
(value o)))
(defmethod print-object ((o nothing) s)
(format s "#.(~s)"
'nothing)))
;; identity functor, necessary for set and over ;; identity functor, necessary for set and over
(defclass identity- () (defclass identity- ()
((%v :initarg :value :reader unidentity))) ((%v :initarg :value :reader unidentity)))
@ -173,47 +210,10 @@ contain the new value at the location focused by the lens."
(defun a-lens (cb) (defun a-lens (cb)
(lambda (foo) (lambda (foo)
(fw.lu:prog1-bind (new (clone foo)) (fw.lu:prog1-bind (new (clone foo))
(setf (a new) (setf (a new)
(funcall cb (a foo)))))) (funcall cb (a foo))))))
(view 'a-lens (view 'a-lens
(over 'a-lens '1+ (over 'a-lens '1+
(set 'a-lens 2 (set 'a-lens 2
(make-instance 'foo :a 1)))) #| (make-instance 'foo :a 1)))) #|
==> 3 |#) ==> 3 |#)
#+fw.dev
(progn
;; maybe functor implementation
(defclass maybe ()
())
(defclass just (maybe)
((%v :initarg :value :reader value)))
(defclass nothing (maybe)
())
(defun just (value)
(make-instance 'just :value value))
(defun nothing (&optional value)
(declare (ignore value))
(make-instance 'nothing))
(defgeneric maybe (default value)
(:method (default (value just))
(value value))
(:method (default (value nothing))
default))
(defgeneric maybe-apply (function value)
(:method (function (value just))
(just (funcall function (value value))))
(:method (function (value nothing))
value))
(defmethod print-object ((o just) s)
(format s "#.(~s ~s)"
'just
(value o)))
(defmethod print-object ((o nothing) s)
(format s "#.(~s)"
'nothing)))