{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Proton.Coindexed where

import Data.Profunctor
import Data.Profunctor.Traversing
import Data.Profunctor.Coindexed
import Proton.Types
import Proton.Setter
import Proton.Prisms
import Proton.Fold
import Data.Monoid


-- coindexing :: (Coindexable i p q) => (s -> i) -> p s t -> q s t
-- coindexing f p = lmap (f &&& id) $ coindexed p

-- itraversed :: (Coindexable Int p q, Traversing q) => p a b -> q [a] [b]
-- vFirst :: CoindexedOptic String p [a] [b] a b
-- vFirst p = _ $ coindexed p

vView :: CoindexedOptic e (Forget (Either e a)) s t a b -> s -> Either e a
vView :: CoindexedOptic e (Forget (Either e a)) s t a b -> s -> Either e a
vView lns :: CoindexedOptic e (Forget (Either e a)) s t a b
lns = Forget (Either e a) s (Either e t) -> s -> Either e a
forall r a b. Forget r a b -> a -> r
runForget (Forget (Either e a) s (Either e t) -> s -> Either e a)
-> (Coindexed e (Forget (Either e a)) s t
    -> Forget (Either e a) s (Either e t))
-> Coindexed e (Forget (Either e a)) s t
-> s
-> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coindexed e (Forget (Either e a)) s t
-> Forget (Either e a) s (Either e t)
forall e (p :: * -> * -> *) a b.
Coindexed e p a b -> p a (Either e b)
runCoindexed (Coindexed e (Forget (Either e a)) s t -> s -> Either e a)
-> Coindexed e (Forget (Either e a)) s t -> s -> Either e a
forall a b. (a -> b) -> a -> b
$ CoindexedOptic e (Forget (Either e a)) s t a b
lns ((a -> Either e a) -> Forget (Either e a) a b
forall r a b. (a -> r) -> Forget r a b
Forget a -> Either e a
forall a b. b -> Either a b
Right)

vPrism :: (Coindexable e p q, Choice p, Choice q) => (t -> e) -> Prism s t a b -> Optical p q s t a b
vPrism :: (t -> e) -> Prism s t a b -> Optical p q s t a b
vPrism f :: t -> e
f pr :: Prism s t a b
pr q :: p a b
q = Prism s t a b -> ((b -> t) -> (s -> Either t a) -> q s t) -> q s t
forall s t a b r.
Prism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism Prism s t a b
pr (((b -> t) -> (s -> Either t a) -> q s t) -> q s t)
-> ((b -> t) -> (s -> Either t a) -> q s t) -> q s t
forall a b. (a -> b) -> a -> b
$ \proj :: b -> t
proj match :: s -> Either t a
match ->
    p s (Either e t) -> q s t
forall e (p :: * -> * -> *) (q :: * -> * -> *) a b.
Coindexable e p q =>
p a (Either e b) -> q a b
coindexed (p s (Either e t) -> q s t)
-> (p (Either t a) (Either t b) -> p s (Either e t))
-> p (Either t a) (Either t b)
-> q s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either t b -> Either e t) -> p s (Either t b) -> p s (Either e t)
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap ((t -> Either e t) -> (b -> Either e t) -> Either t b -> Either e t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> Either e t
forall a b. a -> Either a b
Left (e -> Either e t) -> (t -> e) -> t -> Either e t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> e
f) (t -> Either e t
forall a b. b -> Either a b
Right (t -> Either e t) -> (b -> t) -> b -> Either e t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> t
proj)) (p s (Either t b) -> p s (Either e t))
-> (p (Either t a) (Either t b) -> p s (Either t b))
-> p (Either t a) (Either t b)
-> p s (Either e t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> Either t a)
-> p (Either t a) (Either t b) -> p s (Either t b)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap s -> Either t a
match (p (Either t a) (Either t b) -> q s t)
-> p (Either t a) (Either t b) -> q s t
forall a b. (a -> b) -> a -> b
$ 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' p a b
q

_Just' :: (Choice p, Choice q, Coindexable String p q) => Optical p q (Maybe a) (Maybe b) a b
_Just' :: Optical p q (Maybe a) (Maybe b) a b
_Just' = (Maybe b -> [Char])
-> Prism (Maybe a) (Maybe b) a b
-> Optical p q (Maybe a) (Maybe b) a b
forall e (p :: * -> * -> *) (q :: * -> * -> *) t s a b.
(Coindexable e p q, Choice p, Choice q) =>
(t -> e) -> Prism s t a b -> Optical p q s t a b
vPrism ([Char] -> Maybe b -> [Char]
forall a b. a -> b -> a
const "Expected Just but got Nothing") forall a b. Prism (Maybe a) (Maybe b) a b
Prism (Maybe a) (Maybe b) a b
_Just

