diff --git a/Control/Monad/Base/Control.hs b/Control/Monad/Base/Control.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monad/Base/Control.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Control.Monad.Base.Control where
+
+import Control.Concurrent.STM (STM)
+import Control.Monad (replicateM)
+import Control.Monad.Trans.Accum
+import Control.Monad.Trans.Control
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Identity
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.State.Lazy as L
+import Control.Monad.Trans.State.Strict as S
+import Control.Monad.Trans.Writer.Lazy as L
+import Control.Monad.Trans.Writer.Strict as S
+import Control.Monad.ST.Lazy as L (ST)
+import Control.Monad.ST.Strict as S (ST)
+import Data.Basic
+import Data.Foldable
+import Data.Functor.Identity
+import Data.List.NonEmpty (NonEmpty)
+import Data.Proxy
+import Language.Haskell.TH
+import Text.ParserCombinators.ReadP (ReadP)
+import Text.ParserCombinators.ReadPrec (ReadPrec)
+
+class (Basic1 m, Monad m, Monad (Base m)) => MonadBaseControl m where
+    type StM m a
+    liftBaseWith :: (RunInBase m -> Base m a) -> m a
+    restoreM :: StM m a -> m a
+
+type RunInBase m = ∀ a . m a -> Base m (StM m a)
+
+newtype ComposeSt t m a = ComposeSt { unComposeSt :: StM m (StT t a) }
+
+type RunInBaseDefault t m = ∀ a . t m a -> Base m (ComposeSt t m a)
+
+defaultLiftBaseWith :: (MonadTransControl t, MonadBaseControl m) => (RunInBaseDefault t m -> Base m a) -> t m a
+defaultLiftBaseWith = \ f -> liftWith $ \ run -> liftBaseWith $ \ runInBase -> f $ fmap ComposeSt . runInBase . run
+{-# INLINABLE defaultLiftBaseWith #-}
+
+defaultRestoreM :: (MonadTransControl t, MonadBaseControl m) => ComposeSt t m a -> t m a
+defaultRestoreM = restoreT . restoreM . unComposeSt
+{-# INLINABLE defaultRestoreM #-}
+
+$(let f :: Int -> Name -> Q Dec
+      f n name =
+          [InstanceD Nothing [] (ConT ''MonadBaseControl `AppT` t)
+           [TySynInstD ''StM $ TySynEqn [t, VarT u] (VarT u),
+            FunD 'liftBaseWith [Clause [VarP v] (NormalB (VarE v `AppE` VarE 'id)) []],
+            ValD (VarP 'restoreM) (NormalB (VarE 'pure)) []]
+            | t <- foldl' AppT (ConT name) <$> replicateM n (VarT <$> newName "a")
+            , u <- newName "a"
+            , v <- newName "f"]
+  in traverse (uncurry f) [(0, ''IO), (1, ''L.ST), (1, ''S.ST), (0, ''STM),
+                           (0, ''Maybe), (1, ''Either), (0, ''Identity),
+                           (0, ''[]), (0, ''NonEmpty), (0, ''Proxy),
+                           (0, ''ReadP), (0, ''ReadPrec)])
+
+instance Monoid a => MonadBaseControl ((,) a) where
+    type StM ((,) a) b = b
+    liftBaseWith f = f id
+    restoreM = pure
+
+instance MonadBaseControl ((->) a) where
+    type StM ((->) a) b = b
+    liftBaseWith f = f id
+    restoreM = pure
+
+$(let f :: Int -> Name -> Q Dec
+      f n name = 
+          [InstanceD Nothing [ConT ''MonadBaseControl `AppT` f] (ConT ''MonadBaseControl `AppT` AppT t f)
+           [TySynInstD ''StM $ TySynEqn [AppT t f, a] (foldl' AppT (ConT ''ComposeSt) [t, f, a]),
+            ValD (VarP 'liftBaseWith) (NormalB (VarE 'defaultLiftBaseWith)) [],
+            ValD (VarP 'restoreM) (NormalB (VarE 'defaultRestoreM)) []]
+            | t <- foldl' AppT (ConT name) <$> replicateM n (VarT <$> newName "a")
+            , f <- VarT <$> newName "f"
+            , a <- VarT <$> newName "a"]
+  in traverse (uncurry f) [(0, ''IdentityT), (0, ''MaybeT), (1, ''ReaderT), (1, ''ExceptT),
+                           (1, ''L.StateT), (1, ''S.StateT)])
+
+instance (MonadBaseControl f, Monoid a) => MonadBaseControl (L.WriterT a f) where
+    type StM (L.WriterT a f) b = ComposeSt (L.WriterT a) f b
+    liftBaseWith = defaultLiftBaseWith
+    restoreM = defaultRestoreM
+
+instance (MonadBaseControl f, Monoid a) => MonadBaseControl (S.WriterT a f) where
+    type StM (S.WriterT a f) b = ComposeSt (S.WriterT a) f b
+    liftBaseWith = defaultLiftBaseWith
+    restoreM = defaultRestoreM
+
+instance (MonadBaseControl f, Monoid a) => MonadBaseControl (AccumT a f) where
+    type StM (AccumT a f) b = ComposeSt (AccumT a) f b
+    liftBaseWith = defaultLiftBaseWith
+    restoreM = defaultRestoreM
diff --git a/Control/Monad/Trans/Control.hs b/Control/Monad/Trans/Control.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monad/Trans/Control.hs
@@ -0,0 +1,82 @@
+module Control.Monad.Trans.Control where
+
+import Control.Monad.Trans.Accum
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Identity
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.State.Lazy as L
+import Control.Monad.Trans.State.Strict as S
+import Control.Monad.Trans.Writer.Lazy as L
+import Control.Monad.Trans.Writer.Strict as S
+
+class MonadTrans t => MonadTransControl t where
+    type StT t a
+    liftWith :: Monad m => (Run t -> m a) -> t m a
+    restoreT :: Monad m => m (StT t a) -> t m a
+
+type Run t = ∀ n b . Monad n => t n b -> n (StT t b)
+
+instance MonadTransControl IdentityT where
+    type StT IdentityT a = a
+    liftWith f = IdentityT $ f runIdentityT
+    restoreT = IdentityT
+    {-# INLINABLE liftWith #-}
+    {-# INLINABLE restoreT #-}
+
+instance MonadTransControl MaybeT where
+    type StT MaybeT a = Maybe a
+    liftWith f = MaybeT $ fmap pure $ f runMaybeT
+    restoreT = MaybeT
+    {-# INLINABLE liftWith #-}
+    {-# INLINABLE restoreT #-}
+
+instance MonadTransControl (ExceptT e) where
+    type StT (ExceptT e) a = Either e a
+    liftWith f = ExceptT $ fmap pure $ f runExceptT
+    restoreT = ExceptT
+    {-# INLINABLE liftWith #-}
+    {-# INLINABLE restoreT #-}
+
+instance MonadTransControl (ReaderT r) where
+    type StT (ReaderT r) a = a
+    liftWith f = ReaderT $ \ r -> f (flip runReaderT r)
+    restoreT = ReaderT . pure
+    {-# INLINABLE liftWith #-}
+    {-# INLINABLE restoreT #-}
+
+instance MonadTransControl (L.StateT s) where
+    type StT (L.StateT s) a = (a, s)
+    liftWith f = L.StateT $ \ s -> flip (,) s <$> f (flip L.runStateT s)
+    restoreT = L.StateT . pure
+    {-# INLINABLE liftWith #-}
+    {-# INLINABLE restoreT #-}
+
+instance MonadTransControl (S.StateT s) where
+    type StT (S.StateT s) a = (a, s)
+    liftWith f = S.StateT $ \ s -> flip (,) s <$> f (flip S.runStateT s)
+    restoreT = S.StateT . pure
+    {-# INLINABLE liftWith #-}
+    {-# INLINABLE restoreT #-}
+
+instance Monoid w => MonadTransControl (L.WriterT w) where
+    type StT (L.WriterT w) a = (a, w)
+    liftWith f = L.WriterT $ flip (,) mempty <$> f L.runWriterT
+    restoreT = L.WriterT
+    {-# INLINABLE liftWith #-}
+    {-# INLINABLE restoreT #-}
+
+instance Monoid w => MonadTransControl (S.WriterT w) where
+    type StT (S.WriterT w) a = (a, w)
+    liftWith f = S.WriterT $ flip (,) mempty <$> f S.runWriterT
+    restoreT = S.WriterT
+    {-# INLINABLE liftWith #-}
+    {-# INLINABLE restoreT #-}
+
+instance Monoid c => MonadTransControl (AccumT c) where
+    type StT (AccumT c) a = (a, c)
+    liftWith f = AccumT $ \ c -> flip (,) c <$> f (flip runAccumT c)
+    restoreT = AccumT . pure
+    {-# INLINABLE liftWith #-}
+    {-# INLINABLE restoreT #-}
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright M Farkas-Dyck © 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of M Farkas-Dyck nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,1 @@
+# control
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/control.cabal b/control.cabal
new file mode 100644
--- /dev/null
+++ b/control.cabal
@@ -0,0 +1,48 @@
+name:                control
+version:             0.1.0.0
+synopsis:            Class of monad transformers which control operations can be lifted thru
+-- description:
+license:             BSD3
+license-file:        LICENSE
+author:              M Farkas-Dyck
+maintainer:          strake888@gmail.com
+copyright:           2018 M Farkas-Dyck
+category:            Control
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Control.Monad.Base.Control
+                     , Control.Monad.Trans.Control
+  build-depends:       base >= 4.7 && < 5
+                     , basic >=0.1 && <0.2
+                     , stm
+                     , template-haskell
+                     , transformers >=0.5 && <0.6
+  default-language:    Haskell2010
+  default-extensions:  UnicodeSyntax
+                     , LambdaCase
+                     , EmptyCase
+                     , InstanceSigs
+                     , PartialTypeSignatures
+                     , PolyKinds
+                     , ConstraintKinds
+                     , FlexibleContexts
+                     , FlexibleInstances
+                     , RankNTypes
+                     , TypeFamilies
+                     , MonadComprehensions
+                     , StandaloneDeriving
+                     , DeriveFunctor, DeriveFoldable, DeriveTraversable
+  ghc-options:         -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing
+                       -Wincomplete-record-updates -Wincomplete-uni-patterns
+                       -Werror=incomplete-patterns
+                       -Werror=incomplete-uni-patterns
+                       -Werror=incomplete-record-updates
+                       -Werror=missing-fields
+                       -Werror=missing-methods
+
+source-repository head
+  type:     git
+  location: https://github.com/strake/control.hs