{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Proton.Annotated where
import Data.Profunctor
import Data.Profunctor.Traversing
import Data.Profunctor.Coindexed
import Proton.Types
import Proton.Setter
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)
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)
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. Traversing p => p a a -> Coindexed String p [a] [a]
vFirst :: p a a -> Coindexed String p [a] [a]
vFirst p :: p a a
p = p [a] (Either String [a]) -> Coindexed String 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 String [a]))
-> p a a -> p [a] (Either String [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 String [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 String [a])
go _ [] = Either String [a] -> f (Either String [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String [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 String [a]
forall a b. b -> Either a b
Right ([a] -> Either String [a]) -> (a -> [a]) -> a -> Either String [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) (a -> Either String [a]) -> f a -> f (Either String [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
x