diff --git a/Extra/ErrorControl.hs b/Extra/ErrorControl.hs
new file mode 100644
--- /dev/null
+++ b/Extra/ErrorControl.hs
@@ -0,0 +1,104 @@
+-- | From the PureScript Error.Control package by Luka Jacobowitz.
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Extra.ErrorControl
+  ( MonadError(throwError) -- re-export
+  , ErrorControl(controlError, accept)
+  , intercept
+  , trial
+  , trialT
+  , absolve
+  , assure
+  ) where
+
+import Control.Monad.Except
+  (catchError, ExceptT(ExceptT), lift, MonadError, runExceptT, throwError, withExceptT)
+import Control.Monad.Identity (Identity(Identity), runIdentity)
+import Control.Monad.Reader (mapReaderT, ReaderT(ReaderT), runReaderT)
+import Control.Monad.RWS (mapRWST, runRWST, RWST(RWST))
+import Control.Monad.State (mapStateT, runStateT, StateT(StateT))
+import Control.Monad.Writer (mapWriterT, runWriterT, WriterT(WriterT))
+import Control.Exception (IOException)
+import UnexceptionalIO.Trans (run, UIO, unsafeFromIO)
+
+class (MonadError e m, Monad n) => ErrorControl e m n where
+  controlError :: m a -> (e -> n a) -> n a
+  accept :: n a -> m a
+
+instance ErrorControl e (Either e) Identity where
+  controlError ma f = either f Identity ma
+  accept = Right . runIdentity
+
+instance ErrorControl IOException IO UIO where
+  controlError ma f = unsafeFromIO (ma `catchError` (accept . f))
+  accept = run
+
+instance Monad m => ErrorControl e (ExceptT e m) m where
+  controlError ma f = runExceptT ma >>= either f pure
+  accept = lift
+
+-- | Resolve the error on the left side of an Either.
+instance Monad m => ErrorControl (Either e1 e2) (ExceptT (Either e1 e2) m) (ExceptT e2 m) where
+  controlError :: ExceptT (Either e1 e2) m a -> (Either e1 e2 -> ExceptT e2 m a) -> ExceptT e2 m a
+  controlError ma f =
+    ExceptT (pivot <$> runExceptT ma) >>= either pure (f . Left)
+    where
+      pivot :: Either (Either a b) c -> Either b (Either c a)
+      pivot = either (either (Right . Right) Left) (Right . Left)
+  accept :: ExceptT e2 m a -> ExceptT (Either e1 e2) m a
+  accept = withExceptT Right
+
+#if 0
+-- | Resolve the error on the right side of an Either.  (It turns out
+-- this actually does conflict with the one above.)
+instance Monad m => ErrorControl (Either e1 e2) (ExceptT (Either e1 e2) m) (ExceptT e1 m) where
+  controlError ma f =
+    ExceptT (pivot <$> runExceptT ma) >>= either (f . Right) pure
+    where
+      pivot :: Either (Either a b) c -> Either a (Either b c)
+      pivot = either (either Left (Right . Left)) (Right . Right)
+  accept = withExceptT Left
+#endif
+
+instance ErrorControl e m n => ErrorControl e (StateT s m) (StateT s n) where
+  controlError sma f = StateT (\s -> controlError (runStateT sma s) (\e -> runStateT (f e) s))
+  accept = mapStateT accept
+
+instance ErrorControl e m n => ErrorControl e (ReaderT r m) (ReaderT r n) where
+  controlError rma f = ReaderT (\r -> controlError (runReaderT rma r) (\e -> runReaderT (f e) r))
+  accept = mapReaderT accept
+
+instance (ErrorControl e m n, Monoid w) => ErrorControl e (WriterT w m) (WriterT w n) where
+  controlError wma f = WriterT (controlError (runWriterT wma) (runWriterT . f))
+  accept = mapWriterT accept
+
+instance (ErrorControl e m n, Monoid w) => ErrorControl e (RWST r w s m) (RWST r w s n) where
+  controlError rwsma f = RWST (\r s -> controlError (runRWST rwsma r s) (\e -> runRWST (f e) r s))
+  accept = mapRWST accept
+
+-- | Enhanced 'handleError'
+intercept :: ErrorControl e m n => m a -> (e -> a) -> n a
+intercept fa f = controlError fa (pure . f)
+
+-- | Enhanced 'try'
+trial :: ErrorControl e m n => m a -> n (Either e a)  -- try
+trial fa = intercept (fmap Right fa) Left
+
+trialT :: ErrorControl e m n => m a -> ExceptT e n a
+trialT fa = ExceptT (trial fa)
+
+absolve :: ErrorControl e m n => n (Either e a) -> m a
+absolve gea = accept gea >>= (either throwError pure)
+
+assure :: ErrorControl e m n => n a -> (a -> e) -> (a -> Bool) -> m a
+assure ga err predicate =
+  accept ga >>= (\a -> if predicate a then pure a else throwError (err a))
diff --git a/Extra/ErrorSet.hs b/Extra/ErrorSet.hs
new file mode 100644
--- /dev/null
+++ b/Extra/ErrorSet.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE ConstraintKinds, DataKinds, DeriveAnyClass, DeriveGeneric, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeFamilies #-}
+
+-- | Type level "sets" as a cons list constructed of Eithers.
+
+module Extra.ErrorSet
+  ( Insert
+  , Delete
+  , Member(follow)
+  , OneOf(OneOf, unOneOf)
+  -- * Re-export
+  -- , Void
+  ) where
+
+import Control.Lens
+import Data.SafeCopy
+import Data.Serialize
+import Data.Typeable (Typeable)
+import GHC.Generics
+
+-- See SafeCopy issue #78
+-- instance SafeCopy Void
+
+type family Insert t s where
+  Insert t (Either t a) = Either t a
+  Insert t () = Either t ()
+  Insert t (Either a b) = Either a (Insert t b)
+
+type family Delete t s where
+  Delete t (Either t a) = a
+  Delete t () = ()
+  Delete t (Either a b) = Either a (Delete t b)
+
+class Member t set where follow :: Prism' set t
+instance Member t (Either t a) where follow = _Left
+instance {-# OVERLAPS #-} Member t b => Member t (Either a b) where follow = _Right . follow
+instance Member t () where follow = error "Type Set Error"
+instance Member t (OneOf set) where follow = iso OneOf unOneOf . follow
+
+newtype OneOf (set :: *) = OneOf {unOneOf :: set} deriving (Show, Eq, Ord, Generic, Serialize, Typeable)
+instance (SafeCopy set, Typeable set) => SafeCopy (OneOf set)
diff --git a/Extra/Errors.hs b/Extra/Errors.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Errors.hs
@@ -0,0 +1,225 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Extra.Errors
+  ( IsMember
+  , Nub
+  , OneOf(Empty, Val, NoVal)
+  , Set(set)
+  , Get(get)
+  , oneOf
+  , DeleteList
+  , DeleteOneOf
+  , Delete(delete)
+  , Member
+  , throwMember
+  , liftMember
+  , catchMember
+  , test
+  ) where
+
+import Control.Lens (Prism', prism', review)
+import Control.Monad.Except (MonadError, throwError)
+--import Extra.Except (mapError)
+import Data.Type.Bool
+--import Data.Type.Equality
+import Data.Word (Word8)
+import Data.SafeCopy
+import qualified Data.Serialize as S (Serialize(get, put), getWord8, Put, PutM, Get)
+import Data.Typeable (Typeable, typeOf)
+import Data.Proxy
+import Extra.Except (tryError)
+
+type family IsMember x ys where
+  IsMember x '[] = 'False
+  IsMember x (x ': ys) = 'True
+  IsMember x (y ': ys) = IsMember x ys
+  IsMember x ys = IsMember x ys
+
+--type family Member x es where
+--  Member' x (OneOf xs) = Member' x xs
+
+type Member e es = (IsMember e es ~ 'True, Get e es, Set e es, Delete e es)
+
+type family Nub xs where
+  Nub '[] = '[]
+  Nub (x ': ys) = If (IsMember x ys) ys (x ': Nub ys)
+
+data OneOf (n :: [k]) where
+  Empty :: OneOf s
+  Val   :: e -> OneOf (e ': s)
+  NoVal :: OneOf s -> OneOf (e ': s)
+
+instance Show (OneOf '[]) where
+  show Empty = "{}"
+
+instance (Show e, Show (OneOf s)) => Show (OneOf (e ': s)) where
+  show (Val e) = show e
+  show (NoVal o) = show o
+  show Empty  = "{}"
+
+instance S.Serialize (OneOf '[]) where
+  get :: S.Get (OneOf s)
+  get = return Empty
+  put :: OneOf s -> S.PutM ()
+  put Empty = return ()
+  put _ = error "fix warning"
+
+instance (S.Serialize e, S.Serialize (OneOf s)) => S.Serialize (OneOf (e ': s)) where
+  put :: OneOf (e ': s) -> S.PutM ()
+  put (NoVal o) = S.put (0 :: Word8) >> S.put o
+  put (Val e) = S.put (1 :: Word8) >> S.put e
+  put _ = error "impossible"
+  get :: S.Get (OneOf (e ': s))
+  get = S.getWord8 >>= \case
+    0 -> NoVal <$> S.get
+    _ -> error "impossible"
+
+instance SafeCopy (OneOf '[]) where
+  version = 1
+  kind = base
+  getCopy :: S.Serialize (OneOf s) => Contained (S.Get (OneOf s))
+  getCopy = contain S.get
+  putCopy :: S.Serialize (OneOf s) => OneOf s -> Contained S.Put
+  putCopy = contain . S.put
+  errorTypeName _ = "()"
+
+instance (SafeCopy e, S.Serialize e, Typeable e,  S.Serialize (OneOf s), Typeable s) => SafeCopy (OneOf (e ': s)) where
+  version = 1
+  kind = base
+  getCopy :: Contained (S.Get (OneOf (e ': s)))
+  getCopy = contain S.get
+  putCopy :: OneOf (e ': s) -> Contained S.Put
+  putCopy = contain . S.put
+  errorTypeName = show . typeOf
+
+class Set e xs where
+  set :: e -> OneOf xs
+
+instance Set e (e ': xs) where
+  set e = Val e
+
+instance {-# OVERLAPS #-} (IsMember e xs ~ 'True, Set e xs) => Set e (f ': xs) where
+  set e = NoVal (set e)
+
+class Get e xs where
+  get :: OneOf xs -> Maybe e
+
+instance {-# OVERLAPS #-} Get e (e ': xs) where
+  get (Val e) = Just e
+  get (NoVal _) = Nothing
+  get Empty = error "impossible"
+
+instance (IsMember e xs ~ 'True, Get e xs) => Get e (f ': xs) where
+  get (NoVal o) = get o
+  get (Val _e) = Nothing
+  get Empty = error "impossible"
+
+oneOf :: ({-IsMember e xs ~ 'True,-} Get e xs, Set e xs) => Prism' (OneOf xs) e
+oneOf = prism' set get
+
+type family DeleteList e xs where
+  DeleteList x '[] = '[]
+  DeleteList x (x ': ys) = ys
+  DeleteList x (y ': ys) = (y ': (DeleteList x ys))
+
+type family DeleteOneOf e xs where
+  DeleteOneOf x (OneOf ys) = OneOf (DeleteList x ys)
+
+class Delete e xs where
+  delete :: Proxy e -> OneOf xs -> DeleteOneOf e (OneOf xs)
+
+instance Delete e (e ': xs) where
+  delete _ (Val _e) = Empty
+  delete _ (NoVal o) = o
+  delete _ Empty = Empty
+
+instance {-# OVERLAPS #-} forall e f xs. (Delete e xs, DeleteList e (f:xs) ~ (f : DeleteList e xs)) => Delete e (f ': xs) where
+   delete _p (Val v) = (Val v) -- :: OneOf (f ': (DeleteList e xs))
+   delete p (NoVal o) = NoVal (delete p o)
+   delete _p Empty = Empty
+
+throwMember :: (Member e es, MonadError (OneOf es) m) => e -> m a
+throwMember = throwError . review oneOf
+
+liftMember :: (Member e es, MonadError (OneOf es) m) => Either e a -> m a
+liftMember = either throwMember return
+
+catchMember ::
+  forall e es es' m n a.
+  (Member e es, es' ~ DeleteList e es,
+   MonadError (OneOf es) m, MonadError (OneOf es') n)
+  => (forall b. (OneOf es -> OneOf es') -> m b -> n b)
+  -> m a -> (e -> n a) -> n a
+catchMember helper ma f =
+  -- The idea here is that we use tryError to bring a copy of e into
+  -- the return value, then we can just delete e from error monad.
+  helper (delete @e Proxy) (tryError ma) >>= either handle return
+  where handle :: OneOf es -> n a
+        handle es = maybe (throwError (delete @e Proxy es)) f (get es :: Maybe e)
+
+-- ** Example
+
+data ErrorFoo = Foo deriving Show
+data ErrorBar = Bar deriving Show
+data ErrorBaz = Baz deriving Show
+
+type AppErrors = OneOf '[ErrorFoo, ErrorBar, ErrorBaz]
+
+handleBar :: (Member ErrorBar errors) => OneOf errors -> IO (DeleteOneOf ErrorBar (OneOf errors))
+handleBar err =
+  do case get err of
+       Nothing -> putStrLn "no Bar error to handle"
+       (Just Bar) -> putStrLn "took care of Bar"
+     pure (delete @ErrorBar Proxy err)
+
+handleFoo :: ({-IsMember ErrorFoo errors ~ 'True,-} Get ErrorFoo errors, Delete ErrorFoo errors) => OneOf errors -> IO (DeleteOneOf ErrorFoo (OneOf errors))
+handleFoo err =
+  do case get err of
+       Nothing -> putStrLn "no Bar error to handle"
+       (Just Foo) -> putStrLn "took care of Bar"
+     pure (delete @ErrorFoo Proxy err)
+
+{-
+Generates the ouput:
+
+current error = Foo
+no Bar error to handle
+current error = Foo
+took care of Bar
+current error = {}
+-}
+test :: IO ()
+test =
+  do let errAll = set Foo :: AppErrors
+     putStrLn $ "current error = " ++ show errAll
+
+     errNoBar <- handleBar errAll
+     putStrLn $ "current error = " ++ show errNoBar
+
+     errNoFoo <- handleFoo errNoBar
+     putStrLn $ "current error = " ++ show errNoFoo
+
+     -- this will not compile because ErrorFoo has already been handled
+--     errNoFoFoo <- handleFoo errNoFoo
+
+     pure ()
diff --git a/Extra/Except.hs b/Extra/Except.hs
--- a/Extra/Except.hs
+++ b/Extra/Except.hs
@@ -1,4 +1,13 @@
-{-# LANGUAGE CPP, DeriveAnyClass, FunctionalDependencies, OverloadedStrings, TemplateHaskell, UndecidableInstances #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS -Wall -Wredundant-constraints -Wno-orphans #-}
 
 module Extra.Except
@@ -8,41 +17,54 @@
       -- * Control.Monad.Except extensions
     , tryError
     , withError
+    , withError'
     , mapError
     , handleError
-    , HasIOException(fromIOException)
+    , HasIOException(ioException)
+    , HasNonIOException(nonIOException)
+    , HasErrorCall(..)
     , IOException'(..)
-#if 1
-    , Tried(unTried)
-    , tryIO
-    , logIOError
-#else
-    , LyftIO(lyftIO, IOMonad, ErrorType)
-    , tryLiftIO
-    , logLiftIO
+    -- , HasSomeNonPseudoException(someNonPseudoException)
+    , SomeNonPseudoException'
+    -- , lyftIO
+    -- , lyftIO'
     , lyftIO'
-    , LyftIO'
-    , LyftIO2
-    , lyftIO2
-
-    , MonadIOError
-    , liftIOError
-    , tryIOError
+    , lyftIO
+#if !__GHCJS__
     , logIOError
 #endif
     , module Control.Monad.Except
     ) where
 
-import Control.Exception ({-evaluate,-} Exception, IOException, SomeException(..))
+import Control.Applicative
+import Control.Exception hiding (catch) -- ({-evaluate,-} Exception, IOException, SomeException(..))
+import Control.Lens (iso, Prism', preview, prism, review, _Right)
 import Control.Monad.Catch
 import Control.Monad.Except
---import Control.Monad.Reader (ReaderT)
---import Control.Monad.RWS (RWST)
---import Control.Monad.State (StateT)
---import Control.Monad.Writer (WriterT)
-import Data.Typeable (typeOf)
+import Control.Monad.Trans (MonadTrans(lift), liftIO)
+import Control.Monad.Except (ExceptT, runExceptT)
+import Data.Maybe (fromJust)
+import Data.Serialize
+import Data.Typeable (Typeable, typeOf)
+import Extra.ErrorControl
+#if !__GHCJS__
 import Extra.Log (logException, Priority(ERROR))
+#endif
+import Foreign.C.Types (CInt(..))
+import GHC.Generics (Generic)
+import GHC.IO.Exception (IOException(IOError), IOErrorType(..))
+import UnexceptionalIO.Trans
 
+deriving instance Generic CInt
+deriving instance Serialize CInt
+deriving instance Generic IOErrorType
+deriving instance Serialize IOErrorType
+deriving instance Generic IOException
+instance Serialize IOException where
+  put (IOError _handle a b c d e) = put a >> put b >> put c >> put d >> put e
+  get = uncurry6 IOError (pure Nothing, get, get, get, get, get)
+    where uncurry6 f (h, t, l, d, e, p) = f <$> h <*> t <*> l <*> d <*> e <*> p
+
 -- | Apply a function to whatever @Exception@ type is inside a
 -- @SomeException@:
 --
@@ -63,9 +85,14 @@
 tryError :: MonadError e m => m a -> m (Either e a)
 tryError action = (Right <$> action) `catchError` (pure . Left)
 
+-- | Absorb an ExceptT e' action into another MonadError instance.
+withError :: MonadError e m => (e' -> e) -> ExceptT e' m a -> m a
+withError f action = runExceptT (withExceptT f action) >>= liftEither
+
 -- | Modify the value (but not the type) of an error
-withError :: MonadError e m => (e -> e) -> m a -> m a
-withError f action = tryError action >>= either (throwError . f) return
+withError' :: MonadError e m => (e -> e) -> m a -> m a
+withError' f action = tryError action >>= either (throwError . f) return
+{-# DEPRECATED withError' "withError might to be able to do this job" #-}
 
 handleError :: MonadError e m => (e -> m a) -> m a -> m a
 handleError = flip catchError
@@ -104,105 +131,172 @@
 --
 -- >>> runExceptT (readFile' "/etc/nonexistant" :: ExceptT Error IO String)
 -- Left (Error /etc/nonexistant: openFile: does not exist (No such file or directory))
-class HasIOException e where fromIOException :: IOException -> e
+class HasIOException e where ioException :: Prism' e IOException
+instance HasIOException IOException where ioException = id
 
 newtype IOException' = IOException' IOException
 instance Show IOException' where show (IOException' e) = "(IOException' " <> show (show e) <> ")"
-instance HasIOException IOException' where fromIOException = IOException'
 
-#if 1
-
--- Newtype wrapper around values that are the result of an IO
--- operation invoked with try.  The Tried constructor is private
--- so it can only appear as the result of the lyftIO operation.
-newtype Tried a = Tried {unTried :: a} deriving Functor
-
-tryIO :: (MonadIO m, MonadCatch m, Exception e, MonadError e m) => m a -> ExceptT e m (Tried a)
-tryIO io = lift (try io >>= liftEither . fmap Tried)
+class HasErrorCall e where fromErrorCall :: ErrorCall -> e
+instance HasErrorCall ErrorCall where fromErrorCall = id
 
+#if !__GHCJS__
 logIOError :: (MonadIO m, MonadError e m) => m a -> m a
 logIOError = handleError (\e -> liftIO ($logException ERROR (pure e)) >> throwError e)
+#endif
 
-#else
+instance MonadCatch UIO where
+  catch uio f = unsafeFromIO $ catch (run uio) (\e -> run (f e))
+instance MonadThrow UIO where
+  throwM = unsafeFromIO . throwM
 
-class (MonadIO (IOMonad m),
-       -- The idea of LyftIO is to be a wrapper around a MonadIO
-       -- instance that is not itself a MonadIO instance. that means
-       -- you have to use lyftIO to run IO rather than liftIO, and
-       -- lyftIO always catches exceptions.
-       Exception (ErrorType m),
-       MonadCatch m,
-       MonadCatch (IOMonad m),
-       MonadError (ErrorType m) m,
-       MonadError (ErrorType m) (IOMonad m),
-       -- IOMonad m must have the same error type as m, this is
-       -- generally done through error constraints like
-       -- HasIOException.
-       HasIOException (ErrorType m)) => LyftIO m where
-  type ErrorType m
-  type IOMonad m :: * -> *
-  lyftIO :: IOMonad m a -> m a
+#if 0
+instance Unexceptional m => Unexceptional (ServerPartT m) where
+  lift = error "instance Unexceptional (ServerPartT m)"
+#endif
 
-instance {-# Overlapping #-} (MonadIO m,
-                              e ~ ErrorType m,
-                              Exception e,
-                              MonadCatch m,
-                              MonadError e (IOMonad (ExceptT e m)),
-                              HasIOException e) => LyftIO (ExceptT e m) where
-  type ErrorType (ExceptT e m) = e
-  type IOMonad (ExceptT e m) = m
-  lyftIO io = lift (try io >>= liftEither)
+instance MonadPlus UIO where
+  mzero = unsafeFromIO mzero
+  mplus a b = unsafeFromIO (mplus (run a) (run b))
+instance Alternative UIO where
+  empty = unsafeFromIO empty
+  a <|> b = unsafeFromIO (run a <|> run b)
 
-instance LyftIO m => LyftIO (ReaderT r m) where
-  type ErrorType (ReaderT r m) = ErrorType m
-  type IOMonad (ReaderT r m) = IOMonad m
-  lyftIO = lift . lyftIO
-instance LyftIO m => LyftIO (StateT s m) where
-  type ErrorType (StateT s m) = ErrorType m
-  type IOMonad (StateT s m) = IOMonad m
-  lyftIO = lift . lyftIO
-instance (Monoid w, LyftIO m) => LyftIO (WriterT w m) where
-  type ErrorType (WriterT w m) = ErrorType m
-  type IOMonad (WriterT w m) = IOMonad m
-  lyftIO = lift . lyftIO
-instance (Monoid w, LyftIO m) => LyftIO (RWST r w s m) where
-  type ErrorType (RWST r w s m) = ErrorType m
-  type IOMonad (RWST r w s m) = IOMonad m
-  lyftIO = lift . lyftIO
+#if 0
+-- | Like 'UnexceptionalIO.Trans.fromIO'', but lifts into any
+-- 'MonadError' instance rather than only ExceptT.
+lyftIO' ::
+  (Unexceptional m, Exception e, MonadError e m)
+  => (SomeNonPseudoException -> e)
+  -> IO a
+  -> m a
+lyftIO' f io =
+  runExceptT (fromIO' f io) >>= liftEither
+  -- withError id (fromIO' (view someNonPseudoException) io)
 
--- | LyftIO analog to the 'try' function.
-tryLiftIO :: LyftIO m => IOMonad m a -> m (Either (ErrorType m) a)
-tryLiftIO = tryError . lyftIO
+-- | Like 'lyftIO' but gets the function argument from the type class
+-- 'HasSomeNonPseudoException'.
+lyftIO ::
+  (Unexceptional m, Exception e, MonadError e m, HasSomeNonPseudoException e)
+  => IO a
+  -> m a
+lyftIO = lyftIO' (review someNonPseudoException)
+#endif
 
-logLiftIO :: forall m a. LyftIO m => m a -> m a
-logLiftIO = handleError (\e -> lyftIO ($logException ERROR (pure e) :: IOMonad m (ErrorType m)) >> throwError e)
+lyftIO' ::
+  forall e m a. (Unexceptional m, HasNonIOException e, HasIOException e, Exception e)
+  => IO a
+  -> ExceptT e m a
+lyftIO' io =
+  controlError
+    (fromIO io :: ExceptT SomeNonPseudoException m a)
+    (\(e :: SomeNonPseudoException) -> (maybe (throwError (review nonIOException e)) (\e' -> throwError (review ioException e')) (preview ioException e)))
 
-type LyftIO' m = (LyftIO m, IOMonad m ~ ExceptT (ErrorType m) IO)
+lyftIO ::
+  (Unexceptional m, Exception e, MonadError e m, HasNonIOException e, HasIOException e)
+  => IO a
+  -> m a
+lyftIO io = runExceptT (lyftIO' io) >>= either throwError return
 
--- | Lift an IO action into any LyftIO instance.  Well, almost any
--- LyftIO instance.
-lyftIO' :: forall m a. (LyftIO' m) => IO a -> m a
-lyftIO' io = lyftIO (withExceptT f (liftIO io))
-  where f :: IOException' -> ErrorType m
-        f = (fromIOException . (\(IOException' e) -> e))
+class HasSomeNonPseudoException e where
+  someNonPseudoException :: Prism' e SomeNonPseudoException
+instance HasSomeNonPseudoException SomeNonPseudoException where
+  someNonPseudoException = id
 
-type LyftIO2 e m = (LyftIO' m, e ~ ErrorType m)
+-- | This is an error that was caught by UnexceptionalIO and is not an
+-- IO exception.  It is stored as a SomeNonPseudoException (or should
+-- it be a SomeException?)
+class HasNonIOException e where
+  nonIOException :: Prism' e SomeNonPseudoException
 
--- | Lift an @IOMonad m a@ action into @m a@.
-lyftIO2 :: LyftIO2 e m => IOMonad m a -> m a
-lyftIO2 action = lyftIO action
+newtype NonIOException e = NonIOException {unNonIOException :: e}
 
--- Backwards compatibiity
+-- | A type we can derive from a 'SomeNonPseudoException' that has
+-- IOException and NonIOException instances.
+type SomeNonPseudoException' =
+  Either (NonIOException SomeNonPseudoException) IOException
 
-type MonadIOError e m = (LyftIO' m, e ~ ErrorType m)
+-- | An example of a type that splits a 'SomeNonPseudoException' into
+-- an IOException and a 'NonIOException'.  It happens to be an Iso'.
+instance HasNonIOException SomeNonPseudoException' where
+  nonIOException :: Prism' SomeNonPseudoException' SomeNonPseudoException
+  nonIOException = iso f g
+    where
+      f :: SomeNonPseudoException' -> SomeNonPseudoException
+      f = either unNonIOException (fromJust . fromException . toException)
+      g :: SomeNonPseudoException -> SomeNonPseudoException'
+      g e = maybe (Left (NonIOException e)) Right (fromException (toException e))
 
-liftIOError :: MonadIOError e m => IO a -> m a
-liftIOError = lyftIO'
+-- The HasIOException instance is easy.
+instance HasIOException SomeNonPseudoException' where
+  ioException = _Right
 
-tryIOError :: MonadIOError e m => IO a -> m (Either e a)
-tryIOError = tryError . liftIOError
+instance HasIOException SomeNonPseudoException where
+  ioException :: Prism' SomeNonPseudoException IOException
+  ioException = prism f g
+    where
+      f :: IOException -> SomeNonPseudoException
+      -- Because IOException is a non-pseudo exception this
+      -- fromException will return a Just
+      f = fromJust . fromException . toException
+      g :: SomeNonPseudoException -> Either SomeNonPseudoException IOException
+      g e = maybe (Left e) Right (fromException (toException e))
 
-logIOError :: MonadIOError e m => m a -> m a
-logIOError = handleError (\e -> liftIOError ($logException ERROR (pure e)) >> throwError e)
+-- Now use ErrorControl to handle the NonIOException and leave the IOException.
 
+instance Monad m => ErrorControl SomeNonPseudoException' (ExceptT SomeNonPseudoException' m) (ExceptT IOException m) where
+  controlError :: ExceptT SomeNonPseudoException' m a -> (SomeNonPseudoException' -> ExceptT IOException m a) -> ExceptT IOException m a
+  controlError ma f = mapExceptT (\ma' -> ma' >>= either (runExceptT . f) (pure . Right)) ma
+  accept :: ExceptT IOException m a -> ExceptT SomeNonPseudoException' m a
+  accept = withExceptT Right
+
+-- fromException :: Exception e => SomeException -> Maybe e
+-- toException :: Exception e => e -> SomeException
+
+-- | Convert a SomeNonPseudoException into any error type with
+-- both IOException and NonIOException instances.  This has a
+-- problem when you try to use 'accept' to convert an e back into
+-- a SomeNonPseudoException, so best not to use accept.
+#if 1
+instance (Monad m, HasIOException e, HasNonIOException e, {-Typeable e, Show e,-} Exception e)
+    => ErrorControl SomeNonPseudoException (ExceptT SomeNonPseudoException m) (ExceptT e m) where
+  controlError :: ExceptT SomeNonPseudoException m a -> (SomeNonPseudoException -> ExceptT e m a) -> ExceptT e m a
+  controlError ma f =
+    mapExceptT (\ma' -> ma' >>= either
+                                  (\e -> maybe
+                                           (runExceptT (f e))
+                                           (pure . Left . review ioException)
+                                           (fromException (toException e) :: Maybe IOException))
+                                  (pure . Right)) ma
+  accept :: ExceptT e m a -> ExceptT SomeNonPseudoException m a
+  accept = withExceptT convert
+    where convert :: e -> SomeNonPseudoException
+          convert e =
+            case preview ioException e of
+              Just ioe -> fromJust (fromException (toException ioe))
+              Nothing ->
+                case preview nonIOException e of
+                  Just e' -> e'
+                  -- If we can't use IOException or the NonIOException
+                  -- use the Exception instance.  I'm not fully certain
+                  -- what the implications of this happening are.
+                  Nothing -> fromJust (fromException (toException e))
+
+#else
+instance Monad m => ErrorControl SomeNonPseudoException (ExceptT SomeNonPseudoException m) (ExceptT IOException m) where
+  controlError :: ExceptT SomeNonPseudoException m a -> (SomeNonPseudoException -> ExceptT IOException m a) -> ExceptT IOException m a
+  controlError ma f =
+    -- My process...
+    -- (undefined :: ExceptT IOException m a)
+    -- mapExceptT (undefined :: m (Either SomeNonPseudoException a) -> m (Either IOException a)) ma
+    -- mapExceptT (\ma' -> ma' >>= (undefined :: (Either SomeNonPseudoException a) -> m (Either IOException a))) ma
+    -- mapExceptT (\ma' -> ma' >>= either (undefined :: SomeNonPseudoException -> m (Either IOException a)) (undefined :: a -> m (Either IOException a))) ma
+    -- mapExceptT (\ma' -> ma' >>= either ((undefined :: SomeException -> m (Either IOException a)) . toException) (pure . Right)) ma
+    -- mapExceptT (\ma' -> ma' >>= either (\e -> (undefined :: Maybe IOException -> m (Either IOException a)) $ fromException $ toException e) (pure . Right)) ma
+    -- mapExceptT (\ma' -> ma' >>= either (\e -> (maybe (undefined :: m (Either IOException a)) (undefined :: IOException -> m (Either IOException a))) $ fromException $ toException e) (pure . Right)) ma
+    -- mapExceptT (\ma' -> ma' >>= either (\(e :: SomeNonPseudoException) -> (maybe ((undefined :: ExceptT IOException m a -> m (Either IOException a)) (f e)) (pure . Left)) $ fromException $ toException e) (pure . Right)) ma
+    mapExceptT (\ma' -> ma' >>= either (\e -> maybe (runExceptT (f e)) (pure . Left) $ fromException $ toException e) (pure . Right)) ma
+  accept :: ExceptT IOException m a -> ExceptT SomeNonPseudoException m a
+  -- This will work because IOException is a non-pseudo exception
+  accept = withExceptT (fromJust . fromException . toException)
 #endif
diff --git a/Extra/Generics/Show.hs b/Extra/Generics/Show.hs
--- a/Extra/Generics/Show.hs
+++ b/Extra/Generics/Show.hs
@@ -36,7 +36,7 @@
 import Data.Proxy (Proxy(Proxy))
 import Generic.Data (gconIndex)
 import GHC.Generics as G
-import GHC.TypeLits
+--import GHC.TypeLits
 import Text.Show.Combinators (PrecShowS, {-ShowFields,-} noFields, showField, showListWith, showInfix, showApp, showCon, showRecord)
 import qualified Text.Show.Combinators as Show (appendFields)
 
@@ -77,7 +77,7 @@
 
 class                                       DoFields p f           where doFields :: forall a. p (Rd a) -> TypeTuple -> ConstrTuple -> f a -> [S1Result]
 instance (DoFields p f, DoFields p g) =>    DoFields p (f :*: g)   where doFields p ti ci (x :*: y) = doFields p ti ci x <> doFields p ti ci y
-instance (DoS1 p f, Selector s) =>          DoFields p (M1 S s f)  where doFields p ti ci (M1 x) = [doS1 p ti ci x]
+instance (DoS1 p f{-, Selector s-}) =>      DoFields p (M1 S s f)  where doFields p ti ci (M1 x) = [doS1 p ti ci x]
 instance                                    DoFields p U1          where doFields _ _ _ U1 = []
 
 class                                       DoNamed p f            where doNamed :: forall a. p (Rd a) -> TypeTuple -> ConstrTuple -> f a -> [(String, S1Result)]
@@ -88,15 +88,15 @@
 -- Its tempting to add the Constructor constraint here but it leads to
 -- a missing constraint on an unexported GHC.Generics class.
 class                                       DoConstructor p c f    where doConstructor :: forall a. p (Rd a) -> TypeTuple -> ConstrTuple -> M1 C c f a -> C1Result
-instance (DoFields p f, KnownSymbol s) =>   DoConstructor p ('MetaCons s y 'False) f
+instance (DoFields p f{-, KnownSymbol s-}) =>   DoConstructor p ('MetaCons s y 'False) f
                                                                    where doConstructor p ti ci (M1 x) = doNormal ti ci (zip [0..] (doFields p ti ci x))
 instance DoNamed p f =>   DoConstructor p ('MetaCons s y 'True) f  where doConstructor p ti ci (M1 x) = doRecord ti ci (zip [0..] (doNamed p ti ci x))
 
 class                                       DoDatatype p d f       where doDatatype :: forall a. p (Rd a) -> TypeTuple -> M1 D d f a -> D1Result
-instance (DoD1 p f, Datatype d) =>          DoDatatype p d f       where doDatatype p ti (M1 x) = doD1 p ti x
+instance (DoD1 p f{-, Datatype d-}) =>          DoDatatype p d f       where doDatatype p ti (M1 x) = doD1 p ti x
 
 class                                       DoD1 p f               where doD1 :: forall a. p (Rd a) -> TypeTuple -> f a -> D1Result
-instance (DoDatatype p d f, Datatype d) =>  DoD1 p (M1 D d f)      where doD1 p ti x@(M1 _) = doDatatype p ti x
+instance (DoDatatype p d f{-, Datatype d-}) =>  DoD1 p (M1 D d f)      where doD1 p ti x@(M1 _) = doDatatype p ti x
 instance (DoD1 p f, DoD1 p g) =>            DoD1 p (f :+: g)       where doD1 p ti (L1 x) = doD1 p ti x
                                                                          doD1 p ti (R1 y) = doD1 p ti y
 instance (Constructor c, DoConstructor p c f) => DoD1 p (M1 C c f) where doD1 p ti x = doConstructor p ti (gconIndex x, G.conName x, G.conFixity x) x
diff --git a/Extra/Log.hs b/Extra/Log.hs
--- a/Extra/Log.hs
+++ b/Extra/Log.hs
@@ -1,19 +1,24 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE CPP, TemplateHaskell #-}
 {-# OPTIONS -Wall #-}
 
 module Extra.Log
   ( alog
   , Priority(..)
+#if !__GHCJS__
   , logException
+  , logQ
+#endif
   ) where
 
 import Control.Monad.Except (MonadError(catchError, throwError))
 import Control.Monad.Trans (liftIO, MonadIO)
 import Data.Time (getCurrentTime)
 import Data.Time.Format (FormatTime(..), formatTime, defaultTimeLocale)
+#if !__GHCJS__
 import Language.Haskell.TH (ExpQ, Exp, Loc(..), location, pprint, Q)
-import Language.Haskell.TH.Instances ()
 import qualified Language.Haskell.TH.Lift as TH (Lift(lift))
+import Language.Haskell.TH.Instances ()
+#endif
 import System.Log.Logger (Priority(..), logM)
 
 alog :: MonadIO m => String -> Priority -> String -> m ()
@@ -38,6 +43,7 @@
 formatTimeCombined :: FormatTime t => t -> String
 formatTimeCombined = formatTime defaultTimeLocale "%d/%b/%Y:%H:%M:%S %z"
 
+#if !__GHCJS__
 -- | Create an expression of type (MonadIO m => Priority -> m a -> m
 -- a) that we can apply to an expression so that it catches, logs, and
 -- rethrows any exception.
@@ -52,3 +58,11 @@
 
 __LOC__ :: Q Exp
 __LOC__ = TH.lift =<< location
+
+logQ :: ExpQ
+logQ = do
+  loc <- location
+  [|\priority message ->
+       alog $(TH.lift (show (loc_module loc))) priority
+         ($(TH.lift (show (loc_module loc) <> ":" <> show (fst (loc_start loc)))) <> " - " <> message)|]
+#endif
diff --git a/Extra/Monad/Supply.hs b/Extra/Monad/Supply.hs
--- a/Extra/Monad/Supply.hs
+++ b/Extra/Monad/Supply.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -15,9 +16,12 @@
 , evalSupply
 , runSupplyT
 , runSupply
+, mapSupplyT
 , supplies
 ) where
 
+import Control.Exception (throw)
+import Control.Monad.Catch
 import Control.Monad.Fix
 import Control.Monad.Identity
 import Control.Monad.RWS
@@ -27,6 +31,7 @@
 import Control.Monad.Writer
 import Control.Monad.Morph (MFunctor(..))
 import qualified Data.Semigroup as Sem
+import Extra.ErrorControl
 
 class Monad m => MonadSupply s m | m -> s where
   supply :: m s
@@ -96,6 +101,18 @@
   mempty = return mempty
   mappend = (<>)
 
+instance ErrorControl e m n => ErrorControl e (SupplyT s m) (SupplyT s n) where
+  controlError :: SupplyT s m a -> (e -> SupplyT s n a) -> SupplyT s n a
+  controlError ma f = SupplyT (controlError (unSupplyT ma) (unSupplyT . f)) where unSupplyT (SupplyT s) = s
+  accept (SupplyT n) = SupplyT (accept n)
+
+instance (MonadCatch m, MonadIO m) => MonadCatch (SupplyT i m) where
+  catch (SupplyT io) f = SupplyT (catch io (unSupplyT . f))
+    where unSupplyT (SupplyT s) = s
+
+instance (MonadThrow m, MonadIO m) => MonadThrow (SupplyT i m) where
+  throwM = liftIO . throw
+
 -- | Get n supplies.
 supplies :: MonadSupply s m => Int -> m [s]
 supplies n = replicateM n supply
@@ -111,3 +128,6 @@
 
 runSupply :: Supply s a -> [s] -> (a,[s])
 runSupply (Supply s) = runIdentity . runSupplyT s
+
+mapSupplyT :: (m (a, [s]) -> n (b, [s])) -> SupplyT s m a -> SupplyT s n b
+mapSupplyT f (SupplyT s) = SupplyT (mapStateT f s)
diff --git a/Extra/Orphans.hs b/Extra/Orphans.hs
--- a/Extra/Orphans.hs
+++ b/Extra/Orphans.hs
@@ -46,7 +46,9 @@
 #else
 #endif
 
+#if !MIN_VERSION_network_uri(2,6,2)
 deriving instance Generic URIAuth
+#endif
 
 -- $(deriveLift ''UserId)
 instance Lift UserId where lift (UserId x0) = [|UserId $(lift x0)|]
@@ -54,7 +56,7 @@
 $(deriveLift ''G.Gr)
 $(deriveLift ''G.NodeMap)
 
-instance Ppr UserId where ppr = ptext . show
+instance Ppr UserId where ppr (UserId n) = ptext ("U" <> show n)
 
 #if !__GHCJS__
 instance Arbitrary T.Text where
diff --git a/Extra/Orphans2.hs b/Extra/Orphans2.hs
--- a/Extra/Orphans2.hs
+++ b/Extra/Orphans2.hs
@@ -14,7 +14,7 @@
 import Data.Generics (TyCon, TypeRep, tyConFingerprint, tyConModule, tyConName, tyConPackage, splitTyConApp)
 import Data.Int (Int32)
 import Data.List (intercalate)
-import Data.ListLike as LL
+import Data.ListLike as LL hiding (show)
 import Data.Map as Map (Map, toList)
 import Data.SafeCopy (SafeCopy(..))
 import Data.Set as Set (Set, toList)
diff --git a/Extra/Process.hs b/Extra/Process.hs
--- a/Extra/Process.hs
+++ b/Extra/Process.hs
@@ -43,7 +43,7 @@
 import Data.Text.Encoding (decodeUtf8)
 import Data.Time (diffUTCTime, getCurrentTime, NominalDiffTime)
 import Data.Typeable (typeOf)
-import Extra.Except -- (LyftIO(lyftIO, ErrorType), LyftIO', lyftIO', withError, withException)
+import Extra.Except
 import Extra.EnvPath (HasEnvRoot(envRootLens), rootPath)
 import Extra.Verbosity (ePutStrLn)
 import Extra.TH (here, prettyLocs)
@@ -102,7 +102,7 @@
     -> m (ExitCode, a, a)
 run opts p input = do
   start " -> " p
-  (result :: (ExitCode, a, a)) <- withError (withLoc $here) $ liftIO (readCreateProcessLazy p input) >>= overOutput >>= return . collectOutput
+  (result :: (ExitCode, a, a)) <- withError' (withLoc $here) $ liftIO (readCreateProcessLazy p input) >>= overOutput >>= return . collectOutput
   finish " <- " p result
   return result
     where
diff --git a/Extra/SafeCopy.hs b/Extra/SafeCopy.hs
--- a/Extra/SafeCopy.hs
+++ b/Extra/SafeCopy.hs
@@ -4,7 +4,6 @@
 -- message.  It also re-exports all other Data.Serialize symbols
 
 {-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE RankNTypes #-}
@@ -24,30 +23,16 @@
     ) where
 
 import Control.Exception (ErrorCall(..), evaluate, )
-import Control.Lens (Getter, _Left, over, Prism', prism, re)
+import Control.Lens (Getter, Prism', prism, re)
 import Control.Monad.Catch (catch, MonadCatch)
 import Control.Monad.Except (MonadError, throwError)
 import Data.ByteString as B (ByteString, null)
-#ifndef OMIT_DATA_INSTANCES
-import Data.Data (Data)
-#endif
-import Data.Data (Proxy(Proxy), Typeable, typeRep)
+import Data.Data (Proxy(Proxy), Typeable)
 import Data.SafeCopy (base, SafeCopy, safeGet, safePut)
 import Data.Serialize hiding (decode, encode)
-import qualified Data.Serialize as Serialize (decode, encode)
-import Data.Text as T hiding (concat, intercalate)
-import Data.Text.Lazy as LT hiding (concat, intercalate)
-import Data.Text.Encoding as TE
-import Data.Text.Lazy.Encoding as TLE
-import Data.Time (UTCTime(..), Day(ModifiedJulianDay), toModifiedJulianDay, DiffTime)
 import Data.UUID.Orphans ()
-import Data.UUID (UUID)
-import Data.UUID.Orphans ()
 import Extra.Orphans ()
-import Extra.Serialize (DecodeError(..), HasDecodeError(..))
-import Extra.Time (Zulu(..))
-import Language.Haskell.TH (Dec, Loc, TypeQ, Q)
-import Network.URI (URI(..), URIAuth(..))
+import Extra.Serialize (DecodeError(..), fakeTypeRep, HasDecodeError(fromDecodeError))
 import System.IO.Unsafe (unsafePerformIO)
 
 encode :: SafeCopy a => a -> ByteString
@@ -61,12 +46,12 @@
 
 -- | Monadic version of decode.
 decodeM ::
-  forall a e m. (SafeCopy a, HasDecodeError e, MonadError e m)
+  forall a e m. (SafeCopy a, Typeable a, HasDecodeError e, MonadError e m)
   => ByteString
   -> m a
 decodeM bs =
   case decode bs of
-    Left s -> throwError (fromDecodeError (DecodeError bs s))
+    Left s -> throwError (fromDecodeError (DecodeError bs (fakeTypeRep (Proxy @a)) s))
     Right a -> return a
 
 -- | Like 'decodeM', but also catches any ErrorCall thrown and lifts
@@ -75,16 +60,16 @@
 -- outside the serialize package, in which case this (and decode') are
 -- pointless.
 decodeM' ::
-  forall e m a. (SafeCopy a, HasDecodeError e, MonadError e m, MonadCatch m)
+  forall e m a. (SafeCopy a, Typeable a, HasDecodeError e, MonadError e m, MonadCatch m)
   => ByteString
   -> m a
 decodeM' bs = go `catch` handle
   where
     go = case decode bs of
-           Left s -> throwError (fromDecodeError (DecodeError bs s))
+           Left s -> throwError (fromDecodeError (DecodeError bs (fakeTypeRep (Proxy @a)) s))
            Right a -> return a
     handle :: ErrorCall -> m a
-    handle (ErrorCall s) = throwError $ fromDecodeError $ DecodeError bs s
+    handle (ErrorCall s) = throwError $ fromDecodeError $ DecodeError bs (fakeTypeRep (Proxy @a)) s
 
 -- | Version of decode that catches any thrown ErrorCall and modifies
 -- its message.
diff --git a/Extra/SafeCopyDebug.hs b/Extra/SafeCopyDebug.hs
--- a/Extra/SafeCopyDebug.hs
+++ b/Extra/SafeCopyDebug.hs
@@ -45,6 +45,7 @@
 import Data.UUID.Orphans ()
 import Extra.Orphans ()
 import Extra.SafeCopy hiding (decode, decode', decodeM, decodeM')
+import Extra.Serialize (fakeTypeRep)
 import Extra.SerializeDebug (Debug, DecodeError(..), HasDecodeError(..))
 import Extra.Time (Zulu(..))
 import Language.Haskell.TH (Dec, Loc, TypeQ, Q)
@@ -64,7 +65,7 @@
   -> m a
 decodeM bs =
   case decode bs of
-    Left s -> throwError (fromDecodeError (DecodeError bs s))
+    Left s -> throwError (fromDecodeError (DecodeError bs (fakeTypeRep (Proxy @a)) s))
     Right a -> return a
 
 -- | Like 'decodeM', but also catches any ErrorCall thrown and lifts
@@ -79,10 +80,10 @@
 decodeM' bs = go `catch` handle
   where
     go = case decode bs of
-           Left s -> throwError (fromDecodeError (DecodeError bs s))
+           Left s -> throwError (fromDecodeError (DecodeError bs (fakeTypeRep (Proxy @a)) s))
            Right a -> return a
     handle :: ErrorCall -> m a
-    handle (ErrorCall s) = throwError $ fromDecodeError $ DecodeError bs s
+    handle (ErrorCall s) = throwError $ fromDecodeError $ DecodeError bs (fakeTypeRep (Proxy @a)) s
 
 -- | Version of decode that catches any thrown ErrorCall and modifies
 -- its message.
diff --git a/Extra/Serialize.hs b/Extra/Serialize.hs
--- a/Extra/Serialize.hs
+++ b/Extra/Serialize.hs
@@ -12,10 +12,13 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Extra.Serialize
     ( DecodeError(..)
     , HasDecodeError(fromDecodeError)
+    -- , HasDecodeFailure
+    -- , decodeFailure, fromDecodeFailure
     , module Data.Serialize
     , decodePrism, deserializePrism
     , encodeGetter, serializeGetter
@@ -25,10 +28,11 @@
     , decode'
     , decodeM
     , decodeM'
+    , FakeTypeRep(..), fakeTypeRep
     ) where
 
 import Control.Exception (ErrorCall(..), evaluate, )
-import Control.Lens (Getter, _Left, over, Prism', prism, re)
+import Control.Lens (Getter, Prism', prism, re, review)
 import Control.Monad.Catch (catch, MonadCatch)
 import Control.Monad.Except (MonadError, throwError)
 import Data.ByteString as B (ByteString, null)
@@ -36,17 +40,19 @@
 import Data.Data (Data)
 #endif
 import Data.Data (Proxy(Proxy))
-import Data.SafeCopy (base, SafeCopy(..), safeGet, safePut)
+import Data.SafeCopy (SafeCopy(..), safeGet, safePut)
 import Data.Serialize hiding (decode, encode)
-import qualified Data.Serialize as Serialize (decode, encode)
+import qualified Data.Serialize as Serialize (encode)
 import Data.Text as T hiding (concat, intercalate)
 import Data.Text.Lazy as LT hiding (concat, intercalate)
 import Data.Text.Encoding as TE
 import Data.Text.Lazy.Encoding as TLE
 import Data.Time (UTCTime(..), Day(ModifiedJulianDay), toModifiedJulianDay, DiffTime)
+import Data.Typeable (Typeable, typeRep)
 import Data.UUID.Orphans ()
 import Data.UUID (UUID)
 import Data.UUID.Orphans ()
+import qualified Extra.Errors as Errors
 import Extra.Orphans ()
 import Extra.Time (Zulu(..))
 import GHC.Generics (Generic)
@@ -54,12 +60,29 @@
 import Network.URI (URI(..), URIAuth(..))
 import System.IO.Unsafe (unsafePerformIO)
 
-data DecodeError = DecodeError ByteString String deriving (Generic, Eq, Ord)
+newtype FakeTypeRep = FakeTypeRep String deriving (Generic, Eq, Ord, Serialize)
+instance SafeCopy FakeTypeRep
+fakeTypeRep :: forall a. Typeable a => Proxy a -> FakeTypeRep
+fakeTypeRep a = FakeTypeRep (show (typeRep a))
 
+data DecodeError = DecodeError ByteString FakeTypeRep String deriving (Generic, Eq, Ord, Typeable)
+
+instance Serialize DecodeError where get = safeGet; put = safePut
+
 class HasDecodeError e where fromDecodeError :: DecodeError -> e
 instance HasDecodeError DecodeError where fromDecodeError = id
-instance Serialize DecodeError where get = safeGet; put = safePut
 
+#if 0
+-- New name for backwards compatibility, especially in appraisalscribe-migrate.
+type HasDecodeFailure e = Errors.Member DecodeError e
+decodeFailure :: Errors.Member DecodeError e => Prism' (Errors.OneOf e) DecodeError
+decodeFailure = Errors.follow
+fromDecodeFailure :: Errors.Member DecodeError e => DecodeError -> Errors.OneOf e
+fromDecodeFailure = review decodeFailure
+#endif
+
+-- instance Member DecodeError DecodeError where follow = id
+
 encode :: Serialize a => a -> ByteString
 encode = Serialize.encode
 
@@ -124,12 +147,12 @@
 
 -- | Monadic version of decode.
 decodeM ::
-  forall a e m. (Serialize a, HasDecodeError e, MonadError e m)
+  forall a e m. (Serialize a, Typeable a, HasDecodeError e, MonadError e m)
   => ByteString
   -> m a
 decodeM bs =
   case decode bs of
-    Left s -> throwError (fromDecodeError (DecodeError bs s))
+    Left s -> throwError (fromDecodeError (DecodeError bs (fakeTypeRep (Proxy @a)) s))
     Right a -> return a
 
 -- | Like 'decodeM', but also catches any ErrorCall thrown and lifts
@@ -138,16 +161,16 @@
 -- outside the serialize package, in which case this (and decode') are
 -- pointless.
 decodeM' ::
-  forall e m a. (Serialize a, HasDecodeError e, MonadError e m, MonadCatch m)
+  forall e m a. (Serialize a, Typeable a, HasDecodeError e, MonadError e m, MonadCatch m)
   => ByteString
   -> m a
 decodeM' bs = go `catch` handle
   where
     go = case decode bs of
-           Left s -> throwError (fromDecodeError (DecodeError bs s))
+           Left s -> throwError (fromDecodeError (DecodeError bs (fakeTypeRep (Proxy @a)) s))
            Right a -> return a
     handle :: ErrorCall -> m a
-    handle (ErrorCall s) = throwError $ fromDecodeError $ DecodeError bs s
+    handle (ErrorCall s) = throwError $ fromDecodeError $ DecodeError bs (fakeTypeRep (Proxy @a)) ("ErrorCall: " <> s)
 
 -- | Version of decode that catches any thrown ErrorCall and modifies
 -- its message.
@@ -178,9 +201,11 @@
 instance SafeCopy DecodeError where version = 1
 
 #ifndef OMIT_DATA_INSTANCES
+deriving instance Data FakeTypeRep
 deriving instance Data DecodeError
 #endif
 
 #ifndef OMIT_SHOW_INSTANCES
+deriving instance Show FakeTypeRep
 deriving instance Show DecodeError
 #endif
diff --git a/Extra/SerializeDebug.hs b/Extra/SerializeDebug.hs
--- a/Extra/SerializeDebug.hs
+++ b/Extra/SerializeDebug.hs
@@ -16,7 +16,8 @@
     ( module Extra.Serialize
     , Debug
     , DecodeError(..)
-    , HasDecodeError(fromDecodeError)
+    , HasDecodeError
+    , fromDecodeError
     , deserializePrism
     , serializeGetter
     , decode
@@ -71,7 +72,7 @@
   -> m a
 decodeM bs =
   case decode bs of
-    Left s -> throwError (fromDecodeError (DecodeError bs s))
+    Left s -> throwError (fromDecodeError (DecodeError bs (fakeTypeRep (Proxy @a)) s))
     Right a -> return a
 
 -- | Like 'decodeM', but also catches any ErrorCall thrown and lifts
@@ -86,10 +87,10 @@
 decodeM' bs = go `catch` handle
   where
     go = case decode bs of
-           Left s -> throwError (fromDecodeError (DecodeError bs s))
+           Left s -> throwError (fromDecodeError (DecodeError bs (fakeTypeRep (Proxy @a)) s))
            Right a -> return a
     handle :: ErrorCall -> m a
-    handle (ErrorCall s) = throwError $ fromDecodeError $ DecodeError bs s
+    handle (ErrorCall s) = throwError $ fromDecodeError $ DecodeError bs (fakeTypeRep (Proxy @a)) s
 
 -- | Version of decode that catches any thrown ErrorCall and modifies
 -- its message.
diff --git a/Extra/Text.hs b/Extra/Text.hs
--- a/Extra/Text.hs
+++ b/Extra/Text.hs
@@ -1,7 +1,8 @@
 {-# LANGUAGE CPP, RankNTypes #-}
 
 module Extra.Text
-    ( diffText
+    ( Texty(textyString, textyText, textyLazy)
+    , diffText
     , camelWords
     , capitalize
     , Describe(describe')
@@ -16,12 +17,39 @@
 import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff)
 import Data.Char (isUpper, toUpper)
 import Data.ListLike (groupBy)
+import Data.String (IsString)
 import Data.Text (split, Text, pack, unpack)
+import qualified Data.Text.Lazy as Lazy ( fromStrict, pack, Text, toStrict, unpack )
 #if !__GHCJS__
 import Test.HUnit (assertEqual, Test(TestCase, TestList))
 #endif
 import qualified Text.PrettyPrint as HPJ
+-- * Texty
 
+class (IsString a, Monoid a) => Texty a where
+  textyString :: String -> a
+  textyText :: Text -> a
+  textyLazy :: Lazy.Text -> a
+
+instance Texty Text where
+  textyString = pack
+  textyText = id
+  textyLazy = Lazy.toStrict
+
+instance Texty String where
+  textyString = id
+  textyText = unpack
+  textyLazy = Lazy.unpack
+
+instance Texty Lazy.Text where
+  textyString = Lazy.pack
+  textyText = Lazy.fromStrict
+  textyLazy = id
+
+-- | The ever needed, never available show that returns a Text.
+textshow :: (Texty text, Show a) => a -> text
+textshow = textyString . show
+
 -- | Output the difference between two string in the style of diff(1).  This
 -- can be used with Test.HUnit.assertString:  assertString (diffText ("a", "1\n2\n3\n"), ("b", "1\n3\n"))
 diffText :: (String, Text) -> (String, Text) -> String
@@ -69,7 +97,3 @@
 -- | Truncate a string to avoid writing monster lines into the log.
 trunc :: String -> String
 trunc s = if length s > 1000 then take 1000 s ++ "..." else s
-
--- | The ever needed, never available show that returns a Text.
-textshow :: Show a => a -> Text
-textshow = pack . show
diff --git a/sr-extra.cabal b/sr-extra.cabal
--- a/sr-extra.cabal
+++ b/sr-extra.cabal
@@ -1,5 +1,5 @@
 Name:           sr-extra
-Version:        1.64
+Version:        1.72.1
 License:        BSD3
 License-File:   COPYING
 Author:         David Fox
@@ -28,6 +28,10 @@
    that we will use SafeCopy instances instead.
   Default: False
 
+flag omit-data
+  Description: Omit all Data instances
+  Default: False
+
 Library
   GHC-Options: -Wall -Wredundant-constraints
   Build-Depends:
@@ -59,6 +63,8 @@
     th-lift-instances,
     th-orphans,
     time >= 1.1,
+    transformers,
+    unexceptionalio-trans,
     unix,
     Unixutils >= 1.51,
     userid,
@@ -78,6 +84,9 @@
     Extra.Debug2,
     Extra.Either,
     Extra.EnvPath,
+    Extra.ErrorControl,
+    Extra.Errors,
+    Extra.ErrorSet,
     Extra.Except,
     Extra.Exit,
     Extra.Files,
@@ -127,6 +136,9 @@
     Build-Depends: network-uri >= 2.6
   else
     Build-Depends: network >= 2.4
+
+  if flag(omit-data)
+    CPP-Options: -DOMIT_DATA_INSTANCES
 
   if flag(omit-serialize)
     CPP-Options: -DOMIT_SERIALIZE