-- vToListOf :: CoindexedOptic e (Forget (Either e a)) s t a b -> s -> Either e a
-- vToListOf lns = runForget . runCoindexed $ lns (Forget Right)

coindexing :: forall e p s t a b. Profunctor p =>
    Optic (Coindexed e p) s t a b -> Optic p s (Either e t) a b
coindexing :: Optic (Coindexed e p) s t a b -> Optic p s (Either e t) a b
coindexing o :: Optic (Coindexed e p) s t a b
o p :: p a b
p = Coindexed e p s t -> p s (Either e t)
forall e (p :: * -> * -> *) a b.
Coindexed e p a b -> p a (Either e b)
runCoindexed (Coindexed e p s t -> p s (Either e t))
-> Optic (Coindexed e p) s t a b
-> Coindexed e p a b
-> p s (Either e t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic (Coindexed e p) s t a b
o (Coindexed e p a b -> p s (Either e t))
-> Coindexed e p a b -> p s (Either e t)
forall a b. (a -> b) -> a -> b
$ p a (Either e b) -> Coindexed e p a b
forall e (p :: * -> * -> *) a b.
p a (Either e b) -> Coindexed e p a b
Coindexed ((b -> Either e b) -> p a b -> p a (Either e b)
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap b -> Either e b
forall a b. b -> Either a b
Right p a b
p)

-- itoListOf :: CoindexedOptic e (Forget [a]) s t a b -> s -> [(i, a)]
-- itoListOf fld = _ (fld (Forget pure))

vOver :: Optic (Coindexed e (->)) s t a b -> (a -> b) -> s -> Either e t
vOver :: Optic (Coindexed e (->)) s t a b -> (a -> b) -> s -> Either e t
vOver modifier :: Optic (Coindexed e (->)) s t a b
modifier f :: a -> b
f s :: s
s = ((a -> b) -> s -> Either e t) -> (a -> b) -> s -> Either e t
forall s t a b. Setter s t a b -> Setter s t a b
over (Optic (Coindexed e (->)) s t a b -> (a -> b) -> s -> Either e t
forall e (p :: * -> * -> *) s t a b.
Profunctor p =>
Optic (Coindexed e p) s t a b -> Optic p s (Either e t) a b
coindexing Optic (Coindexed e (->)) s t a b
modifier) a -> b
f s
s

-- vFirst :: forall p a. Choice p => p a a -> Coindexed String p [a] [a]
-- vFirst p = Coindexed (dimap _ _ $ right' p)
--   where
--     -- passThrough :: p (Either [a] (a, [a])) (Either [a] (a, [a]))
--     passThrough = dimap _ _ $ right' p

-- (^??) :: forall e s t a b p q. s -> Optical p q s t a b ->  Either e a
-- (^??) s o = maybe (undefined) Right (s ^? (o @(Forget (First a)) @(Forget (First a))))

vFirst :: forall p a. Traversing p => p a a -> Coindexed String p [a] [a]
vFirst :: p a a -> Coindexed [Char] p [a] [a]
vFirst p :: p a a
p = p [a] (Either [Char] [a]) -> Coindexed [Char] p [a] [a]
forall e (p :: * -> * -> *) a b.
p a (Either e b) -> Coindexed e p a b
Coindexed ((forall (f :: * -> *).
 Applicative f =>
 (a -> f a) -> [a] -> f (Either [Char] [a]))
-> p a a -> p [a] (Either [Char] [a])
forall (p :: * -> * -> *) a b s t.
Traversing p =>
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p a b -> p s t
wander forall (f :: * -> *).
Applicative f =>
(a -> f a) -> [a] -> f (Either [Char] [a])
go p a a
p)
  where
    go :: forall f. Applicative f => (a -> f a) -> [a] -> f (Either String [a])
    go :: (a -> f a) -> [a] -> f (Either [Char] [a])
go _ [] = Either [Char] [a] -> f (Either [Char] [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Either [Char] [a]
forall a b. a -> Either a b
Left "No first element to list")
    go f :: a -> f a
f (x :: a
x : xs :: [a]
xs) = [a] -> Either [Char] [a]
forall a b. b -> Either a b
Right ([a] -> Either [Char] [a]) -> (a -> [a]) -> a -> Either [Char] [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) (a -> Either [Char] [a]) -> f a -> f (Either [Char] [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
x

-- iset :: CoindexedOptic i (->) s t a b -> (i -> b) -> s -> t
-- iset setter f = iover setter (\i _ -> f i)