{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ConstraintKinds #-}
module Proton.Glass where
import Data.Profunctor
import Control.Comonad
import Proton.Types
import Proton.Internal.Orphans
import Proton.Lens
import Proton.Setter
import Proton.Getter
type Glass s t a b = forall p. (Strong p, Closed p) => Optic p s t a b
type Glass' s a = Glass s s a a
type Glassed p = (Strong p, Closed p)
glassed :: (Strong p, Closed p) => p a b -> p (s, u -> a) (s, u -> b)
glassed :: p a b -> p (s, u -> a) (s, u -> b)
glassed = p (u -> a) (u -> b) -> p (s, u -> a) (s, u -> b)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second' (p (u -> a) (u -> b) -> p (s, u -> a) (s, u -> b))
-> (p a b -> p (u -> a) (u -> b))
-> p a b
-> p (s, u -> a) (s, u -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (u -> a) (u -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed
glass :: forall p s t a b. Glassed p => (((s -> a) -> b) -> s -> t) -> p a b -> p s t
glass :: (((s -> a) -> b) -> s -> t) -> p a b -> p s t
glass glasser :: ((s -> a) -> b) -> s -> t
glasser p :: p a b
p = (s -> (s, (s -> a) -> a))
-> ((s, (s -> a) -> b) -> t)
-> p (s, (s -> a) -> a) (s, (s -> a) -> b)
-> 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 -> a) -> a)
l (s, (s -> a) -> b) -> t
r (p (s, (s -> a) -> a) (s, (s -> a) -> b) -> p s t)
-> p (s, (s -> a) -> a) (s, (s -> a) -> b) -> p s t
forall a b. (a -> b) -> a -> b
$ p a b -> p (s, (s -> a) -> a) (s, (s -> a) -> b)
forall (p :: * -> * -> *) a b s u.
(Strong p, Closed p) =>
p a b -> p (s, u -> a) (s, u -> b)
glassed p a b
p
where
l :: s -> (s, (s -> a) -> a)
l :: s -> (s, (s -> a) -> a)
l s :: s
s = (s
s, ((s -> a) -> s -> a
forall a b. (a -> b) -> a -> b
$ s
s))
r :: (s, (s -> a) -> b) -> t
r :: (s, (s -> a) -> b) -> t
r (s :: s
s, f :: (s -> a) -> b
f) = ((s -> a) -> b) -> s -> t
glasser (s -> a) -> b
f s
s
glassList :: forall a b. Glass [a] [b] a b
glassList :: Optic p [a] [b] a b
glassList = ((([a] -> a) -> b) -> [a] -> [b]) -> Optic p [a] [b] a b
forall (p :: * -> * -> *) s t a b.
Glassed p =>
(((s -> a) -> b) -> s -> t) -> p a b -> p s t
glass (([a] -> a) -> b) -> [a] -> [b]
go
where
go :: (([a] -> a) -> b) -> [a] -> [b]
go :: (([a] -> a) -> b) -> [a] -> [b]
go f :: ([a] -> a) -> b
f s :: [a]
s = [b]
forall a. HasCallStack => a
undefined
extendOf :: (Comonad w) => Optic (Costar w) s t a b -> (w a -> b) -> w s -> w t
extendOf :: Optic (Costar w) s t a b -> (w a -> b) -> w s -> w t
extendOf gr :: Optic (Costar w) s t a b
gr f :: w a -> b
f = (w s -> t) -> w s -> w t
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (Costar w s t -> w s -> t
forall (f :: * -> *) d c. Costar f d c -> f d -> c
runCostar (Costar w s t -> w s -> t) -> Costar w s t -> w s -> t
forall a b. (a -> b) -> a -> b
$ Optic (Costar w) s t a b
gr ((w a -> b) -> Costar w a b
forall (f :: * -> *) d c. (f d -> c) -> Costar f d c
Costar w a -> b
f))
traversed' :: forall f a b. Traversable f => Glass (f a) (f b) a b
traversed' :: Glass (f a) (f b) a b
traversed' = (((f a -> a) -> b) -> f a -> f b) -> p a b -> p (f a) (f b)
forall (p :: * -> * -> *) s t a b.
Glassed p =>
(((s -> a) -> b) -> s -> t) -> p a b -> p s t
glass ((f a -> a) -> b) -> f a -> f b
go
where
go :: ((f a -> a) -> b) -> f a -> f b
go :: ((f a -> a) -> b) -> f a -> f b
go f :: (f a -> a) -> b
f fa :: f a
fa = f b
forall a. HasCallStack => a
undefined