Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    text
    copied!<p>Not sure if this is exactly what you want, but here is an implementation that enforces the correct number of steps and requires there to be zero steps left at the end. For simplicity, I'm using a monad instead of a monad transformer over IO. Note that I am not using the Prelude monad to do what I'm doing.</p> <p><strong>UPDATE</strong>:</p> <p>Now can extract the number of remaining steps. Run the following with -XRebindableSyntax</p> <pre><code>{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} module Test where import Prelude hiding (Monad(..)) import qualified Prelude as Old (Monad(..)) ----------------------------------------------------------- data Z = Z data S n = S type Zero = Z type One = S Zero type Two = S One type Three = S Two type Four = S Three ----------------------------------------------------------- class Peano n where peano :: n fromPeano :: n -&gt; Integer instance Peano Z where peano = Z fromPeano Z = 0 instance Peano (S Z) where peano = S fromPeano S = 1 instance Peano (S n) =&gt; Peano (S (S n)) where peano = S fromPeano s = n `seq` (n + 1) where prev :: S (S n) -&gt; (S n) prev S = S n = fromPeano $ prev s ----------------------------------------------------------- class (Peano s, Peano p) =&gt; Succ s p | s -&gt; p where instance Succ (S Z) Z where instance Succ (S n) n =&gt; Succ (S (S n)) (S n) where ----------------------------------------------------------- infixl 1 &gt;&gt;=, &gt;&gt; class ParameterisedMonad m where return :: a -&gt; m s s a (&gt;&gt;=) :: m s1 s2 t -&gt; (t -&gt; m s2 s3 a) -&gt; m s1 s3 a fail :: String -&gt; m s1 s2 a fail = error (&gt;&gt;) :: ParameterisedMonad m =&gt; m s1 s2 t -&gt; m s2 s3 a -&gt; m s1 s3 a x &gt;&gt; f = x &gt;&gt;= \_ -&gt; f ----------------------------------------------------------- newtype PIO p q a = PIO { runPIO :: IO a } instance ParameterisedMonad PIO where return = PIO . Old.return PIO io &gt;&gt;= f = PIO $ (Old.&gt;&gt;=) io $ runPIO . f ----------------------------------------------------------- data Progress p n a = Progress a instance ParameterisedMonad Progress where return = Progress Progress x &gt;&gt;= f = let Progress y = f x in Progress y runProgress :: Peano n =&gt; n -&gt; Progress n Zero a -&gt; a runProgress _ (Progress x) = x runProgress' :: Progress p Zero a -&gt; a runProgress' (Progress x) = x task :: Peano n =&gt; n -&gt; Progress n n () task _ = return () task' :: Peano n =&gt; Progress n n () task' = task peano step :: Succ s n =&gt; Progress s n () step = Progress () stepsLeft :: Peano s2 =&gt; Progress s1 s2 a -&gt; (a -&gt; Integer -&gt; Progress s2 s3 b) -&gt; Progress s1 s3 b stepsLeft prog f = prog &gt;&gt;= flip f (fromPeano $ getPeano prog) where getPeano :: Peano n =&gt; Progress s n a -&gt; n getPeano prog = peano procedure1 :: Progress Three Zero String procedure1 = do task' step task (peano :: Two) -- any other Peano is a type error --step -- uncommenting this is a type error step -- commenting this is a type error step return "hello" procedure2 :: (Succ two one, Succ one zero) =&gt; Progress two zero Integer procedure2 = do task' step `stepsLeft` \_ n -&gt; do step return n main :: IO () main = runPIO $ do PIO $ putStrLn $ runProgress' procedure1 PIO $ print $ runProgress (peano :: Four) $ do n &lt;- procedure2 n' &lt;- procedure2 return (n, n') </code></pre>
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload