{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
module Fresnel.Optional
( -- * Optionals
  Optional
, Optional'
, IsOptional
  -- * Construction
, optional
, optional'
  -- * Elimination
, matching
, matching'
, withOptional
, traverseOf
, is
, isn't
  -- * Unpacked
, UnpackedOptional(..)
, unpackedOptional
) where

import Data.Bifunctor
import Data.Maybe (isJust, isNothing)
import Data.Profunctor
import Fresnel.Iso.Internal (IsIso)
import Fresnel.Lens.Internal (IsLens)
import Fresnel.Optic
import Fresnel.Optional.Internal (IsOptional)
import Fresnel.Prism.Internal (IsPrism)
import Fresnel.Profunctor.OptionalStar

-- Optional traversals

type Optional s t a b = forall p . IsOptional p => Optic p s t a b

type Optional' s a = Optional s s a a


-- Construction

optional :: (s -> Either t a) -> (s -> b -> t) -> Optional s t a b
optional :: forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> Optional s t a b
optional s -> Either t a
prj s -> b -> t
set = (s -> (Either t a, b -> t))
-> ((Either t b, b -> t) -> t)
-> p (Either t a, b -> t) (Either t b, b -> t)
-> p s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap
  (\ s
s -> (s -> Either t a
prj s
s, s -> b -> t
set s
s))
  (\ (Either t b
e, b -> t
f) -> (t -> t) -> (b -> t) -> Either t b -> t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either t -> t
forall a. a -> a
id b -> t
f Either t b
e)
  (p (Either t a, b -> t) (Either t b, b -> t) -> p s t)
-> (p a b -> p (Either t a, b -> t) (Either t b, b -> t))
-> p a b
-> p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Either t a) (Either t b)
-> p (Either t a, b -> t) (Either t b, b -> t)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' (p (Either t a) (Either t b)
 -> p (Either t a, b -> t) (Either t b, b -> t))
-> (p a b -> p (Either t a) (Either t b))
-> p a b
-> p (Either t a, b -> t) (Either t b, b -> t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Either t a) (Either t b)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'

optional' :: (s -> Maybe a) -> (s -> b -> s) -> Optional s s a b
optional' :: forall s a b. (s -> Maybe a) -> (s -> b -> s) -> Optional s s a b
optional' s -> Maybe a
prj = (s -> Either s a) -> (s -> b -> s) -> Optional s s a b
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> Optional s t a b
optional (\ s
s -> Either s a -> (a -> Either s a) -> Maybe a -> Either s a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (s -> Either s a
forall a b. a -> Either a b
Left s
s) a -> Either s a
forall a b. b -> Either a b
Right (s -> Maybe a
prj s
s))


-- Elimination

matching :: Optional s t a b -> (s -> Either t a)
matching :: forall s t a b. Optional s t a b -> s -> Either t a
matching Optional s t a b
o = Optional s t a b
-> ((s -> Either t a) -> (s -> b -> t) -> s -> Either t a)
-> s
-> Either t a
forall s t a b r.
Optional s t a b -> ((s -> Either t a) -> (s -> b -> t) -> r) -> r
withOptional Optional s t a b
o (s -> Either t a) -> (s -> b -> t) -> s -> Either t a
forall a b. a -> b -> a
const

matching' :: Optional s t a b -> (s -> Maybe a)
matching' :: forall s t a b. Optional s t a b -> s -> Maybe a
matching' Optional s t a b
o = Optional s t a b
-> ((s -> Either t a) -> (s -> b -> t) -> s -> Maybe a)
-> s
-> Maybe a
forall s t a b r.
Optional s t a b -> ((s -> Either t a) -> (s -> b -> t) -> r) -> r
withOptional Optional s t a b
o (\ s -> Either t a
prj s -> b -> t
_ -> (t -> Maybe a) -> (a -> Maybe a) -> Either t a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> t -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either t a -> Maybe a) -> (s -> Either t a) -> s -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Either t a
prj)

