{-# LANGUAGE InstanceSigs #-}
module Proton.Loop where
import Data.Profunctor
import Data.Profunctor.Traversing
import Proton.Types
import Data.Profunctor.Choice
type Loop s t a b = forall p. Cochoice p => p a b -> p s t
type Loop' s a = Loop s s a a
data CoPrism a b s t = CoPrism (s -> a) (b -> Either a t)
instance Profunctor (CoPrism a b) where
dimap :: (a -> b) -> (c -> d) -> CoPrism a b b c -> CoPrism a b a d
dimap f :: a -> b
f g :: c -> d
g (CoPrism project :: b -> a
project match :: b -> Either a c
match) = (a -> a) -> (b -> Either a d) -> CoPrism a b a d
forall a b s t. (s -> a) -> (b -> Either a t) -> CoPrism a b s t
CoPrism (b -> a
project (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) ((c -> d) -> Either a c -> Either a d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (Either a c -> Either a d) -> (b -> Either a c) -> b -> Either a d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a c
match)
instance Cochoice (CoPrism a b) where
unright :: forall d a' b'. CoPrism a b (Either d a') (Either d b') -> CoPrism a b a' b'
unright :: CoPrism a b (Either d a') (Either d b') -> CoPrism a b a' b'
unright (CoPrism project :: Either d a' -> a
project match :: b -> Either a (Either d b')
match) = (a' -> a) -> (b -> Either a b') -> CoPrism a b a' b'
forall a b s t. (s -> a) -> (b -> Either a t) -> CoPrism a b s t
CoPrism (Either d a' -> a
project (Either d a' -> a) -> (a' -> Either d a') -> a' -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> Either d a'
forall a b. b -> Either a b
Right) (Either a (Either d b') -> Either a b'
go (Either a (Either d b') -> Either a b')
-> (b -> Either a (Either d b')) -> b -> Either a b'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a (Either d b')
match)
where
go :: Either a (Either d b') -> Either a b'
go :: Either a (Either d b') -> Either a b'
go (Left a :: a
a) = a -> Either a b'
forall a b. a -> Either a b
Left a
a
go (Right (Right b :: b'
b)) = b' -> Either a b'
forall a b. b -> Either a b
Right b'
b
go (Right (Left d :: d
d)) = a -> Either a b'
forall a b. a -> Either a b
Left (Either d a' -> a
project (Either d a' -> a) -> Either d a' -> a
forall a b. (a -> b) -> a -> b
$ d -> Either d a'
forall a b. a -> Either a b
Left d
d)
loop :: forall p s t a b. Cochoice p
=> (s -> a) -> (b -> Either a t) -> Optic p s t a b
loop :: (s -> a) -> (b -> Either a t) -> Optic p s t a b
loop inject :: s -> a
inject step :: b -> Either a t
step = p (Either a s) (Either a t) -> p s t
forall (p :: * -> * -> *) d a b.
Cochoice p =>
p (Either d a) (Either d b) -> p a b
unright (p (Either a s) (Either a t) -> p s t)
-> (p a b -> p (Either a s) (Either a t)) -> Optic p s t a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a s -> a)
-> (b -> Either a t) -> p a b -> p (Either a s) (Either a t)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ((a -> a) -> (s -> a) -> Either a s -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id s -> a
inject) b -> Either a t
step
iterM :: forall s t a . Optic (Star ((,) [a])) s t a a -> (a -> Either a a) -> s -> ([a], t)
iterM :: Optic (Star ((,) [a])) s t a a
-> (a -> Either a a) -> s -> ([a], t)
iterM o :: Optic (Star ((,) [a])) s t a a
o f :: a -> Either a a
f s :: s
s = s -> ([a], t)
g s
s
where
Star (s -> ([a], t)
g :: s -> ([a], t)) = Optic (Star ((,) [a])) s t a a
o Optic (Star ((,) [a])) s t a a
-> (Star ((,) [a]) a (Either a a) -> Star ((,) [a]) a a)
-> Star ((,) [a]) a (Either a a)
-> Star ((,) [a]) s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Star ((,) [a]) (Either a a) (Either a a) -> Star ((,) [a]) a a
forall (p :: * -> * -> *) d a b.
Cochoice p =>
p (Either d a) (Either d b) -> p a b
unright (Star ((,) [a]) (Either a a) (Either a a) -> Star ((,) [a]) a a)
-> (Star ((,) [a]) a (Either a a)
-> Star ((,) [a]) (Either a a) (Either a a))
-> Star ((,) [a]) a (Either a a)
-> Star ((,) [a]) a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a a -> a)
-> Star ((,) [a]) a (Either a a)
-> Star ((,) [a]) (Either a a) (Either a a)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap ((a -> a) -> (a -> a) -> Either a a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id) (Star ((,) [a]) a (Either a a) -> Star ((,) [a]) s t)
-> Star ((,) [a]) a (Either a a) -> Star ((,) [a]) s t
forall a b. (a -> b) -> a -> b
$ (a -> ([a], Either a a)) -> Star ((,) [a]) a (Either a a)
forall (f :: * -> *) d c. (d -> f c) -> Star f d c
Star (Either a a -> ([a], Either a a)
wrapper (Either a a -> ([a], Either a a))
-> (a -> Either a a) -> a -> ([a], Either a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a a
f)
wrapper :: Either a a -> ([a], Either a a)
wrapper :: Either a a -> ([a], Either a a)
wrapper (Left a :: a
a) = ([a
a], a -> Either a a
forall a b. a -> Either a b
Left a
a)
wrapper (Right b :: a
b) = ([a
b], a -> Either a a
forall a b. b -> Either a b
Right a
b)
tester :: Int -> Either Int Int
tester :: Int -> Either Int Int
tester a :: Int
a
| Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10 = Int -> Either Int Int
forall a b. a -> Either a b
Left (Int -> Int
forall a. Enum a => a -> a
succ Int
a)
| Bool
otherwise = Int -> Either Int Int
forall a b. b -> Either a b
Right (Int -> Int
forall a. Enum a => a -> a
succ Int
a)