{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

module Saturation where

import Control.Monad.Writer (Writer, runWriter, tell)
import Data.Monoid (Any(..))

import DebugPrint

-- Tool box for iteration

type Change = Writer Any

dirty :: Change ()
dirty :: Change ()
dirty = Any -> Change ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Any -> Change ()) -> Any -> Change ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True

-- | Iterate until no change.

saturate :: (a -> Change a) -> a -> a
saturate :: forall a. (a -> Change a) -> a -> a
saturate a -> Change a
f = a -> a
loop
  where
  loop :: a -> a
loop a
x = case Change a -> (a, Any)
forall w a. Writer w a -> (a, w)
runWriter (Change a -> (a, Any)) -> Change a -> (a, Any)
forall a b. (a -> b) -> a -> b
$ a -> Change a
f a
x of
    (a
y, Any Bool
True)  -> a -> a
loop a
y
    (a
y, Any Bool
False) -> a
y

-- | Iterate forever

iterateChange :: (a -> Change a) -> a -> [Change a]
iterateChange :: forall a. (a -> Change a) -> a -> [Change a]
iterateChange a -> Change a
f a
a = (Change a -> Change a) -> Change a -> [Change a]
forall a. (a -> a) -> a -> [a]
iterate (a -> Change a
f (a -> Change a) -> (Change a -> a) -> Change a -> Change a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Any) -> a
forall a b. (a, b) -> a
fst ((a, Any) -> a) -> (Change a -> (a, Any)) -> Change a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Change a -> (a, Any)
forall w a. Writer w a -> (a, w)
runWriter) (Change ()
dirty Change () -> Change a -> Change a
forall a b.
WriterT Any Identity a
-> WriterT Any Identity b -> WriterT Any Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Change a
forall a. a -> WriterT Any Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a)

-- * Printing

instance DebugPrint a => DebugPrint (Change a) where
  debugPrint :: Change a -> String
debugPrint Change a
w = case Change a -> (a, Any)
forall w a. Writer w a -> (a, w)
runWriter Change a
w of
    (a
a, Any Bool
b) -> [String] -> String
unwords [ if Bool
b then String
"(dirty)" else String
"(clean)", a -> String
forall a. DebugPrint a => a -> String
debugPrint a
a ]