withOptional :: Optional s t a b -> (((s -> Either t a) -> (s -> b -> t) -> r) -> r)
withOptional :: forall s t a b r.
Optional s t a b -> ((s -> Either t a) -> (s -> b -> t) -> r) -> r
withOptional Optional s t a b
o = UnpackedOptional a b s t
-> forall r. ((s -> Either t a) -> (s -> b -> t) -> r) -> r
forall a b s t.
UnpackedOptional a b s t
-> forall r. ((s -> Either t a) -> (s -> b -> t) -> r) -> r
withUnpackedOptional (Optic (UnpackedOptional a b) s t a b
Optional s t a b
o ((a -> Either b a) -> (a -> b -> b) -> UnpackedOptional a b a b
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> UnpackedOptional a b s t
unpackedOptional a -> Either b a
forall a b. b -> Either a b
Right ((b -> b) -> a -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
id)))

traverseOf :: Functor f => Optional s t a b -> (forall r . r -> f r) -> (a -> f b) -> (s -> f t)
traverseOf :: forall (f :: * -> *) s t a b.
Functor f =>
Optional s t a b -> (forall r. r -> f r) -> (a -> f b) -> s -> f t
traverseOf Optional s t a b
o forall r. r -> f r
point = OptionalStar f s t -> s -> f t
forall (f :: * -> *) a b. OptionalStar f a b -> a -> f b
runOptionalStar (OptionalStar f s t -> s -> f t)
-> ((a -> f b) -> OptionalStar f s t) -> (a -> f b) -> s -> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic (OptionalStar f) s t a b
Optional s t a b
o Optic (OptionalStar f) s t a b
-> ((a -> f b) -> OptionalStar f a b)
-> (a -> f b)
-> OptionalStar f s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall r. r -> f r) -> (a -> f b) -> OptionalStar f a b
forall (f :: * -> *) a b.
(forall x. x -> f x) -> (a -> f b) -> OptionalStar f a b
optionalStar forall r. r -> f r
point

is :: Optional s t a b -> (s -> Bool)
is :: forall s t a b. Optional s t a b -> s -> Bool
is Optional s t a b
o = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> (s -> Maybe a) -> s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optional s t a b -> s -> Maybe a
forall s t a b. Optional s t a b -> s -> Maybe a
matching' Optional s t a b
o

isn't :: Optional s t a b -> (s -> Bool)
isn't :: forall s t a b. Optional s t a b -> s -> Bool
isn't Optional s t a b
o = Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe a -> Bool) -> (s -> Maybe a) -> s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optional s t a b -> s -> Maybe a
forall s t a b. Optional s t a b -> s -> Maybe a
matching' Optional s t a b
o


-- Unpacked

newtype UnpackedOptional a b s t = UnpackedOptional { forall a b s t.
UnpackedOptional a b s t
-> forall r. ((s -> Either t a) -> (s -> b -> t) -> r) -> r
withUnpackedOptional :: forall r . ((s -> Either t a) -> (s -> b -> t) -> r) -> r }

instance Profunctor (UnpackedOptional a b) where
  dimap :: forall a b c d.
(a -> b)
-> (c -> d) -> UnpackedOptional a b b c -> UnpackedOptional a b a d
dimap a -> b
f c -> d
g (UnpackedOptional forall r. ((b -> Either c a) -> (b -> b -> c) -> r) -> r
r) = ((b -> Either c a) -> (b -> b -> c) -> UnpackedOptional a b a d)
-> UnpackedOptional a b a d
forall r. ((b -> Either c a) -> (b -> b -> c) -> r) -> r
r (((b -> Either c a) -> (b -> b -> c) -> UnpackedOptional a b a d)
 -> UnpackedOptional a b a d)
-> ((b -> Either c a) -> (b -> b -> c) -> UnpackedOptional a b a d)
-> UnpackedOptional a b a d
forall a b. (a -> b) -> a -> b
$ \ b -> Either c a
prj b -> b -> c
set -> (a -> Either d a) -> (a -> b -> d) -> UnpackedOptional a b a d
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> UnpackedOptional a b s t
unpackedOptional ((c -> Either d a) -> (a -> Either d a) -> Either c a -> Either d a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (d -> Either d a
forall a b. a -> Either a b
Left (d -> Either d a) -> (c -> d) -> c -> Either d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) a -> Either d a
forall a b. b -> Either a b
Right (Either c a -> Either d a) -> (a -> Either c a) -> a -> Either d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either c a
prj (b -> Either c a) -> (a -> b) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) ((c -> d) -> (b -> c) -> b -> d
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap c -> d
g ((b -> c) -> b -> d) -> (a -> b -> c) -> a -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> c
set (b -> b -> c) -> (a -> b) -> a -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Strong (UnpackedOptional a b) where
  first' :: forall a b c.
UnpackedOptional a b a b -> UnpackedOptional a b (a, c) (b, c)
first'  (UnpackedOptional forall r. ((a -> Either b a) -> (a -> b -> b) -> r) -> r
r) = ((a -> Either b a)
 -> (a -> b -> b) -> UnpackedOptional a b (a, c) (b, c))
