{-# LANGUAGE InstanceSigs #-}
module Proton.Loop where

import Data.Profunctor
import Data.Profunctor.Traversing
import Proton.Types
import Data.Profunctor.Choice

-- Cochoice represents iteration/looping

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

-- loop' :: forall p s t a b. (Cochoice p, Traversing p)
--      => (s -> a) -> (b -> Either a t) -> Optic p s t a b
-- loop' inject step = unright . dimap (either id inject) step


-- iterM :: forall s t a b . Optic (Star ((,) [a])) s t a b -> (a -> Either a b) -> s -> ([a], t)
-- iterM o f s = g s
--   where
--     Star (g :: s -> ([a], t)) = (o . unright . lmap (either id id)) $ Star (wrapper . f)
--     wrapper :: Either a b -> ([a], Either a b)
--     wrapper (Left a) = ([a], Left a)
--     wrapper (Right b) = ([], Right b)

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)


-- iter :: forall f p s t a b. (Alternative f,  Cochoice p)
--      => Optic p s t a b
-- iter = _