{-# 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

-- factorial :: Int -> Maybe (Int, Product Int)
-- factorial 0 = Nothing
-- factorial n = Just (n - 1, Product 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

-- >>> collatz 3
-- [3,10,5,16,8,4,2]
-- >>> collatz 5
-- [5,16,8,4,2]

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

-- >>> factorial 3
-- Product {getProduct = 6}
-- >>> factorial 6
-- Product {getProduct = 720}

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