{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Examples.Loop where
import Proton.Loop
import Proton
import Data.Profunctor
import Data.Monoid
thing :: Loop' Int Int
thing :: p Int Int -> p Int Int
thing = (Int -> Int) -> (Int -> Either Int Int) -> p Int Int -> p Int Int
forall (p :: * -> * -> *) s t a b.
Cochoice p =>
(s -> a) -> (b -> Either a t) -> Optic p s t a b
loop Int -> Int
forall a. a -> a
id Int -> Either Int Int
forall a b. (Eq a, Num a, Num b) => a -> Either a b
step
where
step :: a -> Either a b
step 0 = b -> Either a b
forall a b. b -> Either a b
Right 0
step n :: a
n = a -> Either a b
forall a b. a -> Either a b
Left a
n
collatz :: Int -> [Int]
collatz :: Int -> [Int]
collatz n :: Int
n = Int
n Int -> (Int -> [Int]) -> [Int]
forall a b. a -> (a -> b) -> b
& (Int -> Bool) -> (Int -> [Int]) -> Optic (->) Int [Int] Int Int
forall state (p :: * -> * -> *) t.
(Monoid state, Strong p, Cochoice p) =>
(t -> Bool) -> (t -> state) -> Optic p t state t t
while (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1) (Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[]) Optic (->) Int [Int] Int Int -> Optic (->) Int [Int] Int Int
forall s t a b. Setter s t a b -> Setter s t a b
%~ Int -> Int
forall a. Integral a => a -> a
step
where
step :: a -> a
step x :: a
x
| a -> Bool
forall a. Integral a => a -> Bool
even a
x = a
x a -> a -> a
forall a. Integral a => a -> a -> a
`div` 2
| Bool
otherwise = (3 a -> a -> a
forall a. Num a => a -> a -> a
* a
x) a -> a -> a
forall a. Num a => a -> a -> a
+ 1
factorial :: Int -> Product Int
factorial :: Int -> Product Int
factorial n :: Int
n = Int
n Int -> (Int -> Product Int) -> Product Int
forall a b. a -> (a -> b) -> b
& (Int -> Bool)
-> (Int -> Product Int) -> Optic (->) Int (Product Int) Int Int
forall state (p :: * -> * -> *) t.
(Monoid state, Strong p, Cochoice p) =>
(t -> Bool) -> (t -> state) -> Optic p t state t t
while (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) Int -> Product Int
forall a. a -> Product a
Product Optic (->) Int (Product Int) Int Int
-> Optic (->) Int (Product Int) Int Int
forall s t a b. Setter s t a b -> Setter s t a b
%~ Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract 1
accum :: forall p next state. (Monoid state, Strong p, Cochoice p)
=> (next -> Maybe (next, state)) -> Optic p next state next next
accum :: (next -> Maybe (next, state)) -> Optic p next state next next
accum check :: next -> Maybe (next, state)
check = (next -> (next, state))
-> ((next, state) -> Either (next, state) state)
-> Optic p next state (next, state) (next, state)
forall (p :: * -> * -> *) s t a b.
Cochoice p =>
(s -> a) -> (b -> Either a t) -> Optic p s t a b
loop next -> (next, state)
initialize (next, state) -> Either (next, state) state
step Optic p next state (next, state) (next, state)
-> (p next next -> p (next, state) (next, state))
-> Optic p next state next next
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p next next -> p (next, state) (next, state)
forall a x b. Lens (a, x) (b, x) a b
_1
where
initialize :: next -> (next, state)
initialize n :: next
n = case next -> Maybe (next, state)
check next
n of
Nothing -> (next
n, state
forall a. Monoid a => a
mempty)
Just (_, s :: state
s) -> (next
n, state
s)
step :: (next, state) -> Either (next, state) state
step :: (next, state) -> Either (next, state) state
step (n :: next
n, s :: state
s) =
case next -> Maybe (next, state)
check next
n of
Nothing -> state -> Either (next, state) state
forall a b. b -> Either a b
Right state
s
Just (n' :: next
n', s' :: state
s') -> (next, state) -> Either (next, state) state
forall a b. a -> Either a b
Left (next
n', state
s state -> state -> state
forall a. Semigroup a => a -> a -> a
<> state
s')
while :: (Monoid state, Strong p, Cochoice p)
=> (t -> Bool)
-> (t -> state)
-> Optic p t state t t
while :: (t -> Bool) -> (t -> state) -> Optic p t state t t
while continue :: t -> Bool
continue inj :: t -> state
inj = (t -> Maybe (t, state)) -> Optic p t state t t
forall (p :: * -> * -> *) next state.
(Monoid state, Strong p, Cochoice p) =>
(next -> Maybe (next, state)) -> Optic p next state next next
accum ((t -> Maybe (t, state)) -> Optic p t state t t)
-> (t -> Maybe (t, state)) -> Optic p t state t t
forall a b. (a -> b) -> a -> b
$ \x :: t
x -> if t -> Bool
continue t
x
then (t, state) -> Maybe (t, state)
forall a. a -> Maybe a
Just (t
x, t -> state
inj t
x)
else Maybe (t, state)
forall a. Maybe a
Nothing