diff --git a/Control/Applicative/Perm.hs b/Control/Applicative/Perm.hs
--- a/Control/Applicative/Perm.hs
+++ b/Control/Applicative/Perm.hs
@@ -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
diff --git a/Control/Monad/Perm.hs b/Control/Monad/Perm.hs
--- a/Control/Monad/Perm.hs
+++ b/Control/Monad/Perm.hs
@@ -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
diff --git a/Control/Monad/Perm/Base.hs b/Control/Monad/Perm/Base.hs
deleted file mode 100644
--- a/Control/Monad/Perm/Base.hs
+++ /dev/null
@@ -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)
diff --git a/Control/Monad/Perm/Dict.hs b/Control/Monad/Perm/Dict.hs
deleted file mode 100644
--- a/Control/Monad/Perm/Dict.hs
+++ /dev/null
@@ -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
diff --git a/Control/Monad/Perm/Internal.hs b/Control/Monad/Perm/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monad/Perm/Internal.hs
@@ -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)
diff --git a/Control/Monad/Perm/Option.hs b/Control/Monad/Perm/Option.hs
deleted file mode 100644
--- a/Control/Monad/Perm/Option.hs
+++ /dev/null
@@ -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
diff --git a/perm.cabal b/perm.cabal
--- a/perm.cabal
+++ b/perm.cabal
@@ -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
diff --git a/tests/RedditTests.hs b/tests/RedditTests.hs
new file mode 100644
--- /dev/null
+++ b/tests/RedditTests.hs
@@ -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