-> UnpackedOptional a b (a, c) (b, c)
forall r. ((a -> Either b a) -> (a -> b -> b) -> r) -> r
r (((a -> Either b a)
  -> (a -> b -> b) -> UnpackedOptional a b (a, c) (b, c))
 -> UnpackedOptional a b (a, c) (b, c))
-> ((a -> Either b a)
    -> (a -> b -> b) -> UnpackedOptional a b (a, c) (b, c))
-> UnpackedOptional a b (a, c) (b, c)
forall a b. (a -> b) -> a -> b
$ \ a -> Either b a
prj a -> b -> b
set -> ((a, c) -> Either (b, c) a)
-> ((a, c) -> b -> (b, c)) -> UnpackedOptional a b (a, c) (b, c)
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> UnpackedOptional a b s t
unpackedOptional (\ (a
a, c
c) -> (b -> (b, c)) -> Either b a -> Either (b, c) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (,c
c) (a -> Either b a
prj a
a)) (\ (a
a, c
c) b
b -> (a -> b -> b
set a
a b
b, c
c))
  second' :: forall a b c.
UnpackedOptional a b a b -> UnpackedOptional a b (c, a) (c, b)
second' (UnpackedOptional forall r. ((a -> Either b a) -> (a -> b -> b) -> r) -> r
r) = ((a -> Either b a)
 -> (a -> b -> b) -> UnpackedOptional a b (c, a) (c, b))
-> UnpackedOptional a b (c, a) (c, b)
forall r. ((a -> Either b a) -> (a -> b -> b) -> r) -> r
r (((a -> Either b a)
  -> (a -> b -> b) -> UnpackedOptional a b (c, a) (c, b))
 -> UnpackedOptional a b (c, a) (c, b))
-> ((a -> Either b a)
    -> (a -> b -> b) -> UnpackedOptional a b (c, a) (c, b))
-> UnpackedOptional a b (c, a) (c, b)
forall a b. (a -> b) -> a -> b
$ \ a -> Either b a
prj a -> b -> b
set -> ((c, a) -> Either (c, b) a)
-> ((c, a) -> b -> (c, b)) -> UnpackedOptional a b (c, a) (c, b)
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> UnpackedOptional a b s t
unpackedOptional (\ (c
c, a
a) -> (b -> (c, b)) -> Either b a -> Either (c, b) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (c
c,) (a -> Either b a
prj a
a)) (\ (c
c, a
a) b
b -> (c
c, a -> b -> b
set a
a b
b))

instance Choice (UnpackedOptional a b) where
  left' :: forall a b c.
UnpackedOptional a b a b
-> UnpackedOptional a b (Either a c) (Either b c)
left' (UnpackedOptional forall r. ((a -> Either b a) -> (a -> b -> b) -> r) -> r
r) = ((a -> Either b a)
 -> (a -> b -> b) -> UnpackedOptional a b (Either a c) (Either b c))
-> UnpackedOptional a b (Either a c) (Either b c)
forall r. ((a -> Either b a) -> (a -> b -> b) -> r) -> r
r (((a -> Either b a)
  -> (a -> b -> b) -> UnpackedOptional a b (Either a c) (Either b c))
 -> UnpackedOptional a b (Either a c) (Either b c))
-> ((a -> Either b a)
    -> (a -> b -> b) -> UnpackedOptional a b (Either a c) (Either b c))
