perm 0.3.0.1 → 0.4.0.0

raw patch · 8 files changed

+327/−337 lines, 8 filesdep +HUnitdep +permdep +test-frameworkdep ~basedep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, perm, test-framework, test-framework-hunit

Dependency ranges changed: base, mtl

API changes (from Hackage documentation)

Files

• Control/Applicative/Perm.hs +11/−4
• Control/Monad/Perm.hs +13/−6
• Control/Monad/Perm/Base.hs +0/−230
• Control/Monad/Perm/Dict.hs +0/−27
• Control/Monad/Perm/Internal.hs +242/−0
• Control/Monad/Perm/Option.hs +0/−66
• perm.cabal +16/−4
• tests/RedditTests.hs +45/−0

@@ -9,10 +9,17 @@        ( Perm        , runPerm        , liftPerm+       , liftPlus        , hoistPerm        ) where -import Control.Monad.Perm.Base (Perm,-                                runPerm,-                                liftPerm,-                                hoistPerm)+import Control.Applicative+import Control.Monad.Perm.Internal (Perm,+                                    sum1,+                                    liftPerm,+                                    liftPlus,+                                    hoistPerm)++-- | Unwrap a 'Perm', combining actions using the 'Alternative' for @f@.+runPerm :: Alternative m => Perm m a -> m a+runPerm = sum1

