@@ -15,15 +15,15 @@ newtype DeclareT d m a = DeclareT { runDeclareT :: d -> m (d, a) }
15instance (Monad m, Monoid d) => Applicative (DeclareT d m) where
15instance (Monad m, Monoid d) => Applicative (DeclareT d m) where
16 pure x = DeclareT (\_ -> pure (mempty, x))
16 pure x = DeclareT (\_ -> pure (mempty, x))
17 DeclareT df <*> DeclareT dx = DeclareT $ \d -> do
17 DeclareT df <*> DeclareT dx = DeclareT $ \d -> do
18− (d', f) <- df d
18+ ~(d', f) <- df d
19− (d'', x) <- dx (d <> d')
19+ ~(d'', x) <- dx (d <> d')
20 return (d' <> d'', f x)
20 return (d' <> d'', f x)
22instance (Monad m, Monoid d) => Monad (DeclareT d m) where
22instance (Monad m, Monoid d) => Monad (DeclareT d m) where
23 return x = DeclareT (\_ -> pure (mempty, x))
23 return x = DeclareT (\_ -> pure (mempty, x))
24 DeclareT dx >>= f = DeclareT $ \d -> do
24 DeclareT dx >>= f = DeclareT $ \d -> do
25− (d', x) <- dx d
25+ ~(d', x) <- dx d
26− (d'', y) <- runDeclareT (f x) (d <> d')
26+ ~(d'', y) <- runDeclareT (f x) (d <> d')
27 return (d' <> d'', y)
27 return (d' <> d'', y)
29instance Monoid d => MonadTrans (DeclareT d) where
29instance Monoid d => MonadTrans (DeclareT d) where
@@ -46,6 +46,9 @@ evalDeclareT (DeclareT f) d = snd `liftM` f d
46execDeclareT :: Monad m => DeclareT d m a -> d -> m d
46execDeclareT :: Monad m => DeclareT d m a -> d -> m d
47execDeclareT (DeclareT f) d = fst `liftM` f d
47execDeclareT (DeclareT f) d = fst `liftM` f d
49+undeclareT :: (Monad m, Monoid d) => DeclareT d m a -> m a
50+undeclareT = flip evalDeclareT mempty
49type Declare d = DeclareT d Identity
52type Declare d = DeclareT d Identity
51runDeclare :: Declare d a -> d -> (d, a)
54runDeclare :: Declare d a -> d -> (d, a)
@@ -57,3 +60,6 @@ evalDeclare m = runIdentity . evalDeclareT m
57execDeclare :: Declare d a -> d -> d
60execDeclare :: Declare d a -> d -> d
58execDeclare m = runIdentity . execDeclareT m
61execDeclare m = runIdentity . execDeclareT m
63+undeclare :: Monoid d => Declare d a -> a
64+undeclare = runIdentity . undeclareT