-> UnpackedOptional a b (Either a c) (Either b c)
forall a b. (a -> b) -> a -> b
$ \ a -> Either b a
prj a -> b -> b
set -> (Either a c -> Either (Either b c) a)
-> (Either a c -> b -> Either b c)
-> UnpackedOptional a b (Either a c) (Either b c)
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> UnpackedOptional a b s t
unpackedOptional ((a -> Either (Either b c) a)
-> (c -> Either (Either b c) a)
-> Either a c
-> Either (Either b c) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b -> Either (Either b c) a)
-> (a -> Either (Either b c) a)
-> Either b a
-> Either (Either b c) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (Either b c -> Either (Either b c) a)
-> (b -> Either b c) -> b -> Either (Either b c) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b c
forall a b. a -> Either a b
Left) a -> Either (Either b c) a
forall a b. b -> Either a b
Right (Either b a -> Either (Either b c) a)
-> (a -> Either b a) -> a -> Either (Either b c) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b a
prj) (Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (Either b c -> Either (Either b c) a)
-> (c -> Either b c) -> c -> Either (Either b c) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right)) (\ Either a c
e b
b -> (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (a -> b -> b
`set` b
b) Either a c
e)
  right' :: forall a b c.
UnpackedOptional a b a b
-> UnpackedOptional a b (Either c a) (Either c b)
right' (UnpackedOptional forall r. ((a -> Either b a) -> (a -> b -> b) -> r) -> r
r) = ((a -> Either b a)
 -> (a -> b -> b) -> UnpackedOptional a b (Either c a) (Either c b))
-> UnpackedOptional a b (Either c a) (Either c b)
forall r. ((a -> Either b a) -> (a -> b -> b) -> r) -> r
r (((a -> Either b a)
  -> (a -> b -> b) -> UnpackedOptional a b (Either c a) (Either c b))
 -> UnpackedOptional a b (Either c a) (Either c b))
-> ((a -> Either b a)
    -> (a -> b -> b) -> UnpackedOptional a b (Either c a) (Either c b))
-> UnpackedOptional a b (Either c a) (Either c b)
forall a b. (a -> b) -> a -> b
$ \ a -> Either b a
prj a -> b -> b
set -> (Either c a -> Either (Either c b) a)
-> (Either c a -> b -> Either c b)
-> UnpackedOptional a b (Either c a) (Either c b)
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> UnpackedOptional a b s t
unpackedOptional ((c -> Either (Either c b) a)
-> (a -> Either (Either c b) a)
-> Either c a
-> Either (Either c b) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either c b -> Either (Either c b) a
forall a b. a -> Either a b
Left (Either c b -> Either (Either c b) a)
-> (c -> Either c b) -> c -> Either (Either c b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either c b
forall a b. a -> Either a b
Left) ((b -> Either (Either c b) a)
-> (a -> Either (Either c b) a)
-> Either b a
-> Either (Either c b) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either c b -> Either (Either c b) a
forall a b. a -> Either a b
Left (Either c b -> Either (Either c b) a)
-> (b -> Either c b) -> b -> Either (Either c b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either c b
forall a b. b -> Either a b
Right) a -> Either (Either c b) a
forall a b. b -> Either a b
Right (Either b a -> Either (Either c b) a)
-> (a -> Either b a) -> a -> Either (Either c b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b a
prj)) (\ Either c a
e b
b -> (a -> b) -> Either c a -> Either c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> b
`set` b
b) Either c a
e)

instance IsIso (UnpackedOptional a b)
instance IsLens (UnpackedOptional a b)
instance IsPrism (UnpackedOptional a b)
instance IsOptional (UnpackedOptional a b)


unpackedOptional :: (s -> Either t a) -> (s -> b -> t) -> UnpackedOptional a b s t
unpackedOptional :: forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> UnpackedOptional a b s t
unpackedOptional s -> Either t a
prj s -> b -> t
set = (forall r. ((s -> Either t a) -> (s -> b -> t) -> r) -> r)
-> UnpackedOptional a b s t
forall a b s t.
(forall r. ((s -> Either t a) -> (s -> b -> t) -> r) -> r)
-> UnpackedOptional a b s t
UnpackedOptional (\ (s -> Either t a) -> (s -> b -> t) -> r
k -> (s -> Either t a) -> (s -> b -> t) -> r
k s -> Either t a
prj s -> b -> t
set)