Kiana Sheibani
69870ff394
Most of these functions are taken from `fresnel`, but I intend to implement more convenient utilities from `lens`.
81 lines
2.4 KiB
Idris
81 lines
2.4 KiB
Idris
module Control.Lens.Optional
|
|
|
|
import Data.Profunctor
|
|
import Control.Lens.Optic
|
|
import Control.Lens.Lens
|
|
import Control.Lens.Prism
|
|
|
|
%default total
|
|
|
|
public export
|
|
record IsOptional p where
|
|
constructor MkIsOptional
|
|
runIsOptional : (Strong p, Choice p)
|
|
|
|
export %hint
|
|
optionalToLens : IsOptional p => IsLens p
|
|
optionalToLens @{MkIsOptional _} = MkIsLens %search
|
|
|
|
export %hint
|
|
optionalToPrism : IsOptional p => IsPrism p
|
|
optionalToPrism @{MkIsOptional _} = MkIsPrism %search
|
|
|
|
|
|
public export
|
|
0 Optional : (s,t,a,b : Type) -> Type
|
|
Optional = Optic IsOptional
|
|
|
|
public export
|
|
0 Optional' : (s,a : Type) -> Type
|
|
Optional' s a = Optional s s a a
|
|
|
|
|
|
public export
|
|
optional : (s -> Either t a) -> (s -> b -> t) -> Optional s t a b
|
|
optional prj set @{MkIsOptional _} = dimap @{fromStrong}
|
|
(\s => (prj s, set s))
|
|
(\(e, f) => either id f e)
|
|
. first . right
|
|
where
|
|
-- arbitrary choice of where to pull profunctor instance from
|
|
fromStrong : Strong p => Profunctor p
|
|
fromStrong = %search
|
|
|
|
public export
|
|
optional' : (s -> Maybe a) -> (s -> b -> s) -> Optional s s a b
|
|
optional' prj = optional (\x => maybe (Left x) Right (prj x))
|
|
|
|
|
|
public export
|
|
getOptional : Optional s t a b -> (s -> Either t a, s -> b -> t)
|
|
getOptional l = l @{MkIsOptional (strong,choice)} (Right, const id)
|
|
where
|
|
Profunctor (\x,y => (x -> Either y a, x -> b -> y)) where
|
|
dimap f g (prj, set) = (either (Left . g) Right . prj . f, (g .) . set . f)
|
|
|
|
[strong] GenStrong Pair (\x,y => (x -> Either y a, x -> b -> y)) where
|
|
strongl (prj, set) = (\(a,c) => mapFst (,c) (prj a), \(a,c),b => (set a b, c))
|
|
strongr (prj, set) = (\(c,a) => mapFst (c,) (prj a), \(c,a),b => (c, set a b))
|
|
|
|
[choice] GenStrong Either (\x,y => (x -> Either y a, x -> b -> y)) where
|
|
strongl (prj, set) = (either (either (Left . Left) Right . prj) (Left . Right),
|
|
\e,b => mapFst (`set` b) e)
|
|
strongr (prj, set) = (either (Left . Left) (either (Left . Right) Right . prj),
|
|
\e,b => mapSnd (`set` b) e)
|
|
|
|
public export
|
|
withOptional : Optional s t a b -> ((s -> Either t a) -> (s -> b -> t) -> r) -> r
|
|
withOptional l f = uncurry f (getOptional l)
|
|
|
|
|
|
public export
|
|
ignored : Optional s s a b
|
|
ignored @{MkIsOptional _} = dimap @{fromStrong}
|
|
(\x => (Left x, const x))
|
|
(\(e, f) => either id (the (b -> s) f) e)
|
|
. first . right
|
|
where
|
|
-- arbitrary choice of where to pull profunctor instance from
|
|
fromStrong : Strong p => Profunctor p
|
|
fromStrong = %search
|