{-# 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

-- class Glassy p where
--   glass :: (((s -> a) -> b) -> s -> t) -> p a b -> p s t

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

-- instance Comonad f => Strong (Costar f) where
--   first' (Costar f) = (Costar (extract . extend (\x -> (, snd . extract $ x) $ f (fst <$> x))))



-- instance Comonad f => Glassy (Costar f) where
--   glass glasser (Costar fab) = Costar (\s -> extract $ fmap (glasser (go s)) s)
--     where
--       go fs sToA = fab $ fmap sToA fs

-- instance (Functor f) => Glassy (Costar f) where
--   glass glasser (Costar fab) = Costar (\fs -> flip glasser $ collect go fs)
--     where
--       go :: s -> _ -> b
--       go = undefined
--       go s sToA = fab $ fmap sToA fs


-- type Glass = Glassy p => p a b -> p s t

-- glass :: Comonad w => (((s -> a) -> b) -> s -> t) -> GrateLike w s t a b
-- glass glasser f s = (glasser $ \h -> f (h <$> s)) $ extract s

-- Move this somewhere
-- instance (Comonad w) => Strong (Costar w) where
--   first' :: forall a b c. Costar w a b -> Costar w (a, c) (b, c)
--   first' (Costar f) = Costar go
--     where
--       go :: (w (a, c) -> (b, c))
--       go wac = extract $ extendThrough (lensGlass _1) f wac