@@ -6,13 +6,20 @@ Portability: non-portable -} module Control.Monad.Perm-       ( PermT-       , runPermT+       ( Perm+       , runPerm        , liftPerm+       , liftPlus        , hoistPerm        ) where -import Control.Monad.Perm.Base (PermT,-                                runPermT,-                                liftPerm,-                                hoistPerm)+import Control.Monad+import Control.Monad.Perm.Internal (Perm,+                                    sum1M,+                                    liftPerm,+                                    liftPlus,+                                    hoistPerm)++-- | Unwrap a 'Perm', combining actions using the 'MonadPlus' for @f@.+runPerm :: MonadPlus m => Perm m a -> m a+runPerm = sum1M

@@ -1,230 +0,0 @@-{-# LANGUAGE-    CPP-  , FlexibleInstances-  , GADTs-  , MultiParamTypeClasses-  , Rank2Types-  , UndecidableInstances #-}-{- |-Copyright: Andy Sonnenburg (c) 2012-License: BSD-style (see the file LICENSE)-Maintainer: Andy Sonnenburg <andy22286@gmail.com>-Stability: experimental-Portability: non-portable--}-module Control.Monad.Perm.Base-       ( Perm-       , runPerm-       , PermT-       , runPermT-       , liftPerm-       , hoistPerm-       ) where--import Control.Applicative-import Control.Monad-#if LANGUAGE_DefaultSignatures-import Control.Monad.Catch.Class (MonadThrow)-#else-import Control.Monad.Catch.Class (MonadThrow (throw))-#endif-import Control.Monad.IO.Class (MonadIO (liftIO))-#if MIN_VERSION_mtl(2, 1, 0)-import Control.Monad.Reader.Class (MonadReader (ask, local, reader))-import Control.Monad.State.Class (MonadState (get, put, state))-#else-import Control.Monad.Reader.Class (MonadReader (ask, local))-import Control.Monad.State.Class (MonadState (get, put))-#endif-import Control.Monad.Trans.Class (MonadTrans (lift))--#if MIN_VERSION_base(4, 5, 0)-import Data.Monoid (Monoid (mappend, mempty), (<>))-#else-import Data.Monoid (Monoid (mappend, mempty))-#endif--import Prelude (($), (.), const, flip, id)--import Control.Monad.Perm.Dict-import Control.Monad.Perm.Option--#if !MIN_VERSION_base(4, 5, 0)-(<>) :: Monoid m => m -> m -> m-(<>) = mappend-{-# INLINE (<>) #-}-#endif---- | The permutation applicative-type Perm = PermT---- | The permutation monad-data PermT m a = Choice (Option m a) (Branches m a)--data Branches m a-  = Nil-  | Tip (Branch m a)-  | Bin (PlusDict m) (Branches m a) (Branches m a)--data Branch m b where-  Ap :: Dict m -> PermT m (a -> b) -> m a -> Branch m b-  Bind :: Monad m => (a -> PermT m b) -> m a -> Branch m b---- | Unwrap a 'Perm', combining actions using the 'Alternative' for @f@.-runPerm :: Alternative m => Perm m a -> m a-runPerm = lower-  where-    lower (Choice a xs) = sumB f (option empty a) (<|>) xs-    f (Ap Monad perm m) = flip ($) `liftM` m `ap` runPerm perm-    f (Ap _ perm m) = m <**> runPerm perm-    f (Bind k m) = m >>= runPerm . k---- | Unwrap a 'PermT', combining actions using the 'MonadPlus' for @f@.-runPermT :: MonadPlus m => PermT m a -> m a-runPermT = lower-  where-    lower (Choice a xs) = sumB f (option mzero a) mplus xs-    f (Ap Applicative perm m) = m <**> runPermT perm-    f (Ap _ perm m) = flip ($) `liftM` m `ap` runPermT perm-    f (Bind k m) = m >>= runPermT . k--sumB :: (Branch m a -> m a) -> m a -> (m a -> m a -> m a) -> Branches m a -> m a-sumB f zero plus = go-  where-    go Nil = zero-    go (Tip x) = f x-    go (Bin Alternative m n) = go m <|> go n-    go (Bin MonadPlus m n) = go m `mplus` go n-    go (Bin Unit m n) = go m `plus` go n---- | A version of 'lift' that can be used with just an 'Applicative' for @m@.-liftPerm :: Applicative m => m a -> PermT m a-liftPerm = Choice mempty . Tip . liftBranch--liftBranch :: Applicative m => m a -> Branch m a-liftBranch = Ap Applicative (Choice (pure id) mempty)--{- |-Lift a monad homomorphism from @m@ to @n@ into a monad homomorphism from-@'PermT' m@ to @'PermT' n@.--}-hoistPerm :: Monad n => (forall a . m a -> n a) -> PermT m b -> PermT n b-hoistPerm f (Choice a xs) = Choice (hoistOption a) (hoistBranches f xs)--hoistBranches :: Monad n =>-                 (forall a . m a -> n a) -> Branches m b -> Branches n b-hoistBranches f (Bin _ m n) = Bin Unit (hoistBranches f m) (hoistBranches f n)-hoistBranches f (Tip x) = Tip (hoistBranch f x)-hoistBranches _ Nil = Nil--hoistBranch :: Monad n => (forall a . m a -> n a) -> Branch m b -> Branch n b-hoistBranch f (Ap _ perm m) = Ap Monad (hoistPerm f perm) (f m)-hoistBranch f (Bind k m) = Bind (hoistPerm f . k) (f m)--instance Monoid (Branches m a) where-  mempty = Nil-  mappend = Bin Unit--instance Functor (PermT m) where-  fmap f (Choice a xs) = Choice (f <$> a) (f <$> xs)--instance Functor (Branches m) where-  fmap _ Nil = Nil-  fmap f (Tip a) = Tip (fmap f a)-  fmap f (Bin dict m n) = Bin dict (fmap f m) (fmap f n)--instance Functor (Branch m) where-  fmap f (Ap dict perm m) = Ap dict (fmap (f .) perm) m-  fmap f (Bind k m) = Bind (fmap f . k) m--instance Applicative m => Applicative (PermT m) where-  pure a = Choice (pure a) mempty-  f@(Choice f' fs) <*> a@(Choice a' as) =-    Choice (f' <*> a') (mapB (`apB` a) fs <> mapB (f `apP`) as)--apP :: Applicative m => PermT m (a -> b) -> Branch m a -> Branch m b-f `apP` Ap _ perm m = Ap Applicative (f .@ perm) m-f `apP` Bind k m = Bind ((f <*>) . k) m--(.@) :: Applicative f => f (b -> c) -> f (a -> b) -> f (a -> c)-(.@) = liftA2 (.)--apB :: Applicative m => Branch m (a -> b) -> PermT m a -> Branch m b-Ap _ perm m `apB` a = Ap Applicative (flipA2 perm a) m-Bind k m `apB` a = Bind ((<*> a) . k) m--flipA2 :: Applicative f => f (a -> b -> c) -> f b -> f (a -> c)-flipA2 = liftA2 flip--instance Alternative m => Alternative (PermT m) where-  empty = Choice empty mempty-  m@(Choice (Return _ _) _) <|> _ = m-  Choice (Zero _) xs <|> Choice b ys = Choice b (xs `orB` ys)--orB :: Alternative m => Branches m a -> Branches m a -> Branches m a-orB = Bin Alternative--instance Monad m => Monad (PermT m) where-  return a = Choice (return a) mempty-  Choice (Zero dict) xs >>= k = Choice (Zero dict) (mapB (bindP k) xs)-  Choice (Return _ a) xs >>= k = case k a of-    Choice a' xs' -> Choice a' (mapB (bindP k) xs <> xs')-  m@(Choice m' ms) >> n@(Choice n' ns) =-    Choice (m' >> n') (mapB (`thenBM` n) ms <> mapB (m `thenPM`) ns)-  fail s = Choice (fail s) mempty--bindP :: Monad m => (a -> PermT m b) -> Branch m a -> Branch m b-bindP k (Ap _ perm m) = Bind (\ a -> k . ($ a) =<< perm) m-bindP k (Bind k' m) = Bind (k <=< k') m--thenPM :: Monad m => PermT m a -> Branch m b -> Branch m b-m `thenPM` Ap _ perm n = Ap Monad (m >> perm) n-m `thenPM` Bind k n = Bind ((m >>) . k) n--thenBM :: Monad m => Branch m a -> PermT m b -> Branch m b-Ap _ perm m `thenBM` n = Ap Monad (perm >> fmap const n) m-Bind k m `thenBM` n = Bind ((>> n) . k) m--instance MonadPlus m => MonadPlus (PermT m) where-  mzero = Choice mzero mempty-  m@(Choice (Return _ _) _) `mplus` _ = m-  Choice (Zero _) xs `mplus` Choice b ys = Choice b (xs `mplusB` ys)--mplusB :: MonadPlus m => Branches m a -> Branches m a -> Branches m a-mplusB = Bin MonadPlus--instance MonadTrans PermT where-  lift = Choice mempty . Tip . Ap Monad (Choice (return id) mempty)--instance MonadIO m => MonadIO (PermT m) where-  liftIO = lift . liftIO--instance MonadReader r m => MonadReader r (PermT m) where-  ask = lift ask-  local f (Choice a xs) = Choice a (mapB (localBranch f) xs)-#if MIN_VERSION_mtl(2, 1, 0)-  reader = lift . reader-#endif--localBranch :: MonadReader r m => (r -> r) -> Branch m a -> Branch m a-localBranch f (Ap dict perm m) = Ap dict (local f perm) (local f m)-localBranch f (Bind k m) = Bind (local f . k) (local f m)--instance MonadState s m => MonadState s (PermT m) where-  get = lift get-  put = lift . put-#if MIN_VERSION_mtl(2, 1, 0)-  state = lift . state-#endif--#ifdef LANGUAGE_DefaultSignatures-instance MonadThrow e m => MonadThrow e (PermT m)-#else-instance MonadThrow e m => MonadThrow e (PermT m) where-  throw = lift . throw-#endif--mapB :: (Branch m a -> Branch m b) -> Branches m a -> Branches m b-mapB _ Nil = Nil-mapB f (Tip x) = Tip (f x)-mapB f (Bin dict m n) = Bin dict (mapB f m) (mapB f n)

@@ -1,27 +0,0 @@-{-# LANGUAGE GADTs #-}-{- |-Copyright: Andy Sonnenburg (c) 2012-License: BSD-style (see the file LICENSE)-Maintainer: Andy Sonnenburg <andy22286@gmail.com>-Stability: experimental-Portability: non-portable--}-module Control.Monad.Perm.Dict-       ( Dict (..)-       , PlusDict (..)-       , ZeroDict-       ) where--import Control.Applicative-import Control.Monad--data Dict m where-  Applicative :: Applicative m => Dict m-  Monad :: Monad m => Dict m--data PlusDict m where-  Alternative :: Alternative m => PlusDict m-  MonadPlus :: MonadPlus m => PlusDict m-  Unit :: PlusDict m--type ZeroDict = PlusDict

@@ -0,0 +1,242 @@+{-# LANGUAGE+    CPP+  , FlexibleInstances+  , GADTs+  , MultiParamTypeClasses+  , Rank2Types+  , UndecidableInstances #-}+{- |+Copyright: Andy Sonnenburg (c) 2012+License: BSD-style (see the file LICENSE)+Maintainer: Andy Sonnenburg <andy22286@gmail.com>+Stability: experimental+Portability: non-portable+-}+module Control.Monad.Perm.Internal+       ( Perm+       , runPerm+       , sum1+       , sum1M+       , liftPerm+       , liftPlus+       , hoistPerm+       ) where++import Control.Applicative+import Control.Arrow (second)+import Control.Monad hiding (ap)+import qualified Control.Monad as Monad (ap)+#if LANGUAGE_DefaultSignatures+import Control.Monad.Catch.Class (MonadThrow)+#else+import Control.Monad.Catch.Class (MonadThrow (throw))+#endif+import Control.Monad.Fix (MonadFix (mfix))+import Control.Monad.IO.Class (MonadIO (liftIO))+#if MIN_VERSION_mtl(2, 1, 0)+import Control.Monad.Reader.Class (MonadReader (ask, local, reader))+import Control.Monad.State.Class (MonadState (get, put, state))+#else+import Control.Monad.Reader.Class (MonadReader (ask, local))+import Control.Monad.State.Class (MonadState (get, put))+#endif+import Control.Monad.Trans.Class (MonadTrans (lift))++import Data.Maybe (Maybe (Nothing, Just), fromMaybe)+import Data.Monoid (Monoid (mappend, mempty))++import Prelude (($), (.), flip, fst, id, snd, uncurry)++-- | The permutation applicative+data Perm m a where+  Plus :: PlusDict m -> Perm m a -> Perm m a -> Perm m a+  Ap :: ApDict m -> m (a -> b) -> Perm m a -> Perm m b+  Bind :: Monad m => m a -> (a -> Perm m b) -> Perm m b+  Fix :: MonadFix m => (a -> Perm m (a, b)) -> Perm m b+  Lift :: m a -> Perm m a++newtype PlusDict m =+  PlusDict { getPlusDict :: forall a . Maybe (m a -> m a -> m a)+           }++fromPlusDict :: (forall a . m a -> m a -> m a) ->+                PlusDict m ->+                m b -> m b -> m b+fromPlusDict d = fromMaybe d . getPlusDict++alternative :: Alternative m => PlusDict m+alternative = PlusDict (Just (<|>))++monadPlus :: MonadPlus m => PlusDict m+monadPlus = PlusDict (Just mplus)++unit :: PlusDict m+unit = PlusDict Nothing++type ApDict m = forall a b . m (a -> b) -> m a -> m b++applicative :: Applicative m => ApDict m+applicative = (<*>)++monad :: Monad m => ApDict m+monad = Monad.ap++-- | Unwrap a 'Perm', combining actions using the 'Alternative' for @f@.+sum1 :: Alternative m => Perm m a -> m a+sum1 m = runPerm m (<|>)++-- | Unwrap a 'Perm', combining actions using the 'MonadPlus' for @f@.+sum1M :: MonadPlus m => Perm m a -> m a+sum1M m = runPerm m mplus++runPerm :: Perm m b -> (forall a . m a -> m a -> m a) -> m b+runPerm (Plus x m n) d = fromPlusDict d x (runPerm m d) (runPerm n d)+runPerm (Ap ap f a) plus = f `ap` runPerm a plus+runPerm (Bind m k) plus = m >>= \ a -> runPerm (k a) plus+runPerm (Fix k) plus = liftM snd $ mfix $ \ ~(a, _) -> runPerm (k a) plus+runPerm (Lift m) _ = m++-- | A version of 'lift' that can be used without a 'Monad' for @m@.+liftPerm :: m a -> Perm m a+liftPerm = Lift++liftPlus :: (forall a . m a -> m a -> m a) ->+            Perm m b -> Perm m b -> Perm m b+liftPlus plus = Plus (PlusDict (Just plus))++{- |+Lift a monad homomorphism from @m@ to @n@ into a monad homomorphism from+@'Perm' m@ to @'Perm' n@.+-}+hoistPerm :: MonadFix n => (forall a . m a -> n a) -> Perm m b -> Perm n b+hoistPerm f (Plus _ m n) = Plus unit (hoistPerm f m) (hoistPerm f n)+hoistPerm f (Ap _ g a) = Ap monad (f g) (hoistPerm f a)+hoistPerm f (Bind m k) = Bind (f m) (hoistPerm f . k)+hoistPerm f (Fix k) = Fix $ hoistPerm f . k+hoistPerm f (Lift m) = Lift (f m)++instance Monoid (m a) => Monoid (Perm m a) where+  mappend = (<>)+  mempty = liftPerm mempty++instance Functor m => Functor (Perm m) where+  fmap f (Plus dict m n) = Plus dict (fmap f m) (fmap f n)+  fmap f (Ap ap g a) = Ap ap (fmap (f .) g) a+  fmap f (Bind m k) = Bind m (fmap f . k)+  fmap f (Fix k) = Fix $ fmap (second f) . k+  fmap f (Lift m) = Lift (fmap f m)++instance Applicative m => Applicative (Perm m) where+  pure = liftPerm . pure+  f <*> a = (f `apL` a) <> (f `apR` a)++infixl 4 `apL`, `apR`+apL, apR :: Applicative m => Perm m (a -> b) -> Perm m a -> Perm m b++Plus plus m n `apL` a = Plus plus (m `apL` a) (n `apL` a)+Ap ap f a `apL` b = Ap ap (uncurry <$> f) $ zipA a b+Bind m k `apL` a = Bind m ((<*> a) . k)+Fix k `apL` n = Fix $ \ a0 -> (\ ((a1, f'), a') -> (a1, f' a')) <$> zipAL (k a0) n+Lift f `apL` a = Ap applicative f a++f `apR` Plus plus m n = Plus plus (f `apR` m) (f `apR` n)+f `apR` Ap ap g a = Ap ap ((\ g' (f', a') -> f' (g' a')) <$> g) $ zipA f a+f `apR` Bind m k = Bind m ((f <*>) . k)+f `apR` Fix k = Fix $ fmap (\ (f', (a1, a')) -> (a1, f' a')) . zipAR f . k+f `apR` Lift a = Ap (<*>) (flip ($) <$> a) f++zipAL, zipAR :: Applicative m => Perm m a -> Perm m b -> Perm m (a, b)+zipAL a b = (,) <$> a `apL` b+zipAR a b = (,) <$> a `apR` b++instance Alternative m => Alternative (Perm m) where+  empty = liftPerm empty+  (<|>) = Plus alternative++instance MonadFix m => Monad (Perm m) where+  return = lift . return+  m >>= k = (m `bindL` k) <> (m `bindR` k)+  m >> n = liftM' snd $ zipM' m n+  fail = lift . fail++infixl 1 `bindL`, `bindR`+bindL, bindR :: MonadFix m => Perm m a -> (a -> Perm m b) -> Perm m b++Plus plus m n `bindL` k = Plus plus (m `bindL` k) (n `bindL` k)+Ap _ f a `bindL` k = Bind f $ \ f' -> a >>= k . f'+Bind m f `bindL` g = Bind m $ f >=> g+Fix k `bindL` k' = Fix $ \ a0 -> k a0 `bindL` \ (a1, a') -> liftM' (\ b -> (a1, b)) $ k' a'+Lift m `bindL` k = Bind m k++m `bindR` k = liftM' snd $ mfix $ zipMR m . k . fst++liftM' :: Monad m => (a -> b) -> Perm m a -> Perm m b+liftM' f (Plus dict m n) = Plus dict (liftM' f m) (liftM' f n)+liftM' f (Ap ap g a) = Ap ap (liftM (f .) g) a+liftM' f (Bind m k) = Bind m (liftM' f . k)+liftM' f (Fix k) = Fix $ liftM' (second f) . k+liftM' f (Lift m) = Lift (liftM f m)++zipM', zipML, zipMR :: Monad m => Perm m a -> Perm m b -> Perm m (a, b)++zipM' m n = zipML m n <> zipMR m n++zipML (Plus plus m n) b = Plus plus (zipML m b) (zipML n b)+zipML (Ap ap f a) b = Ap ap (liftM mapFst f) $ zipM' a b+zipML (Bind m k) n = Bind m $ \ a -> zipM' (k a) n+zipML (Fix k) n = Fix $ \ a0 -> liftM' (\ ((a1, a'), b') -> (a1, (a', b'))) $ zipML (k a0) n+zipML (Lift m) n = Ap monad (liftM (,) m) n++zipMR a (Plus plus m n) = Plus plus (zipMR a m) (zipMR a n)+zipMR a (Ap ap f b) = Ap ap (liftM fmap f) $ zipM' a b+zipMR m (Bind n k) = Bind n $ zipM' m . k+zipMR m (Fix k) = Fix $ liftM' (\ (a, (a', b)) -> (a', (a, b))) . zipMR m . k+zipMR m (Lift n) = Ap monad (liftM (flip (,)) n) m++instance (MonadFix m, MonadPlus m) => MonadPlus (Perm m) where+  mzero = lift mzero+  mplus = Plus monadPlus++instance MonadFix m => MonadFix (Perm m) where+  mfix f = Fix $ liftM' (join (,)) . f++instance MonadTrans Perm where+  lift = Lift++instance (MonadFix m, MonadIO m) => MonadIO (Perm m) where+  liftIO = lift . liftIO++instance (MonadFix m, MonadReader r m) => MonadReader r (Perm m) where+  ask = lift ask+  local f (Plus plus m n) = Plus plus (local f m) (local f n)+  local f (Ap ap g a) = Ap ap (local f g) (local f a)+  local f (Bind m k) = Bind (local f m) (local f . k)+  local f (Fix k) = Fix $ local f . k+  local f (Lift m) = Lift $ local f m+#if MIN_VERSION_mtl(2, 1, 0)+  reader = lift . reader+#endif++instance (MonadFix m, MonadState s m) => MonadState s (Perm m) where+  get = lift get+  put = lift . put+#if MIN_VERSION_mtl(2, 1, 0)+  state = lift . state+#endif++#ifdef LANGUAGE_DefaultSignatures+instance (MonadFix m, MonadThrow e m) => MonadThrow e (Perm m)+#else+instance (MonadFix m, MonadThrow e m) => MonadThrow e (Perm m) where+  throw = lift . throw+#endif++infixr 6 <>+(<>) :: Perm m a -> Perm m a -> Perm m a+(<>) = Plus unit++zipA :: Applicative m => m a -> m b -> m (a, b)+zipA m n = (,) <$> m <*> n++mapFst :: (a -> a') -> (a, b) -> (a', b)+mapFst f (a, b) = (f a, b)

@@ -1,66 +0,0 @@-{- |-Copyright: Andy Sonnenburg (c) 2012-License: BSD-style (see the file LICENSE)-Maintainer: Andy Sonnenburg <andy22286@gmail.com>-Stability: experimental-Portability: non-portable--}-module Control.Monad.Perm.Option-       ( Option (..)-       , option-       , hoistOption-       ) where--import Control.Applicative-import Control.Monad--import Data.Monoid--import Control.Monad.Perm.Dict--data Option m a-  = Zero (ZeroDict m)-  | Return (Dict m) a--option :: m a -> Option m a -> m a-option _ (Zero Alternative) = empty-option _ (Zero MonadPlus) = mzero-option n (Zero Unit) = n-option _ (Return Applicative a) = pure a-option _ (Return Monad a) = return a--hoistOption :: Monad n => Option m a -> Option n a-hoistOption (Zero _) = mempty-hoistOption (Return _ a) = Return Monad a--instance Monoid (Option m a) where-  mempty = Zero Unit-  Zero _ `mappend` r = r-  l `mappend` _ = l--instance Functor (Option m) where-  fmap _ (Zero dict) = Zero dict-  fmap f (Return dict a) = Return dict (f a)--instance Applicative m => Applicative (Option m) where-  pure = Return Applicative-  Return _ f <*> a = fmap f a-  Zero dict <*> _ = Zero dict--instance Alternative m => Alternative (Option m) where-  empty = Zero Alternative-  Zero _ <|> r = r-  l <|> _ = l--instance Monad m => Monad (Option m) where-  return = Return Monad-  Return _ a >>= k = k a-  Zero dict >>= _ = Zero dict-  Return _ _ >> k = k-  Zero dict >> _ = Zero dict-  fail _ = mempty--instance MonadPlus m => MonadPlus (Option m) where-  mzero = Zero MonadPlus-  Zero _ `mplus` r = r-  l `mplus` _ = l

@@ -1,5 +1,5 @@ name:          perm-version:       0.3.0.1+version:       0.4.0.0 cabal-version: >= 1.10 synopsis:      permutation Applicative and Monad with many mtl instances description:@@ -27,9 +27,7 @@     Control.Applicative.Perm     Control.Monad.Perm   other-modules:-    Control.Monad.Perm.Base-    Control.Monad.Perm.Dict-    Control.Monad.Perm.Option+    Control.Monad.Perm.Internal   build-depends:     base >= 4 && < 5,     transformers >= 0.2 && < 0.4,@@ -45,3 +43,17 @@     MultiParamTypeClasses     Rank2Types     UndecidableInstances++test-suite reddit-tests+  default-language: Haskell98+  hs-source-dirs: tests+  main-is: RedditTests.hs+  type: exitcode-stdio-1.0+  build-depends:+    base,+    mtl,+    HUnit,+    test-framework >= 0.3.3,+    test-framework-hunit,+    perm+  ghc-options: -Wall

@@ -0,0 +1,45 @@+-- | <http://www.reddit.com/r/haskell/comments/12kuvr/permutation_monad_using_monadfix/>+module Main (main) where++import Control.Applicative+import Control.Monad.Perm+import Control.Monad.Writer++import Test.Framework (Test, defaultMain)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (Assertion, (@=?))++redditExample1 :: Assertion+redditExample1 =+  ["abc", "acb", "bac", "bca", "cab", "cba"]+  @=?+  (execWriterT $ runPerm $ lift (tell "a") >>= \ _ -> lift (tell "b") >>= \ _ -> lift (tell "c"))++redditExample1UsingThen :: Assertion+redditExample1UsingThen =+  ["abc", "acb", "bac", "bca", "cab", "cba"]+  @=?+  (execWriterT $ runPerm $ lift (tell "a") >> lift (tell "b") >> lift (tell "c"))++redditExample1UsingAp :: Assertion+redditExample1UsingAp =+  ["abc", "acb", "bac", "bca", "cab", "cba"]+  @=?+  (execWriterT $ runPerm $ lift (tell "a") *> lift (tell "b") *> lift (tell "c"))++redditExample2 :: Assertion+redditExample2 =+  ["abc", "acb", "bac", "bca", "cab", "cba"]+  @=?+  (execWriterT $ runPerm $ lift (tell "a" >> return "b") >>= \ a -> lift (tell a) >>= \ _ -> lift (tell "c"))++tests :: [Test]+tests =+  [ testCase "redditExample1" redditExample1+  , testCase "redditExample1UsingThen" redditExample1UsingThen+  , testCase "reddit1ExampleUsingAp" redditExample1UsingAp+  , testCase "redditExample2" redditExample2+  ]++main :: IO ()+main = defaultMain tests