diff --git a/src/contextual.lisp b/src/contextual.lisp
index 1b1c048..14b0aa1 100644
--- a/src/contextual.lisp
+++ b/src/contextual.lisp
@@ -7,17 +7,21 @@
    #:pure #:fapply #:product
    #:mreturn #:flatmap #:flatten
    #:wrap #:unwrap
+   #:extract #:duplicate #:extend
+   #:expel
 
    #:fmap-func
    #:pure-func #:fapply-func #:product-func
    #:flatmap-func #:flatten-func
    #:wrap-func #:unwrap-func
+   #:extract-func #:duplicate-func #:extend-func
    #:let*-fun #:let-fun #:let-app #:let*-mon #:let-mon
    #:lift #:lift2 #:lift3 #:lift4 #:lift5 #:lift6 #:lift7
 
    #:functor-operators
    #:applicative-operators
    #:monad-operators
+   #:comonad-operators
    #:trivial-operators
 
    #:ctx-run))
@@ -33,6 +37,9 @@
 (defgeneric flatten-func (context))
 (defgeneric wrap-func    (context))
 (defgeneric unwrap-func  (context))
+(defgeneric extract-func (context))
+(defgeneric duplicate-func (context))
+(defgeneric extend-func (context))
 
 (defun ask-fmap ()
   (ctx-asks #'fmap-func))
@@ -61,6 +68,15 @@
 (defun ask-unwrap ()
   (ctx-asks #'unwrap-func))
 
+(defun ask-extract ()
+  (ctx-asks #'extract-func))
+
+(defun ask-duplicate ()
+  (ctx-asks #'duplicate-func))
+
+(defun ask-extend ()
+  (ctx-asks #'extend-func))
+
 (defun fmap (f cmx)
   "Given a function and an embelished value, return a
 contexual expression with the embellishment of the result
@@ -143,6 +159,33 @@ stripped from the input, which has multiple layers of embellishment."
                 (mx (ctx-injest cmx)))
     (funcall unwrap mx)))
 
+(defun extract (cwx)
+  "Return a contextual expression extracting the value from the embellishment."
+  (let-app/ctx ((extract (ask-extract))
+                (wx (ctx-injest cwx)))
+    (funcall extract wx)))
+
+(defun expel (ctx cwx)
+  (ctx-run ctx (extract cwx)))
+
+(defun duplicate (cwx)
+  "Return a contextual expression with the context's embellishment duplicated on the input"
+  (let-app/ctx ((duplicate (ask-duplicate))
+                (wx (ctx-injest cwx)))
+    (funcall duplicate wx)))
+
+(defun extend (f cwx)
+  "Return a contextual expression with the context's embellishment extended back over
+the value extracted from the embellishment."
+  (let-app/ctx ((ctx (ctx-ask))
+                (extend (ask-extend))
+                (wx (ctx-injest cwx)))
+    (funcall extend (lambda (wx)
+                      (let ((result (funcall f wx)))
+                        (if (contextual-p result)
+                            (ctx-run ctx result)
+                            result)))
+             wx)))
 
 (defmacro let*-fun (((var expr) &rest more-bindings) body &body more-body)
   (make-sequential-functor-binding
@@ -368,7 +411,46 @@ not occur in the arguments, return `NIL'."
 
   (call-next-method))
 
-(defclass trivial-operators (monad-operators)
+(defclass comonad-operators (functor-operators)
+  ((extract :initarg :extract :type function :reader extract-func)
+   (duplicate :initarg :duplicate :type function :reader duplicate-func)
+   (extend :initarg :extend :type function :reader extend-func)))
+
+(defmethod initialize-instance ((obj comonad-operators) &rest args)
+  (let ((extract (get-argument-or-slot-value args :extract obj 'extract)))
+    (if extract
+        (setf (slot-value obj 'extract) extract)
+        (error "`EXTRACT' was not provided and could not be derived fro `TRIVIAL-OPERATORS'")))
+
+  (let ((extend (get-argument-or-slot-value args :extend obj 'extend)))
+    (if extend
+        (setf (slot-value obj 'extend) extend)
+        (let ((fmap (get-argument-or-slot-value args :fmap obj 'fmap))
+              (duplicate (get-argument-or-slot-value args :duplicate obj 'duplicate)))
+          (if (and fmap duplicate)
+              (setf (slot-value obj 'extend)
+                    (lambda/duplicate-to-extend :duplicate duplicate :fmap fmap))))))
+
+  (let ((duplicate (get-argument-or-slot-value args :duplicate obj 'duplicate)))
+    (if duplicate (setf (slot-value obj 'duplicate) duplicate)
+        (let ((extend (get-argument-or-slot-value args :extend obj 'extend)))
+          (setf (slot-value obj 'duplicate)
+                (lambda/extend-to-duplicate :extend extend)))))
+
+  (let ((extend (get-argument-or-slot-value args :extend obj 'extend))
+        (extract (get-argument-or-slot-value args :extract obj 'extract)))
+    (setf (slot-value obj 'fmap)
+          (lambda (f wx)
+            (funcall extend (lambda (wx) (funcall f (funcall extract wx))) wx))))
+
+  (call-next-method)
+
+  (assert (slot-value obj 'fmap))
+  (assert (slot-value obj 'extract))
+  (assert (slot-value obj 'duplicate))
+  (assert (slot-value obj 'extend)))
+
+(defclass trivial-operators (monad-operators comonad-operators)
   ((wrap :initarg :wrap :type function :reader wrap-func)
    (unwrap :initarg :unwrap :type function :reader unwrap-func)))
 
@@ -378,28 +460,38 @@ not occur in the arguments, return `NIL'."
     (if wrap
         (setf (slot-value obj 'wrap) wrap)
         (let ((mreturn (get-argument-or-slot-value args :mreturn obj 'mreturn))
-              (pure (get-argument-or-slot-value args :pure obj 'pure)))
-          (if (or mreturn pure)
-              (setf (slot-value obj 'wrap) (or mreturn pure))
+              (pure (get-argument-or-slot-value args :pure obj 'pure))
+              (duplicate (get-argument-or-slot-value args :duplicate obj 'duplicate)))
+          (if (or mreturn pure duplicate)
+              (setf (slot-value obj 'wrap) (or mreturn pure duplicate))
               (error "`WRAP' was not provided and cannot be derived for `TRIVIAL-OPERATORS'")))))
 
   (let ((unwrap (get-argument-or-slot-value args :unwrap obj 'unwrap)))
     (if unwrap
         (setf (slot-value obj 'unwrap) unwrap)
-        (let ((flatten (get-argument-or-slot-value args :flatten obj 'flatten)))
-          (if flatten
-              (setf (slot-value obj 'unwrap) flatten)
+        (let ((flatten (get-argument-or-slot-value args :flatten obj 'flatten))
+              (extract (get-argument-or-slot-value args :extract obj 'extract)))
+          (if (or flatten extract)
+              (setf (slot-value obj 'unwrap) (or flatten extract))
               (error "`UNWRAP' was not provided and cannot be derived for `TRIVIAL-OPERATORS'")))))
 
   (setf (slot-value obj 'mreturn) (slot-value obj 'wrap))
   (setf (slot-value obj 'pure) (slot-value obj 'wrap))
+  (setf (slot-value obj 'duplicate) (slot-value obj 'wrap))
+
   (setf (slot-value obj 'flatten) (slot-value obj 'unwrap))
+  (setf (slot-value obj 'extract) (slot-value obj 'unwrap))
 
   (setf (slot-value obj 'fmap)
         (lambda/wrap-and-unwrap-to-fmap
          :wrap (slot-value obj 'wrap)
          :unwrap (slot-value obj 'unwrap)))
 
+  (let ((wrap (slot-value obj 'wrap)))
+    (setf (slot-value obj 'extend)
+          (lambda (f wx)
+            (funcall wrap (funcall f wx)))))
+
   (assert (slot-boundp obj 'wrap))
   (assert (slot-boundp obj 'unwrap))
   (assert (slot-boundp obj 'flatten))
diff --git a/src/derivation.lisp b/src/derivation.lisp
index 4f3c074..9e63952 100644
--- a/src/derivation.lisp
+++ b/src/derivation.lisp
@@ -10,8 +10,9 @@
    #:defun/flatmap-to-fapply       #:lambda/flatmap-to-fapply
    #:defun/fapply-to-product       #:lambda/fapply-to-product
    #:defun/product-to-fapply       #:lambda/product-to-fapply
-   #:defun/fapply-to-fmap          #:lambda/fapply-to-fmap))
-
+   #:defun/fapply-to-fmap          #:lambda/fapply-to-fmap
+   #:defun/duplicate-to-extend     #:lambda/duplicate-to-extend
+   #:defun/extend-to-duplicate     #:lambda/extend-to-duplicate))
 (in-package :contextual-derivation)
 
 (defmacro with-syms ((&rest names) &body body)
@@ -143,3 +144,117 @@ from the named functions `FAPPLY' and `PURE'."
  from `FAPPLY' and `PURE'."
   (lambda (f mx)
     (funcall fapply (funcall pure f) mx)))
+
+
+
+
+(defmacro defun/duplicate-to-extend (name &key duplicate fmap documentation)
+  "Defines a function `NAME' that prefoms a comonadic mapping operation.
+
+The resulting function will take two arguments: `F', the function to map,
+and `WX', the comonadic input, which will be duplicated before mapping.
+The defined function uses the provided comonadic duplicate and fmap functions
+name by the inputs `DUPLICATE` and `FMAP`.
+
+Parameters:
+  NAME           - The name of the function to define.
+  :DUPLICATE     - The name of the comonadic duplciate function for the context.
+  :FMAP          - The name of the functorial mapping function for the context.
+  :DOCUMENTATION - Optional Documentation for the defined function.
+"
+  (assert duplicate)
+  (assert fmap)
+
+  (let ((documentation (if documentation (list documentation) documentation)))
+    (with-syms (f wx)
+      `(defun ,name (,f ,wx)
+         ,@documentation
+         (,fmap ,f (,duplicate ,wx))))))
+
+(defun lambda/duplicate-to-extend (&key duplicate fmap)
+  "Creates a lambda function that performs a comonadic 'extend' operation.
+
+This function constructs and returns an anonymous function (lambda) that
+takes a function `F' and a comonadic context `WX', and then performs an
+extend-like operation by:
+  1. Duplicating the context `WX' using the provided `DUPLICATE' function.
+  2. Mapping `F' over the duplicated context using the provided `FMAP' function.
+
+Parameters:
+  :DUPLICATE - A function that duplicates the comonadic context `WX'.
+  :FMAP      - A function that maps `F' over elements in the duplicated
+               context.
+
+Usage:
+  This returned lambda function can be applied to a function `F' and a
+  comonadic context `WX' to perform comonadic mapping.
+
+Example:
+  (let ((extend-fn (lambda/duplicate-to-extend :duplicate duplicate-fn :fmap fmap-fn)))
+    (funcall extend-fn some-function some-context))"
+  (flet ((duplicate (wx) (funcall duplicate wx))
+         (fmap (f wx) (funcall fmap f wx)))
+    (lambda (f wx)
+      (fmap f (duplicate wx)))))
+
+
+(defmacro defun/extend-to-duplicate (name &key extend documentation)
+  "Defines a function `NAME` that duplicates a comonadic context using an 'extend' function.
+
+This macro generates a function that takes a single argument `WX` and applies
+the `EXTEND` function to it with an identity transformation, effectively duplicating
+the comonadic context. This is useful in comonadic programming where duplicating
+or 'extending' the context is required to perform further operations.
+
+Parameters:
+  NAME           - The name of the function to define. Must be a symbol.
+  :EXTEND        - A function that takes a transformation function and the comonadic
+                   context `WX`, and applies the transformation across the context.
+                   Must be a symbol.
+  :DOCUMENTATION - An optional string describing the purpose or behavior of the
+                   generated function, added as a docstring.
+
+Example Usage:
+  (defun/extend-to-duplicate my-duplicate :extend extend-fn :documentation \"Duplicates the context using extend-fn\")
+
+This will create a function `my-duplicate` that takes a comonadic context `WX`
+and returns a duplicated context by applying `extend-fn` with an identity transformation."
+
+  (assert (symbolp name))
+  (assert (symbolp extend))
+  (assert (or (null documentation)
+              (stringp documentation)))
+
+  (let ((documentation (if documentation (list documentation) nil)))
+    (with-syms (wx)
+      `(defun ,name (,wx)
+         ,@documentation
+         (,extend (lambda (,wx) ,wx) ,wx)))))
+
+
+
+(defun lambda/extend-to-duplicate (&key extend)
+  "Creates a lambda function that perfoms a comonadic 'duplicate' operation using an 'extend' function.
+
+This function constructs and returns an anonymous function (lambda) that,
+when given a comonadic context `WX', applies an extend-like operation to
+produce a duplicated context. It effectively uses the `EXTEND' function to
+create a new context containing the original context at each level.
+
+Parameters:
+  :EXTEND - A function that performs comonadic mapping to the comonadic context `WX'.
+
+Usage:
+  The returned lambda function can be used to duplicate a comonadic
+  structure by.
+
+Example:
+  (let ((duplicate-fn (lambda/extend-to-duplicate :extend extend-fn)))
+    (funcall duplicate-fn some-context))
+
+This will return a duplicated context by applying the `EXTEND' function
+to `some-context' with an identity function."
+  (assert (functionp extend))
+  (flet ((extend (f wx)
+           (funcall extend f wx)))
+    (lambda (wx) (extend (lambda (wx) wx) wx))))
diff --git a/test/contextual-test.lisp b/test/contextual-test.lisp
index de2b5e7..2d27134 100644
--- a/test/contextual-test.lisp
+++ b/test/contextual-test.lisp
@@ -89,7 +89,7 @@
     (is (equalp (make-id :value 9) (ctx-run context (flatmap #'sqr-id (pure 3)))))
     (is (equalp (make-id :value 3) (ctx-run context (flatten (pure (pure 3))))))))
 
-(test trivial-context
+(test trivial-context-pure-and-flatten
   (let ((context
           (make-instance 'trivial-operators
             :pure (lambda (x) (make-id :value x))
@@ -105,9 +105,65 @@
     (is (equalp (make-id :value 9) (ctx-run context (fmap #'sqr (pure 3)))))
     (is (equalp (make-id :value 9) (ctx-run context (fapply (pure #'sqr) (pure 3)))))
     (is (equalp (make-id :value 9) (ctx-run context (flatmap #'sqr-id (pure 3)))))
-    (is (equalp (make-id :value 3) (ctx-run context (flatten (pure (pure 3))))))))
+    (is (equalp (make-id :value 3) (ctx-run context (flatten (pure (pure 3))))))
+    (is (equalp 3 (ctx-run context (extract (pure 3)))))
+    (is (equalp (make-id :value 3) (ctx-run context (extend #'extract (pure 3)))))
+    (is (equalp (make-id :value 3) (ctx-run context (extend #'extract (make-id :value 3)))))
+    (is (equalp (make-id :value (make-id :value 3))
+                (ctx-run context
+                  (duplicate (pure 3)))))
+    (is (equalp 3 (expel context (pure 3))))))
+
+(test trivial-context-pure-and-extract
+  (let ((context
+          (make-instance 'trivial-operators
+            :pure (lambda (x) (make-id :value x))
+            :extract (lambda (mx) (id-value mx)))))
+    (is-true (typep context 'trivial-operators))
+    (is-true (typep context 'monad-operators))
+    (is-true (typep context 'applicative-operators))
+    (is-true (typep context 'functor-operators))
+    (is (equalp (make-id :value 3) (ctx-run context (pure 3))))
+    (is (equalp (make-id :value 3) (ctx-run context (mreturn 3))))
+    (is (equalp (make-id :value 3) (ctx-run context (wrap 3))))
+    (is (equalp 3 (ctx-run context (unwrap (pure 3)))))
+    (is (equalp (make-id :value 9) (ctx-run context (fmap #'sqr (pure 3)))))
+    (is (equalp (make-id :value 9) (ctx-run context (fapply (pure #'sqr) (pure 3)))))
+    (is (equalp (make-id :value 9) (ctx-run context (flatmap #'sqr-id (pure 3)))))
+    (is (equalp (make-id :value 3) (ctx-run context (flatten (pure (pure 3))))))
+    (is (equalp 3 (ctx-run context (extract (pure 3)))))
+    (is (equalp (make-id :value 3) (ctx-run context (extend #'extract (pure 3)))))
+    (is (equalp (make-id :value 3) (ctx-run context (extend #'extract (make-id :value 3)))))
+    (is (equalp (make-id :value (make-id :value 3))
+                (ctx-run context
+                  (duplicate (pure 3)))))))
 
+(test comonad-context-with-duplicate
+  (let ((context
+          (make-instance 'comonad-operators
+            :fmap (lambda (f wx) (cons (funcall f (car wx))
+                                       (cdr wx)))
+            :extract #'car
+            :duplicate (lambda (wx)
+                         (cons wx (cdr wx))))))
+    (is (equal (ctx-run context
+                 (extend (lambda (wx) (sqr (car wx))) `(3 . 4)))
+               `(9 . 4)))
+    (is (equal 3 (ctx-run context
+                   (extract '(3 . 4)))))
+    (is (equal '((3 . 4) . 4)
+               (ctx-run context
+                 (duplicate `(3 . 4)))))))
 
+(test comonad-context-with-extend
+  (let ((context
+          (make-instance 'comonad-operators
+            :extract #'car
+            :extend (lambda (f wx)
+                      (cons (funcall f wx) (cdr wx))))))
+    (is (equal (ctx-run context (extend (lambda (wx) (sqr (car wx))) `(3 . 4))) `(9 . 4)))
+    (is (equal 3 (ctx-run context (extract '(3 . 4)))))
+    (is (equal '((3 . 4) . 4) (ctx-run context (duplicate `(3 . 4)))))))
 
 (defun rappend (xs ys)
   (labels ((recur (xs accum)
@@ -441,4 +497,10 @@
               :pure #'repeat
               :product #'ziplist-product))
 
-  (is-error (make-instance 'functor-operators)))
+  (is-error (make-instance 'functor-operators))
+
+  (is-error (make-instance 'comonad-operators))
+  (is-error (make-instance 'comonad-operators :extract #'funcall))
+
+  (is-error (make-instance 'comonad-operators :extract #'funcall :duplicate #'list))
+  (is-error (make-instance 'comonad-operators :extend (lambda (f wx) (funcall f wx)))))
diff --git a/test/derivation-test.lisp b/test/derivation-test.lisp
index d7f0434..bb2a233 100644
--- a/test/derivation-test.lisp
+++ b/test/derivation-test.lisp
@@ -39,6 +39,15 @@
 (defun id-unwrap (mx)
   (id-value mx))
 
+(defun id-duplicate (wx)
+  (make-id :value wx))
+
+(defun id-extract (wx)
+  (id-value wx))
+
+(defun id-extend (f wx)
+  (make-id :value (funcall f wx)))
+
 (defun sqr (x)
   (* x x))
 
@@ -125,3 +134,30 @@
          (expected (id-fmap #'sqr mx)))
     (is (equalp expected (funcall fmap #'sqr mx)))
     (is (equalp expected (fmap-from-wrap-and-unwrap #'sqr mx)))))
+
+
+(defun/duplicate-to-extend extend-from-duplicate
+  :duplicate id-duplicate
+  :fmap id-fmap)
+
+(test extend-from-duplicate
+  (flet ((func (wx)
+           (sqr (id-value wx))))
+    (let* ((extend (lambda/duplicate-to-extend
+                    :duplicate #'id-duplicate
+                    :fmap #'id-fmap))
+           (wx (id-pure 3))
+           (expected (id-extend #'func wx)))
+      (is (equalp expected (funcall extend #'func wx))
+          (equalp expected (extend #'func wx))))))
+
+(contextual-derivation:defun/extend-to-duplicate duplicate-from-extend
+  :extend id-extend)
+
+(test duplicate-from-extend
+  (let* ((duplicate (lambda/extend-to-duplicate :extend #'id-extend))
+         (wx (id-pure 3))
+         (expected (id-duplicate wx)))
+    nil
+    (is (equalp expected (funcall duplicate wx)))
+    (is (equalp expected (duplicate-from-extend wx)))))
diff --git a/test/thunk-test.lisp b/test/thunk-test.lisp
index 6de71f6..26fcc70 100644
--- a/test/thunk-test.lisp
+++ b/test/thunk-test.lisp
@@ -38,10 +38,19 @@
   (let ((context (make-thunk-context)))
     (is (equal "X" (funcall (ctx-run context (flatmap (lambda (x) (thunk (symbol-name x))) (pure 'x))))))))
 
-(test flatten/unwrap
+(test flatten/unwrap/extract
   (let ((context (make-thunk-context)))
     (is (eq 'x (funcall (ctx-run context (flatten (thunk (thunk 'x)))))))
-    (is (eq 'x (funcall (ctx-run context (unwrap (thunk (thunk 'x)))))))))
+    (is (eq 'x (funcall (ctx-run context (unwrap (thunk (thunk 'x)))))))
+    (is (eq 'x (ctx-run context (extract (thunk 'x)))))))
+
+(test extend
+  (let ((context (make-thunk-context)))
+    (is (eq 'x (funcall (ctx-run context (extend  #'extract (thunk 'x))))))))
+
+(test duplicate
+  (let ((context (make-thunk-context)))
+    (is (eq 'x (funcall (funcall (ctx-run context (duplicate (pure 'x)))))))))
 
 (test binding-syntax
   (let ((context (make-thunk-context)))