Skip to content

Instantly share code, notes, and snippets.

@ctford
Created December 10, 2017 22:40
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ctford/369fa4c46d527415b0e0f4527a17bcbc to your computer and use it in GitHub Desktop.
Save ctford/369fa4c46d527415b0e0f4527a17bcbc to your computer and use it in GitHub Desktop.
A non-compiling prism implementation where the applicative instance is AWOL.
module Optic.Prism
import Data.List
%default total
-- Const
data Const a b = Constant a
implementation Functor (Const a) where
map _ (Constant x) = (Constant x)
implementation Monoid m => Applicative (Const m) where
pure _ = Constant neutral
(Constant x) <*> (Constant y) = Constant (x <+> y)
runConst : Const a b -> a
runConst (Constant x) = x
-- Prism
Prism : Type -> Type -> Type -> Type -> Type
Prism s t a b = {f : Type -> Type} -> Applicative f => (a -> f b) -> s -> f t
prism : (a -> s) -> (s -> Maybe a) -> Prism s s a a
prism encode decode fn s =
case (decode s) of
Nothing => pure s
(Just v) => map encode $ fn v
view : Prism s s a a -> s -> Maybe a
view p x = runConst $ p (Constant . Just) x
-- Maybe Prism
justPrism : Prism (Maybe a) (Maybe a) a a
justPrism = prism Just id
getNat : Maybe Nat
getNat = view justPrism (Just 1) -- Can't find applicative of f1.
@clayrat
Copy link

clayrat commented Dec 10, 2017

If you make f explicit:

Prism : Type -> Type -> Type -> Type -> Type
Prism s t a b = (f : Type -> Type) -> Applicative f => (a -> f b) -> s -> f t

prism : (a -> s) -> (s -> Maybe a) -> Prism s s a a
prism encode decode _ _ fn s =
  case decode s of
    Nothing  => pure s
    (Just v) => map encode $ fn v

view : Prism s s a a -> s -> Maybe a
view p x = runConst $ p _ (Constant . Just) x

it seems to work.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment