diff --git a/Extra/CIO.hs b/Extra/CIO.hs
deleted file mode 100644
--- a/Extra/CIO.hs
+++ /dev/null
@@ -1,308 +0,0 @@
--- |CIO is a type class for the TIO monad, which tracks the cursor
--- position of the console so that indentation and prefixes can be
--- added to the output.  TIO also has a style component which lets you
--- control the output verbosity and the appearance of the prefix.
--- There is an instance for the regular IO monad which doesn't use any
--- of these features, to allow functions which do not use the TIO
--- monad call functions in the Debian library.
---
--- NOTE: a copy of this library is in the Extra library as
--- well. Please update both locations.
--- 
--- This code is provided for backwards compatibility, I don't
--- endorse its use in new projects.
-module Extra.CIO  {-# DEPRECATED "Use System.Unix.QIO in Unixutils." #-}
-    ( -- * The CIO class
-      CIO(..)
-
-    -- * Style constructors and transformers
-    , TStyle(..)
-    , defStyle
-    , withStyle
-
-    , setVerbosity
-    , addVerbosity
-    , setPrefix
-    , addPrefix
-    , appPrefix
-    , setPrefixes
-    , addPrefixes
-    , appPrefixes
-    , hGetPrefix
-
-    -- * Output functions
-    , putStr
-    , ePutStr
-    , vPutStr
-    , vEPutStr
-
-    , hPutChar
-    , putChar
-    , ePutChar
-    , vHPutChar
-    , vPutChar
-    , vEPutChar
-
-    , hPutStrBl
-    , putStrBl
-    , ePutStrBl
-    , vHPutStrBl
-    , vPutStrBl
-    , vEPutStrBl
-
-    , hPutStrLn
-    , putStrLn
-    , ePutStrLn
-    , vHPutStrLn
-    , vPutStrLn
-    , vEPutStrLn
-
-    , bol
-    , eBOL
-    , vHBOL
-    , vBOL
-    , vEBOL
-
-    , hColor
-    , blue
-    , green
-    , red
-    , magenta
-    ) where
-
-import Prelude hiding (putStr, putChar, putStrLn)
-import qualified System.IO as IO
-import Control.Monad.Trans
-import Control.Exception
-
--- |Class representing ways of doing console (terminal?) output.
-class MonadIO m => CIO m where
-    -- |Write output to a handle.
-    hPutStr :: IO.Handle -> String -> m ()
-    -- |If we are not already at the beginning of a line, move the cursor
-    -- to the beginning of the next one.
-    hBOL :: IO.Handle -> m ()
-    -- |Return the \"effective verbosity\" for a task.  If the argument
-    -- is 2 it means the caller is computing ev for a task that
-    -- normally does output when the verbosity level is 2 or higher.
-    -- If the verbosity of the current style is 1, then the ev or
-    -- effective verbosity is 2-1 = -1, so the output should be
-    -- quieter.
-    ev :: Int -> m Int
-    -- |Modify the current output style.
-    setStyle :: (TStyle -> TStyle) -> m a -> m a
-    -- |Implementation of try for this monad
-    tryCIO :: m a -> m (Either SomeException a)
-
--- |A record used to hold the output style information for a task.
--- This The prefixes that will appear at the beginning of each line,
--- and the desired verbosity level.  Suggested verbosity level policy:
---
---  * -1: No output of any kind, as if you were directing all output to /dev/null
--- 
---  * 0: Error output only, suitable for a run whose log you might examine later
--- 
---  * 1: casual progress reporting - if you were running on a console but didn't
---      expect anything to go wrong
---
---  * 2: detailed progress reporting - show more progress, particularly things
---      that might fail during the normal operation of the autobuilder: patches
---      that fail to apply, dpkg-buildpackage runs that return errors, etc.
---
---  * 3: Debugging output - use this level or higher if you suspect the
---      autobuilder itself is failing, or you are doing development work on
---      the autobuilder.
-data TStyle
-    = TStyle { prefix :: String			-- ^ Add this string at the beginning of each line
-             , verbosity :: Int			-- ^ Ignore v functions whose argument is more than this
-             , hPrefix :: [(IO.Handle, String)]	-- ^ Per-handle prefix
-             } deriving Show
-
-defStyle :: TStyle
-defStyle = TStyle { prefix = ": "
-                  , hPrefix = []
-                  , verbosity = 0
-                  }
-
--- |Use a new style for the TIO action
-withStyle :: CIO m => TStyle -> m a -> m a
-withStyle newStyle = setStyle (const newStyle)
-
-setVerbosity :: Int -> TStyle -> TStyle
-setVerbosity n style = style {verbosity = n}
-addVerbosity :: Int -> TStyle -> TStyle
-addVerbosity n style = setVerbosity (n + verbosity style) style
-
--- |Set the output style for a handle to prefixed.
-setPrefix :: String -> TStyle -> TStyle
-setPrefix prefix style = style {prefix = prefix}
-
--- | Prepend some text to the prefix.
-addPrefix :: String -> TStyle -> TStyle
-addPrefix newPrefix style = style {prefix = newPrefix ++ prefix style}
-
--- | Append some text to the prefix.
-appPrefix :: String -> TStyle -> TStyle
-appPrefix newPrefix style = style {prefix = prefix style ++ newPrefix}
-
-hSetPrefix :: IO.Handle -> String -> TStyle -> TStyle
-hSetPrefix handle string style =
-    style {hPrefix = (handle, string) : filter ((/= handle) . fst) (hPrefix style)}
-
-hAddPrefix :: IO.Handle -> String -> TStyle -> TStyle
-hAddPrefix handle string style =
-    hSetPrefix handle (string ++ prefix) style
-    where prefix = maybe "" id (lookup handle (hPrefix style))
-
-hAppPrefix :: IO.Handle -> String -> TStyle -> TStyle
-hAppPrefix handle string style =
-    hSetPrefix handle (prefix ++ string) style
-    where prefix = maybe "" id (lookup handle (hPrefix style))
-
--- |Get the current prefix for a particular handle
-hGetPrefix :: IO.Handle -> TStyle -> String
-hGetPrefix handle style = prefix style ++ maybe "" id (lookup handle (hPrefix style))
-
--- |Set the output style for the stdout and stderr handle to prefixed,
--- using whatever prefixes were most recently set (default is [1] and [2].)
-setPrefixes :: String -> String -> TStyle -> TStyle
-setPrefixes stdoutPrefix stderrPrefix style =
-    hSetPrefix IO.stdout stdoutPrefix . hSetPrefix IO.stderr stderrPrefix $ style
-
--- |Switch to prefixed mode and modify both the stdout and stderr prefixes.
-addPrefixes :: String -> String -> TStyle -> TStyle
-addPrefixes oPrefix ePrefix style =
-    hAddPrefix IO.stdout oPrefix . hAddPrefix IO.stderr ePrefix $ style
-
-appPrefixes :: String -> String -> TStyle -> TStyle
-appPrefixes oPrefix ePrefix style =
-    hAppPrefix IO.stdout oPrefix . hAppPrefix IO.stderr ePrefix $ style
-
--- |Perform an action if the effective verbosity level is >= 0,
--- otherwise return the default value d.
-vIO :: CIO m => Int -> a -> m a -> m a
-vIO v d f =
-    do v' <- ev v
-       if v' >= 0 then f else return d
-
--- |Write a string to stdout.
-putStr :: CIO m => String -> m ()
-putStr = hPutStr IO.stdout
-
--- |Write a string to stderr.
-ePutStr :: CIO m => String -> m ()
-ePutStr = hPutStr IO.stderr
-
--- |Verbosity controlled version of ePutStr
-vEPutStr :: CIO m => Int -> String -> m ()
-vEPutStr = vHPutStr IO.stderr
-
--- |Write a string to stdout depending on the verbosity level.
-vPutStr :: CIO m => Int -> String -> m ()
-vPutStr = vHPutStr IO.stdout
-
--- |Write a character.
-hPutChar :: CIO m => IO.Handle -> Char -> m ()
-hPutChar h c = hPutStr h [c]
-
--- |Write a character to stdout.
-putChar :: CIO m => Char -> m ()
-putChar = hPutChar IO.stdout
-
--- |Write a character to stderr.
-ePutChar :: CIO m => Char -> m ()
-ePutChar = hPutChar IO.stderr
-
--- |Verbosity controlled version of hPutStr
-vHPutStr :: CIO m => IO.Handle -> Int -> String -> m ()
-vHPutStr h v s = vIO v () (hPutStr h s)
-
--- |Verbosity controlled version of hPutChar.
-vHPutChar :: CIO m => IO.Handle -> Int -> Char -> m ()
-vHPutChar h v c = vHPutStr h v [c]
-
--- |Verbosity controlled version of putChar
-vPutChar :: CIO m => Int -> Char -> m ()
-vPutChar = vHPutChar IO.stdout
-
--- |Verbosity controlled version of ePutChar
-vEPutChar :: CIO m => Int -> Char -> m ()
-vEPutChar = vHPutChar IO.stderr
-
--- |Move to beginning of next line (if necessary) and output a string.
-hPutStrBl :: CIO m => IO.Handle -> String -> m ()
-hPutStrBl h s = hBOL h >> hPutStr h s
-
--- |hPutStrBl to stdout.
-putStrBl :: CIO m => String -> m ()
-putStrBl = hPutStrBl IO.stdout
-
--- |hPutStrBl to stderr.
-ePutStrBl :: CIO m => String -> m ()
-ePutStrBl = hPutStrBl IO.stderr
-
--- |Verbosity controlled version of hPutStrBl
-vHPutStrBl :: CIO m => IO.Handle -> Int -> String -> m ()
-vHPutStrBl h v s = vHBOL h v >> vHPutStr h v s
-
--- |Verbosity controlled version of putStrBl
-vPutStrBl :: CIO m => Int -> String -> m ()
-vPutStrBl = vHPutStrBl IO.stdout          
-
--- |Verbosity controlled version of ePutStrBl
-vEPutStrBl :: CIO m => Int -> String -> m ()
-vEPutStrBl = vHPutStrBl IO.stderr
-
--- |Write a newline character and a string.
-hPutStrLn :: CIO m => IO.Handle -> String -> m ()
-hPutStrLn h s = hBOL h >> hPutStr h s
-
--- |hPutStrLn to stdout.
-putStrLn :: CIO m => String -> m ()
-putStrLn s = hPutStrLn IO.stdout s
-
--- |hPutStrLn to stderr.
-ePutStrLn :: CIO m => String -> m ()
-ePutStrLn = hPutStrLn IO.stderr
-
--- |Verbosity controlled version of hPutStrLn.
-vHPutStrLn :: CIO m => IO.Handle -> Int -> String -> m ()
-vHPutStrLn h v s = vHBOL h v >> vHPutStr h v s
-
--- |Verbosity controlled version of putStrLn
-vPutStrLn :: CIO m => Int -> String -> m ()
-vPutStrLn = vHPutStrLn IO.stdout          
-
--- |Verbosity controlled version of ePutStrLn
-vEPutStrLn :: CIO m => Int -> String -> m ()
-vEPutStrLn = vHPutStrLn IO.stderr
-
--- |hBOL to stdout.
-bol :: CIO m => m ()
-bol = hBOL IO.stdout
-
--- |hBOL to stderr.
-eBOL :: CIO m => m ()
-eBOL = hBOL IO.stderr
-
-vHBOL :: CIO m => IO.Handle -> Int -> m ()
-vHBOL h v = vIO v () (hBOL h)
-
--- |Verbosity controlled version of BOL
-vBOL :: CIO m => Int -> m ()
-vBOL = vHBOL IO.stdout
-
--- |Verbosity controlled version of eBOL
-vEBOL :: CIO m => Int -> m ()
-vEBOL = vHBOL IO.stderr
-
--- These only work in a terminal, not in an emacs shell.
-hColor h s = case h of
-               _ | h == IO.stdout -> green s
-               _ | h == IO.stdout -> red s
-               _ -> magenta s
-
-blue s = "\ESC[34m" ++ s ++ "\ESC[30m"
-green s = "\ESC[32m" ++ s ++ "\ESC[30m"
-red s = "\ESC[31m" ++ s ++ "\ESC[30m"
-magenta s = "\ESC[35m" ++ s ++ "\ESC[30m"
diff --git a/Extra/Debug.hs b/Extra/Debug.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Debug.hs
@@ -0,0 +1,85 @@
+-- | Declarations pulled out of th-unify
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Extra.Debug
+    ( HasMessageInfo(..)
+    , Verbosity(message)
+    , quietly, noisily, indented
+    , R(..))
+    where
+
+import Control.Lens (Lens', makeLenses, over, view)
+import Control.Monad (when)
+import Control.Monad.Reader (local, MonadReader, ReaderT)
+import Control.Monad.RWS (RWST)
+import Control.Monad.Trans (MonadIO(liftIO))
+import Data.Char (isSpace)
+import Data.List (dropWhileEnd, intercalate)
+import Instances.TH.Lift ()
+import Language.Haskell.TH.Instances ()
+import System.IO (hPutStrLn, stderr)
+
+class HasMessageInfo a where
+    verbosity :: Lens' a Int
+    prefix :: Lens' a String
+
+-- | Class of monads with a verbosity level and a stored indentation string.
+class (HasMessageInfo r, MonadReader r m) => Verbosity r m where
+  message :: Int -> String -> m ()
+  -- ^ If the monad's verbosity level exceeds the verbosity argument,
+  -- prepend the current indentation string to the lines of a message
+  -- and output it.
+
+instance (MonadIO m, HasMessageInfo r, Monoid w) => Verbosity r (RWST r w s m) where
+  message minv s = do
+    v <- view verbosity
+    p <- view prefix
+    when (v >= minv) $ (liftIO . hPutStrLn stderr . indent p) s
+
+instance (MonadIO m, HasMessageInfo r) => Verbosity r (ReaderT r m) where
+  message minv s = do
+    v <- view verbosity
+    p <- view prefix
+    liftIO $ putStrLn ("v=" ++ show v ++ " vmin=" ++ show minv)
+    when (v >= minv) $ (liftIO . putStrLn . indent p) s
+
+-- | Indent the lines of a message with a prefix
+indent :: String -> String -> String
+indent pre s = intercalate "\n" $ fmap (dropWhileEnd isSpace . (pre ++)) (lines s)
+
+-- | If the current verbosity level is >= minv perform the action with
+-- additional indentation.
+indented :: (HasMessageInfo r, MonadReader r m) => Int -> m a -> m a
+indented minv action = do
+  (v :: Int) <- view verbosity
+  if v >= minv then local (over prefix ("  " ++)) action else action
+
+-- | Perform the action with reduced verbosity
+quietly :: (HasMessageInfo r, MonadReader r m) => Int -> m a -> m a
+quietly n = local (over verbosity (\i -> i - n))
+
+-- | Perform the action with increased verbosity
+noisily :: (HasMessageInfo r, MonadReader r m) => Int -> m a -> m a
+noisily n = local (over verbosity (+ n))
+
+-- | A type with a HasMessageInfo instance to use in the Reader or RWS monad.
+data R
+    = R
+      { _verbosityR :: Int
+      , _prefixR :: String
+      }
+
+$(makeLenses ''R)
+
+instance HasMessageInfo R where
+    verbosity = verbosityR
+    prefix = prefixR
diff --git a/Extra/Debug2.hs b/Extra/Debug2.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Debug2.hs
@@ -0,0 +1,61 @@
+-- | Generate debug messages - verbosity controls, indentation.
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS -Wall -Wredundant-constraints #-}
+
+module Extra.Debug2
+    ( HasTraceInfo(verbosityLens, prefixLens)
+    , message
+    , trace
+    , indented
+    , verbosity
+    ) where
+
+import Control.Lens ((%=), (.=), Lens', use)
+import Control.Monad (when)
+import Control.Monad.RWS
+import Data.List (intercalate)
+import qualified Debug.Trace
+import Language.Haskell.TH.Instances ()
+import System.Log.Logger (Priority(..))
+
+-- Perform an action with modified state.
+bracketState :: MonadState s m => Lens' s a -> (a -> a) -> m r -> m r
+bracketState lns f action = do
+  a0 <- use lns
+  lns %= f
+  r <- action
+  lns .= a0
+  return r
+
+class HasTraceInfo a where
+    verbosityLens :: Lens' a Priority
+    prefixLens :: Lens' a String
+
+-- | If the verbosity argument monad's verbosity level exceeds the verbosity argument,
+-- prepend the current indentation string to the lines of a message
+-- and output it.
+message :: (HasTraceInfo s, MonadState s m) => (String -> m ()) -> Priority -> String -> m ()
+message f p s = do
+  v <- use verbosityLens
+  when (p >= v) $ do
+    i <- use prefixLens
+    f (intercalate "\n" $ fmap (i ++) (lines s))
+
+trace :: (HasTraceInfo s, MonadState s m) => String -> m ()
+trace = message (\s -> Debug.Trace.trace s (return ())) DEBUG
+
+-- | Perform an action with added indentation
+indented :: (HasTraceInfo s, MonadState s m) => String -> m r -> m r
+indented s action = bracketState prefixLens (<> s) action
+
+-- | Perform an action with modified verbosity
+verbosity :: (HasTraceInfo s, MonadState s m) => Priority -> m r -> m r
+verbosity v action = bracketState verbosityLens (const v) action
diff --git a/Extra/Either.hs b/Extra/Either.hs
--- a/Extra/Either.hs
+++ b/Extra/Either.hs
@@ -1,20 +1,11 @@
 module Extra.Either where
 
-import Data.Either (partitionEithers, rights)
-
-isRight (Right _) = True
-isRight (Left _) = False
-
-isLeft = not . isRight
+import Data.Either
 
 -- |Turn a list of eithers into an either of lists
 concatEithers :: [Either a b] -> Either [a] [b]
 concatEithers xs =
-    case partitionEithers xs of 
+    case partitionEithers xs of
       ([], rs) -> Right rs
       (ls, _) -> Left ls
-
-{-# DEPRECATED rightOnly "Use rights" #-}
-rightOnly = rights
-{-# DEPRECATED eitherFromList "Use concatEithers" #-}
-eitherFromList = concatEithers
+{-# DEPRECATED concatEithers "This is terrible.  Delete your account." #-}
diff --git a/Extra/EnvPath.hs b/Extra/EnvPath.hs
new file mode 100644
--- /dev/null
+++ b/Extra/EnvPath.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE FlexibleInstances, StandaloneDeriving, TemplateHaskell, TypeSynonymInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Extra.EnvPath
+    ( EnvRoot(..), rootPath
+    , EnvPath(..), envRoot, envPath
+    , outsidePath
+    , appendPath
+    , rootEnvPath
+    , HasEnvRoot(envRootLens)
+    ) where
+
+import Control.Lens (Lens', makeLenses, over)
+import Extra.Pretty (PP(PP))
+import Text.PrettyPrint.HughesPJClass (text)
+import Distribution.Pretty (Pretty(pretty))
+
+-- |The root directory of an OS image.
+data EnvRoot = EnvRoot { _rootPath :: FilePath } deriving (Ord, Eq, Read, Show)
+
+-- |A directory inside of an OS image.
+data EnvPath = EnvPath { _envRoot :: EnvRoot
+                       , _envPath :: FilePath
+                       } deriving (Ord, Eq, Read, Show)
+
+$(makeLenses ''EnvRoot)
+$(makeLenses ''EnvPath)
+
+outsidePath :: EnvPath -> FilePath
+outsidePath path = _rootPath (_envRoot path) ++ _envPath path
+
+appendPath :: FilePath -> EnvPath -> EnvPath
+appendPath suff path = over envPath (++ suff) path
+
+rootEnvPath :: FilePath -> EnvPath
+rootEnvPath s = EnvPath { _envRoot = EnvRoot "", _envPath = s }
+
+instance Pretty (PP EnvRoot) where
+    pretty (PP x) = text (_rootPath x)
+
+-- | Class used to access an EnvRoot in a value, typically in a reader
+-- monad.
+class HasEnvRoot r where envRootLens :: Lens' r EnvRoot
+instance HasEnvRoot EnvRoot where envRootLens = id
+
diff --git a/Extra/Except.hs b/Extra/Except.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Except.hs
@@ -0,0 +1,208 @@
+{-# LANGUAGE CPP, DeriveAnyClass, FunctionalDependencies, OverloadedStrings, TemplateHaskell, UndecidableInstances #-}
+{-# OPTIONS -Wall -Wredundant-constraints -Wno-orphans #-}
+
+module Extra.Except
+    ( -- * Control.Exception extensions
+      withException
+    , displaySomeExceptionType
+      -- * Control.Monad.Except extensions
+    , tryError
+    , withError
+    , mapError
+    , handleError
+    , HasIOException(fromIOException)
+    , IOException'(..)
+#if 1
+    , Tried(unTried)
+    , tryIO
+    , logIOError
+#else
+    , LyftIO(lyftIO, IOMonad, ErrorType)
+    , tryLiftIO
+    , logLiftIO
+    , lyftIO'
+    , LyftIO'
+    , LyftIO2
+    , lyftIO2
+
+    , MonadIOError
+    , liftIOError
+    , tryIOError
+    , logIOError
+#endif
+    , module Control.Monad.Except
+    ) where
+
+import Control.Exception ({-evaluate,-} Exception, IOException, SomeException(..))
+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 Extra.Log (logException, Priority(ERROR))
+
+-- | Apply a function to whatever @Exception@ type is inside a
+-- @SomeException@:
+--
+-- >>> catch (readFile "/tmp/nonexistant") (withException (return . show . typeOf))
+-- "IOException"
+withException :: forall r. (forall e. Exception e => e -> r) -> SomeException -> r
+withException f (SomeException e) = f e
+
+-- | Use 'withException' to obtain the exception's type name (similar
+-- to 'Control.Exception.displayException')
+--
+-- >>> catch (readFile "/tmp/nonexistant") (return . displaySomeExceptionType)
+-- "IOException"
+displaySomeExceptionType :: SomeException -> String
+displaySomeExceptionType = withException (show . typeOf)
+
+-- | MonadError analog to the 'try' function.
+tryError :: MonadError e m => m a -> m (Either e a)
+tryError action = (Right <$> action) `catchError` (pure . Left)
+
+-- | 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
+
+handleError :: MonadError e m => (e -> m a) -> m a -> m a
+handleError = flip catchError
+
+-- | MonadError analogue of the 'mapExceptT' function.
+mapError :: (MonadError e m, MonadError e' n) => (m (Either e a) -> n (Either e' b)) -> m a -> n b
+mapError f action = f (tryError action) >>= liftEither
+
+-- | In order to guarantee IOException is caught, do NOT create this
+-- 'HasIOException' instance for IOException.
+--
+-- > instance HasIOException IOException where fromIOException = id
+--
+-- Because there is an @instance MonadError IOException IO@ in
+-- @Control.Monad.Except@, "thrown" IOexceptions are not be caught by
+-- 'runExceptT':
+--
+-- >>> runExceptT (liftIO (readFile "/etc/nonexistant") :: ExceptT IOException IO String)
+-- *** Exception: /etc/nonexistant: openFile: does not exist (No such file or directory)
+--
+--  (*** means the exception reached the top level.)  However, if we
+-- use 'liftIOError' to implement a version of 'readFile' that has a
+-- 'MonadIOError' constraint:
+--
+-- >>> let readFile' path = liftIOError (readFile path)
+-- >>> :type readFile'
+-- readFile' :: MonadIOError e m => FilePath -> m String
+--
+-- and then create a suitable error type
+--
+-- >>> newtype Error = Error IOException deriving Show
+-- >>> instance MonadIOError Error where liftIOError io = liftIO (try io) >>= either (throwError . fromIOException) return
+--
+-- Now the thrown 'IOException' will always be caught and lifted into
+-- the 'MonadError':
+--
+-- >>> 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
+
+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)
+
+logIOError :: (MonadIO m, MonadError e m) => m a -> m a
+logIOError = handleError (\e -> liftIO ($logException ERROR (pure e)) >> throwError e)
+
+#else
+
+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
+
+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 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
+
+-- | LyftIO analog to the 'try' function.
+tryLiftIO :: LyftIO m => IOMonad m a -> m (Either (ErrorType m) a)
+tryLiftIO = tryError . lyftIO
+
+logLiftIO :: forall m a. LyftIO m => m a -> m a
+logLiftIO = handleError (\e -> lyftIO ($logException ERROR (pure e) :: IOMonad m (ErrorType m)) >> throwError e)
+
+type LyftIO' m = (LyftIO m, IOMonad m ~ ExceptT (ErrorType m) IO)
+
+-- | 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))
+
+type LyftIO2 e m = (LyftIO' m, e ~ ErrorType m)
+
+-- | Lift an @IOMonad m a@ action into @m a@.
+lyftIO2 :: LyftIO2 e m => IOMonad m a -> m a
+lyftIO2 action = lyftIO action
+
+-- Backwards compatibiity
+
+type MonadIOError e m = (LyftIO' m, e ~ ErrorType m)
+
+liftIOError :: MonadIOError e m => IO a -> m a
+liftIOError = lyftIO'
+
+tryIOError :: MonadIOError e m => IO a -> m (Either e a)
+tryIOError = tryError . liftIOError
+
+logIOError :: MonadIOError e m => m a -> m a
+logIOError = handleError (\e -> liftIOError ($logException ERROR (pure e)) >> throwError e)
+
+#endif
diff --git a/Extra/Exit.hs b/Extra/Exit.hs
--- a/Extra/Exit.hs
+++ b/Extra/Exit.hs
@@ -4,7 +4,7 @@
 import System.Environment
 import System.Exit
 import System.IO
-import Text.PrettyPrint.HughesPJ
+import Text.PrettyPrint
 
 -- |exitFailure with nicely formatted help text on stderr
 exitWithHelp :: (String -> Doc) -- ^ generate help text, the argument is the result of getProgName
diff --git a/Extra/FP.hs b/Extra/FP.hs
new file mode 100644
--- /dev/null
+++ b/Extra/FP.hs
@@ -0,0 +1,71 @@
+-- | Copied from packman.  Tried to use the library but got a compile error:
+--
+-- <no location info>: error:
+--     <command line>: can't load .so/.DLL for: /usr/lib/haskell-packages/ghc/lib/x86_64-linux-ghc-8.4.3/libHSpackman-0.5.0-Fv7reuyLHo03M7x4FerNmn-ghc8.4.3.so (/usr/lib/haskell-packages/ghc/lib/x86_64-linux-ghc-8.4.3/libHSpackman-0.5.0-Fv7reuyLHo03M7x4FerNmn-ghc8.4.3.so: undefined symbol: mblock_address_space)
+
+{-# LANGUAGE DeriveAnyClass, DeriveDataTypeable, DeriveGeneric, TemplateHaskell #-}
+
+module Extra.FP
+    ( FP(..)
+    , matches
+    , toFP
+    , typeFP
+    , typeRepFP
+    ) where
+
+
+--import Data.Binary (Binary(..), Get)
+import Data.Data (Data, Proxy, typeRep)
+import Data.SafeCopy (base, deriveSafeCopy)
+import Extra.Serialize (Serialize)
+import Data.Typeable (Typeable, typeOf)
+import Data.Typeable (typeRepFingerprint)
+import Data.Word (Word64)
+import qualified GHC.Fingerprint
+import GHC.Generics (Generic)
+
+------------------------------------------------------------------
+-- $ComparingTypes
+-----------------------------------------------
+-- Helper functions to compare types at runtime:
+--   We use type "fingerprints" defined in 'GHC.Fingerprint.Type'
+
+-- This should ensure (as of GHC.7.8) that types with the same name
+-- but different definition get different hashes.  (however, we also
+-- require the executable to be exactly the same, so this is not
+-- strictly necessary anyway).
+
+-- Typeable context for dynamic type checks. 
+
+-- | The module uses a custom GHC fingerprint type with its two Word64
+--   fields, to be able to /read/ fingerprints
+data FP = FP Word64 Word64 deriving (Read, Show, Eq, Data, Typeable, Ord, Generic, Serialize)
+
+-- | checks whether the type of the given expression matches the given Fingerprint
+matches :: Typeable a => a -> FP -> Bool
+matches x (FP c1 c2) = f1 == c1 && f2 == c2
+  where  (GHC.Fingerprint.Fingerprint f1 f2) = typeRepFingerprint (typeOf x)
+
+-- | creates an 'FP' from a GHC 'Fingerprint'
+toFP :: GHC.Fingerprint.Fingerprint -> FP
+toFP (GHC.Fingerprint.Fingerprint f1 f2) = FP f1 f2
+
+-- | returns the type fingerprint of an expression
+typeFP :: Typeable a => a -> FP
+typeFP = toFP . typeRepFingerprint . typeOf
+
+typeRepFP :: Typeable a => Proxy a -> FP
+typeRepFP p = toFP (typeRepFingerprint (typeRep p))
+
+{-
+-- | Binary instance for fingerprint data (encoding TypeRep and
+--   executable in binary-encoded @Serialized a@)
+instance Binary FP where
+  put (FP f1 f2) = do put f1
+                      put f2
+  get            = do f1 <- get :: Get Word64
+                      f2 <- get :: Get Word64
+                      return (FP f1 f2)
+-}
+
+$(deriveSafeCopy 1 'base ''FP)
diff --git a/Extra/Files.hs b/Extra/Files.hs
--- a/Extra/Files.hs
+++ b/Extra/Files.hs
@@ -5,7 +5,7 @@
 -- An example of an inconsistant state would be if we got a failure
 -- when writing out a file, but were unable to restore the original
 -- file to its original position.
-module Extra.Files 
+module Extra.Files
     ( getSubDirectories
     , renameAlways
     , renameMissing
@@ -15,7 +15,7 @@
     , writeAndZipFile
     , backupFile
     , writeFileIfMissing
-    , maybeWriteFile		-- writeFileUnlessSame
+    , maybeWriteFile            -- writeFileUnlessSame
     , createSymbolicLinkIfMissing
     , prepareSymbolicLink
     , forceRemoveLink
@@ -24,16 +24,16 @@
 
 import qualified Codec.Compression.GZip as GZip
 import qualified Codec.Compression.BZip as BZip
-import		 Control.Exception
-import		 Control.Monad
+import           Control.Exception
+import           Control.Monad
 import qualified Data.ByteString.Lazy as B
-import		 Data.List
-import		 Data.Maybe
-import		 Extra.Misc
-import		 System.Unix.Directory
-import		 System.Directory
-import		 System.IO.Error hiding (try, catch)
-import		 System.Posix.Files as SPF
+import           Data.List
+import           Data.Maybe
+import           Extra.Misc
+import           System.Unix.Directory
+import           System.Directory
+import           System.IO.Error
+import           System.Posix.Files as SPF
 
 -- | Return the list of subdirectories, omitting . and .. and ignoring
 -- symbolic links.
@@ -52,7 +52,7 @@
 installFiles pairs =
     do backedUp <- mapM (uncurry renameAlways) (zip originalFiles backupFiles)
        case lefts backedUp of
-         [] -> 
+         [] ->
              do renamed <- mapM (uncurry renameAlways) (zip replacementFiles originalFiles)
                 case lefts renamed of
                   [] -> return $ Right ()
@@ -63,9 +63,9 @@
                       -- files back into place.
                       do restored <- mapM (uncurry renameAlways) (zip backupFiles originalFiles)
                          case lefts restored of
-	                   -- We succeeded in failing.
+                           -- We succeeded in failing.
                            [] -> return . Left . concat . lefts $ renamed
-	                   -- Restore failed.  Throw an exception.
+                           -- Restore failed.  Throw an exception.
                            _ -> error ("installFiles: Couldn't restore original files after write failure:" ++
                                        concat (map message (zip3 replacementFiles originalFiles renamed)) ++
                                        concat (map message (zip3 originalFiles backupFiles restored)))
@@ -75,9 +75,9 @@
              -- Restore the backup for any missing original files.
              do restored <- mapM (uncurry renameMissing) (zip backupFiles originalFiles)
                 case lefts restored of
-	          -- We succeeded in failing.
+                  -- We succeeded in failing.
                   [] -> return . Left . concat . lefts $ backedUp
-		  -- Restore failed.  Throw an exception.
+                  -- Restore failed.  Throw an exception.
                   _ -> error ("installFiles: Couldn't restore original files after write failure: " ++
                               concat (map message (zip3 originalFiles backupFiles backedUp)) ++
                               concat (map message (zip3 backupFiles originalFiles restored)))
@@ -126,7 +126,7 @@
          False -> return $ Right ()
          True ->
              do status <- getSymbolicLinkStatus path
-		-- To do: should we remove the directory contents?
+                -- To do: should we remove the directory contents?
                 let rm = if isDirectory status then removeDirectory else removeLink
                 try (rm path) >>= return . either (\ (e :: SomeException) -> Left ["Couldn't remove " ++ path ++ ": " ++ show e]) (const . Right $ ())
 
@@ -152,18 +152,18 @@
 -- |like removeLink, but does not fail if link did not exist
 forceRemoveLink :: FilePath -> IO ()
 forceRemoveLink fp = removeLink fp `Control.Exception.catch` (\e -> unless (isDoesNotExistError e) (ioError e))
-                 
+
 -- | Write out three versions of a file, regular, gzipped, and bzip2ed.
 writeAndZipFileWithBackup :: FilePath -> B.ByteString -> IO (Either [String] ())
 writeAndZipFileWithBackup path text =
     backupFile path >>=
     either (\ e -> return (Left ["Failure renaming " ++ path ++ " -> " ++ path ++ "~: " ++ show e]))
            (\ _ -> try (B.writeFile path text) >>=
-                   either (\ (e :: SomeException) ->
+                   either (\(e :: SomeException) ->
                                restoreBackup path >>=
-                               either (\ e -> error ("Failed to restore backup: " ++ path ++ "~ -> " ++ path ++ ": " ++ show e))
+                               either (\ex -> error ("Failed to restore backup: " ++ path ++ "~ -> " ++ path ++ ": " ++ show ex))
                                       (\ _ -> return (Left ["Failure writing " ++ path ++ ": " ++ show e])))
-                          (\ _ -> zipFile path))
+                          (\_ -> zipFile path))
 
 -- | Write out three versions of a file, regular, gzipped, and bzip2ed.
 -- This new version assumes the files are written to temporary locations,
@@ -207,7 +207,7 @@
       maybeWrite (Left (e :: IOException)) | isDoesNotExistError e = writeFile path text
       maybeWrite (Left e) = error ("maybeWriteFile: " ++ show e)
       maybeWrite (Right old) | old == text = return ()
-      maybeWrite (Right _old) = 
+      maybeWrite (Right _old) =
           --hPutStrLn stderr ("Old text: " ++ show old) >>
           --hPutStrLn stderr ("New text: " ++ show text) >>
           replaceFile path text
@@ -238,7 +238,7 @@
 -- isAlreadyBusyError exceptions before the writeFile succeeds.
 replaceFile :: FilePath -> String -> IO ()
 replaceFile path text =
-    --tries 100 10 f	-- There is now a fix for this problem, see ghc ticket 2122.
+    --tries 100 10 f    -- There is now a fix for this problem, see ghc ticket 2122.
     f
     where
       f :: IO ()
diff --git a/Extra/GPGSign.hs b/Extra/GPGSign.hs
--- a/Extra/GPGSign.hs
+++ b/Extra/GPGSign.hs
@@ -20,7 +20,7 @@
 
 sign :: PGPKey'' -> FilePath -> IO FilePath
 sign keyname path =
-    do (_, _,err,pid) <- runInteractiveProcess cmd args workingDir env
+    do (_, _,err,pid) <- runInteractiveProcess cmd args workingDir Nothing
        status <- waitForProcess pid
        case status of
          ExitSuccess -> return outputPath
@@ -39,7 +39,6 @@
                 ]
          outputPath = path ++ ".gpg"
          workingDir = Nothing -- Just (dirName path)
-         env = Nothing
 
 data PGPKey = Key String | Default deriving Show
 
@@ -48,7 +47,7 @@
 
 pgpSignFile :: PGPKey -> FilePath -> IO Bool
 pgpSignFile keyname path =
-    do (_, _,err,pid) <- runInteractiveProcess cmd args workingDir env
+    do (_, _,err,pid) <- runInteractiveProcess cmd args workingDir Nothing
        status <- waitForProcess pid
        case status of
          ExitSuccess -> return True
@@ -69,4 +68,3 @@
          defaultKey = case keyname of Key name -> ["--default-key", name]; Default -> []
          outputPath = path ++ ".gpg"
          workingDir = Nothing -- Just (dirName path)
-         env = Nothing
diff --git a/Extra/Generics.hs b/Extra/Generics.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Generics.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE ConstraintKinds, FlexibleContexts #-}
+
+module Extra.Generics
+    ( gFind
+    , Extra.Generics.GShow
+    , gshow
+    , gshows
+    , gshowsPrec
+    ) where
+
+import Control.Monad (MonadPlus, msum)
+import Data.Generics (Data, listify, Proxy, Typeable)
+import Generic.Data (gshowsPrec)
+import Generic.Data.Internal.Show (GShow)
+import GHC.Generics (Generic, Rep)
+
+-- | @gFind a@ will extract any elements of type @b@ from
+-- @a@'s structure in accordance with the MonadPlus
+-- instance, e.g. Maybe Foo will return the first Foo
+-- found while [Foo] will return the list of Foos found.
+gFind :: (MonadPlus m, Data a, Typeable b) => a -> m b
+gFind = msum . map return . listify (const True)
+
+type GShow a = (Generic a, Generic.Data.Internal.Show.GShow Proxy (Rep a))
+
+-- | Generic version of show based on generic-data's gshowsPrec function.
+gshow :: (Generic a, Generic.Data.Internal.Show.GShow Proxy (Rep a)) => a -> String
+gshow x = gshows x ""
+
+gshows :: (Generic a, Generic.Data.Internal.Show.GShow Proxy (Rep a)) => a -> ShowS
+gshows x = gshowsPrec 0 x
diff --git a/Extra/Generics/Show.hs b/Extra/Generics/Show.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Generics/Show.hs
@@ -0,0 +1,278 @@
+-- | This is a both a working implementation of Generic Show and a
+-- template for using GHC.Generics to implement similar functions
+-- without requiring that every type it can operate on have a Show
+-- instance.  It does require an instance for each base type.
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+-- {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+-- {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS -Wall -Wredundant-constraints #-}
+
+module Extra.Generics.Show
+  ( GShow0, gprecShows, gshowsPrec
+  , GShow1, gLiftPrecShows, gLiftShowsPrec
+  , GShow, gshow, gshows
+  , myshow
+  ) where
+
+--import Debug.Trace
+import Data.Foldable (foldl')
+import Data.Functor.Classes (Show1(..))
+import Data.Functor.Identity (Identity(Identity))
+import Data.Proxy (Proxy(Proxy))
+import Generic.Data (gconIndex)
+import GHC.Generics as G
+import GHC.TypeLits
+import Text.Show.Combinators (PrecShowS, {-ShowFields,-} noFields, showField, showListWith, showInfix, showApp, showCon, showRecord)
+import qualified Text.Show.Combinators as Show (appendFields)
+
+-- For primitive instances
+-- import Data.Typeable (Typeable, typeOf)
+
+-- For tests
+#if !__GHCJS__
+import Test.HUnit
+import Language.Haskell.TH (location)
+import Language.Haskell.TH.Lift (lift)
+import Language.Haskell.TH.Instances ()
+#endif
+
+-- for debug
+-- import Debug.Trace
+--import GHC.TypeLits
+
+-- The K1 instance had constraint Show a, which means that every field
+-- traversed must have a Show instance.  I removed this constraint,
+-- and then also had to remove it from doK1.  Now I needed doK1 to Use
+-- the Show instance for a set of base types and otherwise use the
+-- Generic instance.  This can be done by creating a new class DoK1
+-- and using overlapping instances.
+
+type TypeTuple = (String, String, String, Bool)
+type ConstrTuple = (Int, String, Fixity)
+
+-- Constraints for doing recusion into subtypes
+type DoRep a = (Generic a, DoM1 Proxy (Rep a))
+type DoRep1 f = (Generic1 f, DoM1 Identity (Rep1 f))
+
+class                                       DoS1 p f               where doS1 :: forall a. p (Rd a) -> TypeTuple -> ConstrTuple -> f a -> S1Result
+instance {-# OVERLAPPABLE #-} DoRep a =>    DoS1 p (K1 R a)        where doS1 p ti ci (K1 a) = doRecursion p ti ci a
+instance DoRep1 f =>                        DoS1 Identity (Rec1 f) where doS1 (Identity st) ti ci (Rec1 r) = doRec1 st ti ci r
+instance                                    DoS1 Identity Par1     where doS1 (Identity st) ti ci (Par1 a) = doPar1 st ti ci a
+instance (Show1 f, DoS1 p g) =>             DoS1 p (f :.: g)       where doS1 p ti ci (Comp1 c) = doComp1 p ti ci c
+
+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                                    DoFields p U1          where doFields _ _ _ U1 = []
+
+class                                       DoNamed p f            where doNamed :: forall a. p (Rd a) -> TypeTuple -> ConstrTuple -> f a -> [(String, S1Result)]
+instance (DoNamed p f, DoNamed p g) =>      DoNamed p (f :*: g)    where doNamed p ti ci (x :*: y) = doNamed p ti ci x <> doNamed p ti ci y
+instance (Selector c, DoS1 p f) =>          DoNamed p (M1 S c f)   where doNamed p ti ci x'@(M1 x) = [(G.selName x', doS1 p ti ci x)]
+instance                                    DoNamed p U1           where doNamed _ _ _ U1 = []
+
+-- 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
+                                                                   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
+
+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 (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
+instance                                    DoD1 p V1              where doD1 _ _ v = case v of {}
+
+class                                       DoM1 p f               where doM1 :: forall a. p (Rd a) -> f a -> D1Result
+instance (DoDatatype p d f, Datatype d) =>  DoM1 p (M1 D d f)      where doM1 p x@(M1 _) = let ti = (G.datatypeName x, G.moduleName x, G.packageName x, G.isNewtype x) in doD1 p ti x
+
+-- customization for generic Show --
+
+-- Instances for primitive types
+instance                      DoS1 p (K1 R Int)      where doS1 p ti ci (K1 a) = doLeaf p ti ci a
+instance                      DoS1 p (K1 R Char)     where doS1 p ti ci (K1 a) = doLeaf p ti ci a
+instance {-# OVERLAPPING #-}  DoS1 p (K1 R String)   where doS1 p ti ci (K1 a) = doLeaf p ti ci a -- overlaps [a]
+instance DoS1 Proxy (K1 R a) =>
+                              DoS1 p (K1 R [a])      where doS1 p ti ci (K1 xs) = doList p ti ci (fmap myshows xs)
+instance                      DoS1 p (K1 R ())       where doS1 p ti ci (K1 ()) = doTuple p ti ci []
+instance (DoS1 Proxy (K1 R a),
+          DoS1 Proxy (K1 R b)) => DoS1 p (K1 R (a, b))
+                                                     where doS1 p ti ci (K1 (a, b)) = doTuple p ti ci [myshows a, myshows b]
+instance (DoS1 Proxy (K1 R a),
+          DoS1 Proxy (K1 R b),
+          DoS1 Proxy (K1 R c)) => DoS1 p (K1 R (a, b, c))
+                                                     where doS1 p ti ci (K1 (a, b, c)) = doTuple p ti ci [myshows a, myshows b, myshows c]
+instance (DoS1 Proxy (K1 R a),
+          DoS1 Proxy (K1 R b),
+          DoS1 Proxy (K1 R c),
+          DoS1 Proxy (K1 R d)) => DoS1 p (K1 R (a, b, c, d))
+                                                     where doS1 p ti ci (K1 (a, b, c, d)) = doTuple p ti ci [myshows a, myshows b, myshows c, myshows d]
+instance (DoS1 Proxy (K1 R a),
+          DoS1 Proxy (K1 R b),
+          DoS1 Proxy (K1 R c),
+          DoS1 Proxy (K1 R d),
+          DoS1 Proxy (K1 R e)) => DoS1 p (K1 R (a, b, c, d, e))
+                                                     where doS1 p ti ci (K1 (a, b, c, d, e)) = doTuple p ti ci [myshows a, myshows b, myshows c, myshows d, myshows e]
+
+type Rd a = (Int -> a -> ShowS, [a] -> ShowS) -- Like a Reader monad
+type S1Result = PrecShowS -- The result of a single field of a constructor
+type C1Result = PrecShowS -- Result of processing one constructors
+type D1Result = PrecShowS -- Result of processing a type value
+
+doLeaf :: Show a => p -> TypeTuple -> ConstrTuple -> a -> S1Result
+doLeaf _p _ti _ci a _prec = shows a
+
+doList :: p -> TypeTuple -> ConstrTuple -> [ShowS] -> S1Result
+doList _ _ _ [] = \_ -> showChar '[' . showChar ']'
+doList _ _ _ xs = \_ -> showChar '[' . foldl1 (\a b -> a . showString "," . b) xs . showChar ']'
+
+doTuple :: p -> TypeTuple -> ConstrTuple -> [ShowS] -> S1Result
+doTuple _ _ _ [] = \_ -> showString "()"
+doTuple _ _ _ ks = \_ -> showChar '(' . foldl1 (\a b -> a . showString "," . b) ks . showChar ')'
+
+doUnboxed :: Show a => p -> TypeTuple -> ConstrTuple -> a -> S1Result
+doUnboxed _p _ti _ci a _prec s = show a <> s
+
+doRecursion :: (Generic a, DoM1 Proxy (Rep a)) => p -> TypeTuple -> ConstrTuple -> a -> S1Result
+doRecursion _p _ti _ci a = flip gshowsPrec a
+
+-- Rec1 marks a field (S1) which is itself a record
+doRec1 :: (Generic1 f, DoM1 Identity (Rep1 f)) => forall a. Rd a -> TypeTuple -> ConstrTuple -> f a -> S1Result
+doRec1 sp _ti _ci r = flip (uncurry gLiftShowsPrec sp) r
+
+-- Par1 marks a field (S1) which is just a type parameter
+doPar1 :: Rd a -> TypeTuple -> ConstrTuple -> a -> S1Result
+doPar1 (op1', _) _ti _ci a = flip op1' a
+
+-- Comp1 is the marks a field (S1) of type (:.:), composition
+doComp1 :: (Show1 f, DoS1 p g) => p (Rd a) -> TypeTuple -> ConstrTuple -> f (g a) -> S1Result
+doComp1 p ti ci c = flip (liftShowsPrec (flip (doS1 p ti ci)) (showListWith (flip (doS1 p ti ci) 0))) c
+
+-- Handle the unnamed fields of a constructor (C1)
+doNormal :: TypeTuple -> ConstrTuple -> [(Int, S1Result)] -> C1Result
+doNormal _ (_, name, Infix _ fy) (k1 : k2 : ks) = foldl' showApp (showInfix name fy (snd k1) (snd k2)) (fmap snd ks)
+doNormal _ (_, name, Infix _ _) ks =              foldl' showApp (showCon ("(" ++ name ++ ")")) (fmap snd ks)
+doNormal _ (_, name, Prefix) ks =                   foldl' showApp (showCon         name        ) (fmap snd ks)
+
+-- Handle the named fields of a constructor (C1)
+doRecord :: TypeTuple -> ConstrTuple -> [(Int, (String, S1Result))] -> C1Result
+doRecord _ (_, cname, _) [] = showRecord cname noFields
+-- Do not render the Top type, it is private to this module and is
+-- only used to get the recursion to work.
+doRecord ("Top", "Extra.Generics.Show", _, _) _ [(_, (_, r))] = r
+doRecord _ (_, cname, Prefix) ks = showRecord cname (foldl1 Show.appendFields (fmap (uncurry showField) (fmap snd ks)))
+doRecord _ (_, cname, Infix _ _) ks = showRecord ("(" ++ cname ++ ")") (foldl1 Show.appendFields (fmap (uncurry showField) (fmap snd ks)))
+
+---------------------------------------------------
+
+-- | Generic representation of 'Show' types.
+type GShow0 = DoM1 Proxy
+
+newtype Top a = Top {unTop :: a} deriving Generic
+infixr 0 `Top`
+
+-- | Generic 'showsPrec'.
+--
+-- @
+-- instance 'Show' MyType where
+--   'showsPrec' = 'gshowsPrec'
+-- @
+gprecShows :: forall a. GShow a => a -> PrecShowS
+gprecShows = doM1 (Proxy :: Proxy (Rd a)) . from
+
+gshowsPrec :: GShow a => Int -> a -> ShowS
+gshowsPrec = flip gprecShows
+
+-- | Generic representation of 'Data.Functor.Classes.Show1' types.
+-- class Show1 (f :: * -> *) where
+--   liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
+--   liftShowsList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
+type GShow1 = DoM1 Identity
+
+gLiftPrecShows ::
+  (GShow1 f)
+  => (Int -> a -> ShowS)
+  -> ([a] -> ShowS)
+  -> f a -> PrecShowS
+gLiftPrecShows = curry (doM1 . Identity)
+
+-- | Generic 'liftShowsPrec'.
+gLiftShowsPrec ::
+  (Generic1 f, GShow1 (Rep1 f))
+  => (Int -> a -> ShowS)
+  -> ([a] -> ShowS)
+  -> Int
+  -> f a -> ShowS
+gLiftShowsPrec op1' op2' =
+  flip (gLiftPrecShows op1' op2' . from1)
+
+type GShow a = (Generic a, GShow0 (Rep a))
+
+gshow :: GShow a => a -> String
+gshow x = gshows x ""
+gshows :: GShow a => a -> ShowS
+gshows = gshowsPrec 0
+
+#if 0
+class MyShow a where
+  myshows :: a -> ShowS
+  default myshows :: (Generic a, GShow (Rep a)) => a -> ShowS
+  myshows a = gshows (Top a)
+  myshow :: a -> String
+  default myshow :: (Generic a, GShow (Rep a)) => a -> String
+  myshow a = gshow
+#else
+myshow :: (DoS1 Proxy (K1 R a)) => a -> String
+myshow a = gshow (Top a)
+
+myshows :: (DoS1 Proxy (K1 R a)) => a -> ShowS
+myshows a = gshows (Top a)
+#endif
+
+#if !__GHCJS__
+data Foo = Foo {n :: Int, ch :: Char} deriving (Generic, Show)
+data Bar = Bar [Foo] String deriving (Generic, Show)
+data Rose a = Fork a [Rose a] deriving (Generic, Show)
+data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic, Show)
+data WithInt a = WithInt Int a deriving (Generic, Show)
+
+_tests :: IO ()
+_tests = do
+  r@Counts{..} <-
+    runTestTT
+      (TestList
+       [ TestCase (assertEqual "T1" "Foo {n = 1, ch = 'x'}" (myshow (Foo 1 'x')))
+       , TestCase (assertEqual "T2" "Bar [Foo {n = 1, ch = 'x'}] \"hello\"" (myshow (Bar [Foo 1 'x'] "hello")))
+       , TestCase (assertEqual "T3" "Fork 'a' [Fork 'b' []]" (myshow (Fork 'a' [Fork 'b' []])))
+       , TestCase (assertEqual "T4" "Node (Leaf 'a') (Node (Leaf 'b') (Leaf 'c'))" (myshow (Node (Leaf 'a') (Node (Leaf 'b') (Leaf 'c')))))
+       , TestCase (assertEqual "T5" "WithInt 5 (WithInt 2 'a')" (myshow (WithInt 5 (WithInt 2 'a'))))
+       , let (expected, loc) = $(lift =<< (\x -> (show x, x)) <$> location) in
+           TestCase (assertEqual "T6" expected (myshow loc))
+       , TestCase (assertEqual "T7" "[1,2,3]" (myshow ([1,2,3] :: [Int])))
+       , TestCase (assertEqual "T8" "[1]" (myshow ([1] :: [Int])))
+       , TestCase (assertEqual "T9" "1" (myshow (1 :: Int)))
+       , TestCase (assertEqual "T10" "('x',2,\"abc\")" (myshow ('x',(2 :: Int),("abc" :: String))))
+       ])
+  case (errors, failures) of
+    (0, 0) -> return ()
+    _ -> error (show r)
+#endif
diff --git a/Extra/HughesPJ.hs b/Extra/HughesPJ.hs
--- a/Extra/HughesPJ.hs
+++ b/Extra/HughesPJ.hs
@@ -2,7 +2,7 @@
 
 import Data.Maybe
 import Extra.Terminal
-import Text.PrettyPrint.HughesPJ
+import Text.PrettyPrint
 
 -- |render a Doc using the current terminal width
 renderWidth :: Doc -> IO String       
diff --git a/Extra/IO.hs b/Extra/IO.hs
--- a/Extra/IO.hs
+++ b/Extra/IO.hs
@@ -1,20 +1,113 @@
-module Extra.IO {-# DEPRECATED "CIO is deprecated" #-} where
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS -Wall #-}
 
-import Extra.CIO
-import qualified System.IO as IO
-import Control.Exception (try)
+module Extra.IO
+    ( -- * IO functions to write files and notice when they change.
+      testAndWriteDotNew
+    , testAndWriteBackup
+    , testAndWriteFile
+    , testAndWrite
+    , writeFileWithBackup
+    , findHaskellFiles
+    , timeComputation
+    ) where
 
--- |Use this module to call functions in the CIO module from the
--- regular IO monad.  This instance ignores all style and state
--- information.  The verbosity controlled output functions will ignore
--- any calls when v is greater than zero.  This allows you to call the
--- functions in the haskell-debian package from the regular IO monad.
--- 
--- This is in a separate module from CIO so you don't accidentally do
--- a liftIO of some other CIO operation and get this instance.
-instance CIO IO where
-    hPutStr h s = IO.hPutStr h s
-    hBOL h = IO.hPutStr h "\n"
-    ev v = return (- v)
-    setStyle _ f = f
-    tryCIO = try
+import Control.Exception as E (IOException, throw, try)
+import Control.Monad (when)
+import Control.Monad.Trans (liftIO, MonadIO)
+import Data.Monoid ((<>))
+import Data.Text as Text (length, take, Text)
+import Data.Text.IO as Text (readFile, writeFile)
+import Data.Time (getCurrentTime, diffUTCTime, getCurrentTime, NominalDiffTime)
+import Extra.Log (alog)
+import Extra.Text (diffText)
+import System.Directory (getCurrentDirectory, removeFile, renameFile)
+import System.FilePath.Find as Find
+    ((==?), (&&?), always, extension, fileType, FileType(RegularFile), find)
+import System.IO.Error (isDoesNotExistError)
+import System.Log.Logger ({-logM,-} Priority(DEBUG, ERROR))
+
+testAndWriteDotNew :: FilePath -> Text -> IO ()
+testAndWriteDotNew dest new = testAndWrite writeDotNew dest new
+
+testAndWriteBackup :: FilePath -> Text -> IO ()
+testAndWriteBackup dest new = testAndWrite (\dest' _ new' -> writeFileWithBackup dest' new') dest new
+
+testAndWriteFile :: FilePath -> Text -> IO ()
+testAndWriteFile = testAndWriteDotNew
+{-# DEPRECATED testAndWriteFile "Use testAndWriteDotNew" #-}
+
+-- | See if the new Paths code matches the old, if not write it to a
+-- file with the suffix ".new" and throw an error so the new code can
+-- be inspected and checked in.  If the new file does match, the
+-- existing .new file is removed.
+testAndWrite :: (FilePath -> Text -> Text -> IO ()) -> FilePath -> Text -> IO ()
+testAndWrite changeAction dest new = do
+  here <- getCurrentDirectory
+  alog "Extra.IO" DEBUG ("testAndWriteFile " <> show dest <> " " <> show (shorten 50 new) <> " (cwd=" <> show here <> ")")
+  removeFileMaybe (dest <> ".new")
+  try (Text.readFile dest >>= \old ->
+       when (old /= new) (changeAction dest old new)) >>=
+    either (\(e :: IOException) ->
+              case isDoesNotExistError e of
+                True -> do
+                  alog "Extra.IO" DEBUG "testAndWriteFile - no existing version"
+                  Text.writeFile dest new
+                False -> do
+                  alog "Extra.IO" ERROR ("testAndWriteFile " <> show dest <> " - IOException " ++ show e)
+                  throw e)
+           return
+
+-- | Shorten a string to a maximum length by replacing its suffix with "..."
+shorten :: Int -> Text -> Text
+shorten n t | n <= 3 = Text.take n t -- no room for an ellipsis
+shorten n t | Text.length t > n - 3 = Text.take (n - 3) t <> "..."
+shorten _ t = t
+
+-- | If the new file does not match the old, write it to file.new and error.
+writeDotNew :: FilePath -> Text -> Text -> IO ()
+writeDotNew dest old new = do
+  alog "Extra.IO" DEBUG ("testAndWriteFile - mismatch, writing " <> show (dest <> ".new"))
+  Text.writeFile (dest <> ".new") new
+  error ("Generated " <> dest <> ".new does not match existing " <> dest <> ":\n" <>
+         diffText (dest, old) (dest <> ".new", new) <>
+         "\nIf these changes look reasonable move " <> dest <> ".new to " <> dest <> " and retry.")
+
+
+-- | Rename existing file with suffix "~" and write a new file
+writeFileWithBackup :: FilePath -> Text -> IO ()
+writeFileWithBackup dest text = do
+  removeFileMaybe (dest <> "~")
+  renameFileMaybe dest (dest <> "~")
+  removeFileMaybe dest
+  Text.writeFile dest text
+
+-- | Remove a file if it exists
+removeFileMaybe :: FilePath -> IO ()
+removeFileMaybe p =
+    try (removeFile p) >>=
+    either (\(e :: IOException) -> case isDoesNotExistError e of
+                                     True -> pure ()
+                                     False -> throw e) pure
+
+-- | Rename a file if it exists
+renameFileMaybe :: FilePath -> FilePath -> IO ()
+renameFileMaybe oldpath newpath =
+    try (renameFile oldpath newpath) >>=
+    either (\(e :: IOException) -> case isDoesNotExistError e of
+                                     True -> pure ()
+                                     False -> throw e) pure
+
+-- | Find all regular files with extension .hs
+findHaskellFiles :: FilePath -> IO [FilePath]
+findHaskellFiles dir = find always (Find.extension ==? ".hs" &&? fileType ==? RegularFile) dir
+
+-- | Perform an IO operation and return the elapsed time along with the result.
+timeComputation :: MonadIO m => m r -> m (r, NominalDiffTime)
+timeComputation a = do
+  !start <- liftIO getCurrentTime
+  !r <- a
+  !end <- liftIO getCurrentTime
+  return (r, diffUTCTime end start)
diff --git a/Extra/IOThread.hs b/Extra/IOThread.hs
--- a/Extra/IOThread.hs
+++ b/Extra/IOThread.hs
@@ -21,9 +21,9 @@
        tid <- forkIO $ ioThread f c
        return (tid, IOThread c)
     where
-      ioThread f c =
+      ioThread f' c =
           forever $ do (a, mvar) <- readChan c
-                       b <- try $ f a
+                       b <- try $ f' a
                        putMVar mvar b
 
 -- |issue a request to the IO thread and get back the result
diff --git a/Extra/List.hs b/Extra/List.hs
--- a/Extra/List.hs
+++ b/Extra/List.hs
@@ -43,13 +43,13 @@
 cartesianProduct [xs] = map (: []) xs
 cartesianProduct (xs : yss) =
     distribute xs (cartesianProduct yss)
-    where distribute xs yss = concat (map (\ x -> map (x :) yss) xs)
+    where distribute xs' yss' = concat (map (\ x -> map (x :) yss') xs')
 
 -- |FIXME: implement for a string
 wordsBy :: Eq a => (a -> Bool) -> [a] -> [[a]]
 wordsBy p s = 
     case (break p s) of
-      (s, []) -> [s]
+      (s', []) -> [s']
       (h, t) -> h : wordsBy p (drop 1 t)
 
 -- |Like maybe, but with empty vs. non-empty list
@@ -61,18 +61,18 @@
 -- over f.  This is like "sortBy (\ a b -> compare (f a) (f b))"
 -- except that f is applied O(n) times instead of O(n log n)
 sortByMapped :: (a -> b) -> (b -> b -> Ordering) -> [a] -> [a]
-sortByMapped f compare list =
+sortByMapped f cmp list =
     map fst sorted
     where
-      sorted = sortBy (\ (_, x) (_, y) -> compare x y) pairs
+      sorted = sortBy (\ (_, x) (_, y) -> cmp x y) pairs
       pairs = zip list (map f list)
 
 -- |Monadic version of sortByMapped
 sortByMappedM :: (a -> IO b) -> (b -> b -> Ordering) -> [a] -> IO [a]
-sortByMappedM f compare list =
+sortByMappedM f cmp list =
     do
       pairs <- mapM f list >>= return . (zip list)
-      let sorted = sortBy (\ (_, x) (_, y) -> compare x y) pairs
+      let sorted = sortBy (\ (_, x) (_, y) -> cmp x y) pairs
       return (map fst sorted)
 
 partitionM :: (Monad m) => (a -> m Bool) -> [a] -> m ([a], [a])
diff --git a/Extra/Lock.hs b/Extra/Lock.hs
--- a/Extra/Lock.hs
+++ b/Extra/Lock.hs
@@ -6,10 +6,9 @@
 
 import Control.Exception
 import Control.Monad.RWS
-import Prelude hiding (catch)
 import System.Directory
 import System.IO
-import System.IO.Error hiding (try, catch)
+import System.IO.Error
 import System.Posix.Files
 import System.Posix.IO
 import System.Posix.Unistd
@@ -48,9 +47,10 @@
 -- |Like withLock, but instead of giving up immediately, try n times
 -- with a wait between each.
 --awaitLock :: (MonadIO m) => Int -> Int -> FilePath -> m a -> m (Either Exception a)
+awaitLock :: (Ord a, Num a) => a -> Int -> [Char] -> IO a -> IO a
 awaitLock tries usecs path task =
     attempt 0
-    where 
+    where
       attempt n | n >= tries = error "awaitLock: too many failures"
       attempt n = withLock path task `catch` checkLockError
           where
@@ -60,4 +60,5 @@
 processID :: IO String
 processID = readSymbolicLink "/proc/self"
 
+lockedBy :: String -> FilePath -> IOError
 lockedBy pid path = mkIOError alreadyInUseErrorType ("Locked by " ++ pid) Nothing (Just path)
diff --git a/Extra/Log.hs b/Extra/Log.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Log.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS -Wall #-}
+
+module Extra.Log
+  ( alog
+  , Priority(..)
+  , logException
+  ) 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)
+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 System.Log.Logger (Priority(..), logM)
+
+alog :: MonadIO m => String -> Priority -> String -> m ()
+alog modul priority msg = liftIO $ do
+  time <- getCurrentTime
+  logM modul priority $ unwords [formatTimeCombined time, msg]
+
+-- | Format the time as describe in the Apache combined log format.
+--   http://httpd.apache.org/docs/2.2/logs.html#combined
+--
+-- The format is:
+--   [day/month/year:hour:minute:second zone]
+--    day = 2*digit
+--    month = 3*letter
+--    year = 4*digit
+--    hour = 2*digit
+--    minute = 2*digit
+--    second = 2*digit
+--    zone = (`+' | `-') 4*digit
+--
+-- (Copied from happstack-server)
+formatTimeCombined :: FormatTime t => t -> String
+formatTimeCombined = formatTime defaultTimeLocale "%d/%b/%Y:%H:%M:%S %z"
+
+-- | 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.
+logException :: ExpQ
+logException =
+    [| \priority action ->
+         action `catchError` (\e -> do
+                                liftIO (logM (loc_module $__LOC__)
+                                             priority
+                                             ("Logging exception: " <> (pprint $__LOC__) <> " -> " ++ show e))
+                                throwError e) |]
+
+__LOC__ :: Q Exp
+__LOC__ = TH.lift =<< location
diff --git a/Extra/Misc.hs b/Extra/Misc.hs
--- a/Extra/Misc.hs
+++ b/Extra/Misc.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module Extra.Misc
     (
     -- * String functions
@@ -7,40 +9,38 @@
     , mapSnd
     -- * FilePath functions
     , parentPath
-    , canon
+    -- , canon
     -- * Map and Set functions
     , listMap
     , listDiff
     -- * System.Posix
-    , checkSuperUser
     , md5sum
-    , sameInode
     , sameMd5sum
-    , tarDir
-    -- * Processes
-    -- , splitOutput
-    -- * ByteString
-    , cd
-    -- * Debugging
     , read'
+#if !__GHCJS__
+    , sameInode
+    , cd
+    , checkSuperUser
+    , tarDir
+#endif
     ) where
 
-import		 Control.Exception
 import qualified Data.ByteString.Lazy.Char8 as B
 import qualified Data.Digest.Pure.MD5
-import		 Data.List
+import           Data.List
 import qualified Data.Map as Map
-import		 Data.Maybe
+import           Data.Maybe
 import qualified Data.Set as Set
-import		 Extra.List
+import           System.FilePath
+#if !__GHCJS__
+import           Control.Exception
+import           Extra.List (wordsBy)
+import           System.Directory
 import           System.Exit
-import		 System.FilePath
-import		 System.Directory
-import		 System.Posix.Files
-import		 System.Posix.User (getEffectiveUserID)
+import           System.Posix.Files
+import           System.Posix.User (getEffectiveUserID)
 import           System.Process (readProcessWithExitCode)
--- import System.Process.Progress (keepStdout, keepStderr, keepResult)
-import		 Text.Regex
+#endif
 
 mapSnd :: (b -> c) -> (a, b) -> (a, c)
 mapSnd f (a, b) = (a, f b)
@@ -62,10 +62,10 @@
 justify s n =
     foldr doWord [[]] (words s)
     where doWord w [] = [[w]]
-	  doWord w (ws : etc) = 
-	      if length (concat (intersperse " " (w:ws))) <= n then
-		 (w : ws) : etc else
-		 [w] : ws : etc
+          doWord w (ws : etc) =
+              if length (concat (intersperse " " (w:ws))) <= n then
+                 (w : ws) : etc else
+                 [w] : ws : etc
 
 -- |dirname
 parentPath :: FilePath -> FilePath
@@ -82,6 +82,7 @@
 listDiff :: Ord a => [a] -> [a] -> [a]
 listDiff a b = Set.toList (Set.difference (Set.fromList a) (Set.fromList b))
 
+#if 0
 -- | Weak attempt at canonicalizing a file path.
 canon :: FilePath -> FilePath
 canon path =
@@ -95,12 +96,14 @@
       merge (x : "." : xs) = (merge (x : xs))
       merge (x : xs) = x : merge xs
       merge [] = []
+#endif
 
 {-# DEPRECATED md5sum "Use Data.ByteString.Lazy.Char8.readFile path >>= return . show . Data.Digest.Pure.MD5.md5" #-}
 -- | Run md5sum on a file and return the resulting checksum as text.
 md5sum :: FilePath -> IO String
 md5sum path = B.readFile path >>= return . show . Data.Digest.Pure.MD5.md5
 
+#if !__GHCJS__
 -- | Predicate to decide if two files have the same inode.
 sameInode :: FilePath -> FilePath -> IO Bool
 sameInode a b =
@@ -108,6 +111,7 @@
       aStatus <- getFileStatus a
       bStatus <- getFileStatus b
       return (deviceID aStatus == deviceID bStatus && fileID aStatus == fileID bStatus)
+#endif
 
 -- | Predicate to decide if two files have the same md5 checksum.
 sameMd5sum :: FilePath -> FilePath -> IO Bool
@@ -123,11 +127,13 @@
 -}
 
 -- |A version of read with a more helpful error message.
+read' :: Read p => String -> p
 read' s =
     case reads s of
       [] -> error $ "read - no parse: " ++ show s
       ((x, _s) : _) -> x
 
+#if !__GHCJS__
 checkSuperUser :: IO Bool
 checkSuperUser = getEffectiveUserID >>= return . (== 0)
 
@@ -146,10 +152,11 @@
                          (s : _) -> Just s
 
 cd :: FilePath -> IO a -> IO a
-cd name m = 
-    bracket 
+cd name m =
+    bracket
         (do cwd <- getCurrentDirectory
             setCurrentDirectory name
             return cwd)
         (\oldwd -> do setCurrentDirectory oldwd)
         (const m)
+#endif
diff --git a/Extra/Monad/Supply.hs b/Extra/Monad/Supply.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Monad/Supply.hs
@@ -0,0 +1,113 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+-- | Support for computations which consume values from a (possibly infinite)
+-- supply. See <http://www.haskell.org/haskellwiki/New_monads/MonadSupply> for
+-- details.
+module Extra.Monad.Supply
+( MonadSupply (..)
+, SupplyT
+, Supply
+, evalSupplyT
+, evalSupply
+, runSupplyT
+, runSupply
+, supplies
+) where
+
+import Control.Monad.Fix
+import Control.Monad.Identity
+import Control.Monad.RWS
+import Control.Monad.State
+import Control.Monad.Except
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Control.Monad.Morph (MFunctor(..))
+import qualified Data.Semigroup as Sem
+
+class Monad m => MonadSupply s m | m -> s where
+  supply :: m s
+  peek :: m s
+  exhausted :: m Bool
+
+-- | Supply monad transformer.
+newtype SupplyT s m a = SupplyT (StateT [s] m a)
+  deriving (Functor, Applicative, Monad, MonadTrans, MonadIO, MonadFix)
+
+instance MonadError e m => MonadError e (SupplyT s m) where
+  throwError = SupplyT . lift . throwError
+  catchError (SupplyT action) handler = SupplyT (action `catchError` (\e -> (\(SupplyT m) -> m) $ handler e))
+
+-- | Supply monad.
+newtype Supply s a = Supply (SupplyT s Identity a)
+  deriving (Functor, Applicative, Monad, MonadSupply s)
+
+
+instance Monad m => MonadSupply s (SupplyT s m) where
+  supply = SupplyT $ do ~(x:xs) <- get
+                        put xs
+                        return x
+  peek = SupplyT $ gets head
+  exhausted = SupplyT $ gets null
+
+-- Monad transformer instances
+instance (MonadSupply s m) => MonadSupply s (ExceptT e m) where
+  supply = lift supply
+  peek = lift peek
+  exhausted = lift exhausted
+
+instance MonadSupply s m => MonadSupply s (StateT st m) where
+  supply = lift supply
+  peek = lift peek
+  exhausted = lift exhausted
+
+instance MonadSupply s m => MonadSupply s (ReaderT r m) where
+  supply = lift supply
+  peek = lift peek
+  exhausted = lift exhausted
+
+instance (Monoid w, MonadSupply s m) => MonadSupply s (WriterT w m) where
+  supply = lift supply
+  peek = lift peek
+  exhausted = lift exhausted
+
+instance (MonadSupply s m, Monoid w) => MonadSupply s (RWST r w st m) where
+  supply = lift supply
+  peek = lift peek
+  exhausted = lift exhausted
+
+instance MFunctor (SupplyT a) where
+  hoist f (SupplyT s) = SupplyT (hoist f s)
+
+-- | Monoid instance for the supply monad. Actually any monad/monoid pair
+-- gives rise to this monoid instance, but we can't write its type like that
+-- because it would conflict with existing instances provided by Data.Monoid.
+--instance (Monoid a, Monad m) => Monoid (m a) where
+instance Sem.Semigroup a => Sem.Semigroup (Supply s a) where
+  m1 <> m2 = do
+    x1 <- m1
+    x2 <- m2
+    return (x1 Sem.<> x2)
+
+instance (Monoid a) => Monoid (Supply s a) where
+  mempty = return mempty
+  mappend = (<>)
+
+-- | Get n supplies.
+supplies :: MonadSupply s m => Int -> m [s]
+supplies n = replicateM n supply
+
+evalSupplyT :: Monad m => SupplyT s m a -> [s] -> m a
+evalSupplyT (SupplyT s) = evalStateT s
+
+evalSupply :: Supply s a -> [s] -> a
+evalSupply (Supply s) = runIdentity . evalSupplyT s
+
+runSupplyT :: SupplyT s m a -> [s] -> m (a,[s])
+runSupplyT (SupplyT s) = runStateT s
+
+runSupply :: Supply s a -> [s] -> (a,[s])
+runSupply (Supply s) = runIdentity . runSupplyT s
diff --git a/Extra/Net.hs b/Extra/Net.hs
--- a/Extra/Net.hs
+++ b/Extra/Net.hs
@@ -1,7 +1,8 @@
-module Extra.Net
-    ( webServerDirectoryContents
-    ) where
+{-# LANGUAGE CPP #-}
 
+module Extra.Net where
+
+#if 0
 import qualified Data.ByteString.Lazy.Char8 as L
 import		 Data.Maybe
 import		 Text.Regex
@@ -18,3 +19,4 @@
       re = mkRegex "( <A HREF|<a href)=\"([^/][^\"]*)/\""
       second (Just [_, b]) = Just b
       second _ = Nothing
+#endif
diff --git a/Extra/Orphans.hs b/Extra/Orphans.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Orphans.hs
@@ -0,0 +1,132 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS -Wno-orphans #-}
+
+module Extra.Orphans where
+
+import Data.Graph.Inductive as G
+import Data.List (intercalate)
+import Data.Proxy (Proxy(Proxy))
+import Data.SafeCopy (base, contain,
+                      SafeCopy(errorTypeName, getCopy, kind, putCopy, version))
+import Data.Serialize.Get (label)
+import Data.Text as T hiding (concat, intercalate)
+import Data.Text.Lazy as LT hiding (concat, intercalate)
+import Data.Time (UTCTime(..), Day(ModifiedJulianDay), TimeOfDay(..), timeOfDayToTime, DiffTime)
+import Data.UserId (UserId(..))
+import Data.UUID.Orphans ()
+import Data.UUID (UUID)
+import Data.UUID.V4 as UUID (nextRandom)
+import Data.UUID.Orphans ({-instance SafeCopy UUID-})
+import Extra.Orphans2 ()
+import GHC.Generics (Generic)
+import Instances.TH.Lift ()
+import Language.Haskell.TH (Ppr(ppr))
+import Language.Haskell.TH.Lift -- (deriveLift, deriveLiftMany)
+import Language.Haskell.TH.PprLib (ptext)
+import Network.URI (URI(..), URIAuth(..), uriToString)
+import System.IO.Unsafe (unsafePerformIO)
+#if !__GHCJS__
+import Test.QuickCheck (Arbitrary(arbitrary), choose, elements, Gen, listOf, listOf1, resize)
+#endif
+
+instance SafeCopy (Proxy t) where
+      putCopy Proxy = contain (do { return () })
+      getCopy = contain (label "Data.Proxy.Proxy:" (pure Proxy))
+      version = 0
+      kind = base
+      errorTypeName _ = "Data.Proxy.Proxy"
+
+#if 1
+deriving instance Generic Day
+deriving instance Generic UTCTime
+#else
+#endif
+
+deriving instance Generic URIAuth
+
+-- $(deriveLift ''UserId)
+instance Lift UserId where lift (UserId x0) = [|UserId $(lift x0)|]
+
+$(deriveLift ''G.Gr)
+$(deriveLift ''G.NodeMap)
+
+instance Ppr UserId where ppr = ptext . show
+
+#if !__GHCJS__
+instance Arbitrary T.Text where
+    arbitrary = T.pack <$> arbitrary
+
+instance Arbitrary LT.Text where
+    arbitrary = LT.pack <$> arbitrary
+
+instance Arbitrary UUID where
+    arbitrary = pure (unsafePerformIO UUID.nextRandom)
+
+instance Arbitrary UserId where
+    arbitrary = UserId <$> choose (0, 20)
+
+instance Arbitrary UTCTime where arbitrary = UTCTime <$> arbitrary <*> arbitrary
+instance Arbitrary Day where arbitrary = ModifiedJulianDay <$> arbitrary
+instance Arbitrary DiffTime where arbitrary = timeOfDayToTime <$> arbitrary
+instance Arbitrary TimeOfDay where arbitrary = TimeOfDay <$> choose (0,23) <*> choose (0,59) <*> (fromInteger <$> choose (0,60999999999999))
+
+-- from https://gist.github.com/roman
+
+newtype URIPair
+  = URIPair { fromPair :: (String, String) }
+  deriving (Show)
+
+genWord :: Gen String
+genWord = listOf1 (choose ('a', 'z'))
+
+genCanonicalURI :: Gen URI
+genCanonicalURI =
+    URI <$> elements ["http:", "https:"]
+        <*> (Just <$> genURIAuthority)
+        <*> (('/':) <$> genPaths)
+        <*> pure ""
+        <*> pure ""
+  where
+    genURIAuthority =
+      URIAuth <$> pure ""
+              <*> genRegName
+              <*> pure ""
+    genRegName = do
+      domainName <- elements ["noomii", "google", "yahoo"]
+      return $ mconcat ["www.", domainName, ".com"]
+    genPaths = resize 10 (intercalate "/" <$> listOf genWord)
+
+genNormalURI :: URI -> Gen URI
+genNormalURI uri = do
+    qs  <- genQueryString
+    fragment <-  genFragment
+    return $ uri { uriQuery = qs, uriFragment = fragment }
+  where
+    genParam = do
+      name  <- genWord
+      value <- genWord
+      return $ name ++ "=" ++ value
+    genQueryString = resize 10 $
+      ('?':) <$> (intercalate "&" <$> listOf genParam)
+    genFragment = ('#':) <$> genWord
+
+instance Arbitrary URIPair where
+    arbitrary = do
+      canonical <- genCanonicalURI
+      normal    <- genNormalURI canonical
+      return (URIPair (uriToString id canonical "", uriToString id normal ""))
+
+instance Arbitrary URI where
+    arbitrary = genCanonicalURI >>= genNormalURI
+#endif
+
+instance SafeCopy URI where version = 0
+instance SafeCopy URIAuth where version = 0
+
+$(concat <$>
+  sequence
+  [ deriveLiftMany [''URI, ''URIAuth] ])
diff --git a/Extra/Orphans2.hs b/Extra/Orphans2.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Orphans2.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS -Wall -fno-warn-orphans #-}
+
+module Extra.Orphans2 where
+
+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.Map as Map (Map, toList)
+import Data.SafeCopy (SafeCopy(..))
+import Data.Set as Set (Set, toList)
+#if !__GHCJS__
+import Debug.Show (V(V))
+#endif
+import Language.Haskell.TH
+import Language.Haskell.TH.PprLib (Doc, hcat, ptext, vcat)
+import Language.Haskell.TH.Syntax (ModName, NameFlavour, OccName, PkgName)
+import Prelude hiding (concat, foldl1)
+
+instance Ppr (Type, Int32) where
+  ppr (t, n) = pprPair (t, n)
+
+instance Ppr Int32 where ppr = ptext . show
+
+instance Ppr (Name, [Type]) where
+    ppr (name, params) = ppr (foldl1 AppT (ConT name : params))
+
+pprPair :: (Ppr a, Ppr b) => (a, b) -> Doc
+pprPair (a, b) = hcat [ptext "(", ppr a, ptext ",", ppr b, ptext ")"]
+
+pprList :: [Doc] -> Doc
+pprList xs = hcat [ptext "[", hcat (intersperse (ptext ",") xs), ptext "]"]
+
+-- deriving instance Data CmdSpec
+
+#if 0
+instance Arbitrary ReportImageID where arbitrary = ReportImageID <$> arbitrary
+instance Arbitrary ReportElemID where arbitrary = ReportElemID <$> arbitrary
+instance (Arbitrary v, Enum k, Ord k) => Arbitrary (Order k v) where
+    arbitrary = sized $ \n -> do
+      vs <- vectorOf n (arbitrary :: Gen v)
+      ks <- shuffle (take n [toEnum 0..] :: [k])
+      fromPairs <$> shuffle (zip ks vs)
+#endif
+
+instance Ppr Char where ppr = ptext . show
+instance Ppr Float where ppr = ptext . show
+-- instance Ppr ReportElemID where ppr = ptext . show
+-- instance Ppr ReportImageID where ppr = ptext . show
+instance (Ppr k, Ppr v) => Ppr (Map k v) where ppr = pprList . fmap pprPair . Map.toList
+#if 0
+instance (Ppr k, Ppr v) => Ppr (Order k v) where ppr = pprList . fmap pprPair . LL.toList . toPairs
+#endif
+instance Ppr (Int, Char) where ppr = ptext . show
+
+instance Ppr Bool where
+    ppr True = ptext "True"
+    ppr False = ptext "False"
+
+#if !__GHCJS__
+instance Show (V TyCon) where
+    show (V c) =
+        "TyCon {" ++
+        "module=" ++ show (tyConModule c) ++
+        " name=" ++ show (tyConName c) ++
+        " package=" ++ show (tyConPackage c) ++
+        " fingerprint=" ++ show (tyConFingerprint c) ++ "}"
+
+instance Show (V TypeRep) where
+    show (V r) =
+        case splitTyConApp r of
+          (c, rs) -> "[" ++ intercalate "," (show (V c) : fmap (show . V) rs) ++ "]"
+#endif
+
+instance Ppr TypeRep where
+  ppr = ptext . show
+
+instance Ppr () where
+    ppr () = ptext "()"
+
+-- | 'Int' is the 'Data.Path.Index.ContainerKey' type for all lists, so
+-- we need to make sure all the required instances exist.
+instance Ppr Int where
+    ppr = ptext . show
+
+instance Ppr (Set Type, Set Type) where
+    ppr (extra, missing) = vcat [ptext "extra:", ppr extra, ptext "missing:", ppr missing]
+
+instance Ppr (Set Type) where
+    ppr s = hcat [ptext "Set.fromList [", ppr (Set.toList s), ptext "]"]
+
+instance SafeCopy OccName where version = 0
+instance SafeCopy NameSpace where version = 0
+instance SafeCopy PkgName where version = 0
+instance SafeCopy ModName where version = 0
+instance SafeCopy NameFlavour where version = 0
+instance SafeCopy Name where version = 0
+instance SafeCopy Loc where version = 1
diff --git a/Extra/Orphans3.hs b/Extra/Orphans3.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Orphans3.hs
@@ -0,0 +1,247 @@
+-- | Serialize and SafeCopy instances for the template haskell Exp type.
+-- Some Arbitrary, Lift, and Ppr instances.
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS -Wall -Wredundant-constraints -Wno-orphans #-}
+
+module Extra.Orphans3 where
+
+import Data.Data (Data, dataTypeOf, gunfold, mkNoRepType, toConstr, TypeRep)
+import Data.Foldable
+--import Data.Function.Memoize (deriveMemoizable)
+import Data.Generics.Instances ()
+import Data.ListLike as LL hiding (concat, sequence, toList)
+-- import Data.Order (Order, toPairs)
+import Data.Proxy (Proxy(Proxy))
+import Data.SafeCopy (SafeCopy(..))
+import Extra.Serialize (Serialize)
+import Extra.Orphans ()
+import Language.Haskell.TH
+import Language.Haskell.TH.Instances ()
+import Language.Haskell.TH.PprLib (Doc, hcat, ptext)
+import Language.Haskell.TH.Syntax
+import Prelude hiding (concat, foldl1)
+#if !__GHCJS__
+import Network.URI
+import Test.QuickCheck (Arbitrary(arbitrary), elements, Gen, oneof)
+#endif
+
+pprPair :: (Ppr a, Ppr b) => (a, b) -> Doc
+pprPair (a, b) = hcat [ptext "(", ppr a, ptext ",", ppr b, ptext ")"]
+
+pprList :: [Doc] -> Doc
+pprList xs = hcat [ptext "[", hcat (intersperse (ptext ",") xs), ptext "]"]
+
+#if 0
+instance (Ppr k, Ord k, Enum k, Show k, Ppr v) => Ppr (Order k v) where
+  ppr = pprList . toList . fmap pprPair . toPairs
+#endif
+
+#if __GLASGOW_HASKELL__ >= 802
+instance Data TypeRep where
+  toConstr _   = error "toConstr"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "Data.Typeable.TypeRep"
+#endif
+
+deriving instance Serialize (Proxy a)
+
+#if !__GHCJS__
+instance Lift (Proxy a) where lift Proxy = [|Proxy|]
+
+instance Arbitrary NameSpace where
+    arbitrary = elements [VarName, DataName, TcClsName]
+
+instance Arbitrary Type where
+    arbitrary = oneof [ ForallT <$> arbitrary <*> arbitrary <*> arbitrary
+                      , AppT <$> arbitrary <*> arbitrary
+                      , SigT <$> arbitrary <*> arbitrary
+                      , VarT <$> arbitraryTypeVariableName
+                      , ConT <$> arbitrary
+                      , PromotedT <$> arbitrary
+                      , TupleT <$> arbitrary
+                      , UnboxedTupleT <$> arbitrary
+                      , pure ArrowT
+                      , pure EqualityT
+                      , pure ListT
+                      , PromotedTupleT <$> arbitrary
+                      , pure PromotedNilT
+                      , pure PromotedConsT
+                      , pure StarT
+                      , pure ConstraintT
+                      , LitT <$> arbitrary ]
+
+instance Arbitrary (Proxy a) where arbitrary = elements [Proxy]
+instance Arbitrary Name where arbitrary = pure (mkName "aName")
+instance Arbitrary TyLit where arbitrary = oneof [NumTyLit <$> arbitrary, StrTyLit <$> arbitraryConstructorName]
+instance Arbitrary TyVarBndr where arbitrary = oneof [PlainTV <$> arbitraryTypeVariableName, KindedTV <$> arbitraryTypeVariableName <*> arbitraryKind]
+
+instance Arbitrary URIAuth where
+    arbitrary =
+      URIAuth <$> pure ""
+              <*> genRegName
+              <*> pure ""
+        where
+          genRegName = do
+            domainName <- elements ["noomii", "google", "yahoo"]
+            return $ concat ["www.", domainName, ".com"]
+
+arbitraryKind :: Gen Kind
+arbitraryKind = oneof [pure StarT {-, finish me -}]
+
+arbitraryConstructorName :: Gen String
+arbitraryConstructorName = pure "AConstructor"
+
+arbitraryTypeVariableName :: Gen Name
+arbitraryTypeVariableName = pure (mkName "aTyVarName")
+
+-- s = $(location >>= \Loc{loc_module=m, loc_start=(sl,sc), loc_end=(el,ec)} -> lift (m <> ":" <> show sl))
+#endif
+
+deriving instance Serialize AnnTarget
+deriving instance Serialize Bang
+deriving instance Serialize Body
+deriving instance Serialize Callconv
+deriving instance Serialize Clause
+deriving instance Serialize Con
+deriving instance Serialize Dec
+deriving instance Serialize DerivClause
+deriving instance Serialize DerivStrategy
+deriving instance Serialize Exp
+deriving instance Serialize FamilyResultSig
+deriving instance Serialize Fixity
+deriving instance Serialize FixityDirection
+deriving instance Serialize Foreign
+deriving instance Serialize FunDep
+deriving instance Serialize Guard
+deriving instance Serialize InjectivityAnn
+deriving instance Serialize Inline
+deriving instance Serialize Lit
+deriving instance Serialize Match
+deriving instance Serialize ModName
+deriving instance Serialize Name
+deriving instance Serialize NameFlavour
+deriving instance Serialize NameSpace
+deriving instance Serialize OccName
+deriving instance Serialize Overlap
+deriving instance Serialize Pat
+deriving instance Serialize PatSynArgs
+deriving instance Serialize PatSynDir
+deriving instance Serialize Phases
+deriving instance Serialize PkgName
+deriving instance Serialize Pragma
+deriving instance Serialize Range
+deriving instance Serialize Role
+deriving instance Serialize RuleBndr
+deriving instance Serialize RuleMatch
+deriving instance Serialize Safety
+deriving instance Serialize SourceStrictness
+deriving instance Serialize SourceUnpackedness
+deriving instance Serialize Stmt
+deriving instance Serialize TyLit
+deriving instance Serialize Type
+deriving instance Serialize TypeFamilyHead
+deriving instance Serialize TySynEqn
+deriving instance Serialize TyVarBndr
+
+#if 0
+deriving instance NFData AnnTarget
+deriving instance NFData Bang
+deriving instance NFData Body
+deriving instance NFData Callconv
+deriving instance NFData Clause
+deriving instance NFData Con
+deriving instance NFData Dec
+deriving instance NFData DerivClause
+deriving instance NFData DerivStrategy
+deriving instance NFData Exp
+deriving instance NFData FamilyResultSig
+deriving instance NFData Fixity
+deriving instance NFData FixityDirection
+deriving instance NFData Foreign
+deriving instance NFData FunDep
+deriving instance NFData Guard
+deriving instance NFData InjectivityAnn
+deriving instance NFData Inline
+deriving instance NFData Lit
+deriving instance NFData Match
+deriving instance NFData ModName
+deriving instance NFData Name
+deriving instance NFData NameFlavour
+deriving instance NFData NameSpace
+deriving instance NFData OccName
+deriving instance NFData Overlap
+deriving instance NFData Pat
+deriving instance NFData PatSynArgs
+deriving instance NFData PatSynDir
+deriving instance NFData Phases
+deriving instance NFData PkgName
+deriving instance NFData Pragma
+deriving instance NFData Range
+deriving instance NFData Role
+deriving instance NFData RuleBndr
+deriving instance NFData RuleMatch
+deriving instance NFData Safety
+deriving instance NFData TH.SourceStrictness
+deriving instance NFData TH.SourceUnpackedness
+deriving instance NFData Stmt
+deriving instance NFData TyLit
+deriving instance NFData Type
+deriving instance NFData TypeFamilyHead
+deriving instance NFData TySynEqn
+deriving instance NFData TyVarBndr
+#endif
+
+instance SafeCopy AnnTarget where version = 1
+instance SafeCopy Bang where version = 1
+instance SafeCopy Body where version = 1
+instance SafeCopy Callconv where version = 1
+instance SafeCopy Clause where version = 1
+instance SafeCopy Con where version = 1
+instance SafeCopy Dec where version = 1
+instance SafeCopy DerivClause where version = 1
+instance SafeCopy DerivStrategy where version = 1
+instance SafeCopy Exp where version = 1
+instance SafeCopy FamilyResultSig where version = 1
+instance SafeCopy Fixity where version = 1
+instance SafeCopy FixityDirection where version = 1
+instance SafeCopy Foreign where version = 1
+instance SafeCopy FunDep where version = 1
+instance SafeCopy Guard where version = 1
+instance SafeCopy InjectivityAnn where version = 1
+instance SafeCopy Inline where version = 1
+instance SafeCopy Lit where version = 1
+instance SafeCopy Match where version = 1
+-- instance SafeCopy ModName where version = 1
+-- instance SafeCopy Name where version = 1
+-- instance SafeCopy NameFlavour where version = 1
+-- instance SafeCopy NameSpace where version = 1
+-- instance SafeCopy OccName where version = 1
+instance SafeCopy Overlap where version = 1
+instance SafeCopy Pat where version = 1
+instance SafeCopy PatSynArgs where version = 1
+instance SafeCopy PatSynDir where version = 1
+instance SafeCopy Phases where version = 1
+-- instance SafeCopy PkgName where version = 1
+instance SafeCopy Pragma where version = 1
+instance SafeCopy Range where version = 1
+instance SafeCopy Role where version = 1
+instance SafeCopy RuleBndr where version = 1
+instance SafeCopy RuleMatch where version = 1
+instance SafeCopy Safety where version = 1
+instance SafeCopy SourceStrictness where version = 1
+instance SafeCopy SourceUnpackedness where version = 1
+instance SafeCopy Stmt where version = 1
+instance SafeCopy TyLit where version = 1
+instance SafeCopy Type where version = 1
+instance SafeCopy TypeFamilyHead where version = 1
+instance SafeCopy TySynEqn where version = 1
+instance SafeCopy TyVarBndr where version = 1
diff --git a/Extra/Pretty.hs b/Extra/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Pretty.hs
@@ -0,0 +1,104 @@
+-- | A constructor we can wrap around values to avoid any built in
+-- Pretty instance - for example, instance Pretty [a].
+--
+--  * display is now prettyShow
+--  * display' is now prettyText
+--  * ppDisplay is now ppShow
+--  * ppDisplay' is now ppText
+
+{-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, OverloadedStrings, TypeSynonymInstances #-}
+
+module Extra.Pretty
+    ( PP(PP, unPP)
+    , prettyText
+    , ppPrint
+    , pprPair
+    , pprSet
+    , ppShow
+    , ppText
+    , pprint1, pprint1', render1
+    , pprintW
+    , friendlyNames
+    -- * Re-export
+    , prettyShow
+    , renderW
+    ) where
+
+import Data.Data (Data)
+import Data.Generics (everywhere, mkT)
+import Data.Set as Set (Set, toList)
+import Data.Text (Text, unpack, pack)
+import Distribution.Pretty (Pretty(pretty), prettyShow)
+import Language.Haskell.TH
+import Language.Haskell.TH.PprLib as TH (Doc, hcat, hsep, ptext, to_HPJ_Doc)
+import Language.Haskell.TH.Syntax
+import qualified Text.PrettyPrint as HPJ
+import Text.PrettyPrint.HughesPJClass as HPJ (Doc, text, empty)
+
+-- | This type is wrapped around values before we pretty print them so
+-- we can write our own Pretty instances for common types without
+-- polluting the name space of clients of this package with instances
+-- they don't want.
+newtype PP a = PP {unPP :: a} deriving (Functor)
+
+instance Pretty (PP Text) where
+    pretty = text . unpack . unPP
+
+instance Pretty (PP String) where
+    pretty = text . unPP
+
+instance Pretty (PP a) => Pretty (PP (Maybe a)) where
+    pretty = maybe empty ppPrint . unPP
+
+prettyText :: Pretty a => a -> Text
+prettyText = pack . prettyShow
+
+ppPrint :: Pretty (PP a) => a -> HPJ.Doc
+ppPrint = pretty . PP
+
+ppShow :: Pretty (PP a) => a -> String
+ppShow = prettyShow . PP
+
+ppText :: Pretty (PP a) => a -> Text
+ppText = pack . prettyShow . PP
+
+-- | Make a template haskell value more human reader friendly.  The
+-- result may or may not be compilable.  That's ok, though, because
+-- the input is usually uncompilable - it imports hidden modules, uses
+-- infix operators in invalid positions, puts module qualifiers in
+-- places where they are not allowed, and maybe other things.
+friendlyNames :: Data a => a -> a
+friendlyNames =
+    everywhere (mkT friendlyName)
+    where
+      friendlyName (Name x _) = Name x NameS -- Remove all module qualifiers
+
+-- | Render a 'Doc' on a single line.
+render1 :: TH.Doc -> String
+render1 = HPJ.renderStyle (HPJ.style {HPJ.mode = HPJ.OneLineMode}) . to_HPJ_Doc
+
+-- | Render a 'Doc' with the given width.
+renderW :: Int -> TH.Doc -> String
+renderW w = HPJ.renderStyle (HPJ.style {HPJ.lineLength = w}) . to_HPJ_Doc
+
+-- | Pretty print the result of 'render1'.
+pprint1' :: Ppr a => a -> [Char]
+pprint1' = render1 . ppr
+
+-- | 'pprint1'' with friendlyNames.
+pprint1 :: (Ppr a, Data a) => a -> [Char]
+pprint1 = pprint1' . friendlyNames
+
+-- | Pretty print the result of 'renderW'.
+pprintW' :: Ppr a => Int -> a -> [Char]
+pprintW' w = renderW w . ppr
+
+-- | 'pprintW'' with friendly names.
+pprintW :: (Ppr a, Data a) => Int -> a -> [Char]
+pprintW w = pprintW' w . friendlyNames
+
+pprPair :: (Ppr a, Ppr b) => (a, b) -> TH.Doc
+pprPair (a, b) = hcat [ptext "(", ppr a, ptext ", ", ppr b, ptext ")"]
+
+pprSet :: Ppr a => Set a -> TH.Doc
+pprSet s = hcat [ptext "[", hsep (fmap ppr (Set.toList s)), ptext "]"]
diff --git a/Extra/Process.hs b/Extra/Process.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Process.hs
@@ -0,0 +1,325 @@
+-- | Various redundant versions of shell command running code
+-- collected here from several different places.
+
+{-# LANGUAGE CPP, FlexibleContexts, RankNTypes, ScopedTypeVariables, TemplateHaskell, TypeFamilies #-}
+{-# OPTIONS_GHC -Wall -Wredundant-constraints #-}
+module Extra.Process
+    ( CreateProcess
+    , timeTask
+    , RunOptions(..)
+    -- * builders for RunOptions
+    , showCommand
+    , showCommandAndResult
+    , putIndented
+    -- * Simple process runners
+    , run
+    , runV, runVE
+    , runQ, runQE
+    , runIO
+    , testExit
+    , processException
+    , insertProcessEnv
+    , modifyProcessEnv
+    , HasLoc(withLoc)
+    -- * Refugees
+    , runV2, runVE2, runQ2, runQE2
+    , run2
+    , runV3, runQE3
+    ) where
+
+import Control.Arrow (second)
+import Control.Exception (evaluate, Exception, IOException, throw)
+import Control.Lens (view)
+import Control.Monad.Catch (catch, MonadCatch, try)
+import Control.Monad.Except (throwError)
+import Control.Monad.Reader (MonadReader)
+import Control.Monad.State (evalState, StateT, get, put)
+import Control.Monad.Trans (liftIO, MonadIO)
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.ListLike (break, head, hPutStr, null, singleton, tail)
+import Data.Semigroup (Semigroup((<>)))
+import Data.String (IsString(fromString))
+import Data.Text (unpack)
+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.EnvPath (HasEnvRoot(envRootLens), rootPath)
+import Extra.Verbosity (ePutStrLn)
+import Extra.TH (here, prettyLocs)
+import GHC.IO.Exception (IOErrorType(OtherError))
+import Language.Haskell.TH.Syntax (Loc)
+import Prelude hiding (break, head, null, tail)
+import System.Environment (getEnvironment)
+import System.Exit (ExitCode(..))
+import System.IO (hPutStrLn, stdout, stderr)
+import System.IO.Error (mkIOError)
+import System.Process (CreateProcess(cwd, env))
+import System.Process.ListLike (Chunk(..), collectOutput, ListLikeProcessIO, readCreateProcessLazy, readCreateProcessWithExitCode, showCreateProcessForUser)
+
+-- | Run a task and return the elapsed time along with its result.
+timeTask :: MonadIO m => m a -> m (a, NominalDiffTime)
+timeTask x =
+    do start <- liftIO $ getCurrentTime
+       result <- x >>= liftIO . evaluate
+       finish <- liftIO $ getCurrentTime
+       return (result, diffUTCTime finish start)
+
+data RunOptions a m
+    = StartMessage (String -> CreateProcess -> m ())
+    | OverOutput ([Chunk a] -> m [Chunk a]) -- e.g. putIndented
+    | FinishMessage (String -> CreateProcess -> (ExitCode, a, a) -> m ())
+    -- | Verbosity Int
+    | RunOptions [RunOptions a m]
+
+instance Semigroup (RunOptions a m) where
+    RunOptions a <> RunOptions b = RunOptions (a <> b)
+    RunOptions a <> b = RunOptions (a <> [b])
+    a <> RunOptions b = RunOptions ([a] <> b)
+    a <> b = RunOptions [a, b]
+
+showCommand :: MonadIO m => String -> CreateProcess -> m ()
+showCommand prefix p = liftIO $ ePutStrLn (prefix ++ showCreateProcessForUser p)
+
+showCommandAndResult :: MonadIO m => [Char] -> CreateProcess -> (ExitCode, a, a) -> m ()
+showCommandAndResult prefix p (code, _, _) =
+    liftIO $ ePutStrLn (prefix ++ showCreateProcessForUser p ++ " -> " ++ show code)
+
+putIndented :: forall a c m. (Eq c, ListLikeProcessIO a c, IsString a, MonadIO m) => [Chunk a] -> m [Chunk a]
+putIndented chunks =
+    liftIO $ mapM_ echo (indentChunks "     1> " "     2> " chunks) >> return chunks
+    where
+      echo :: Chunk a -> IO (Chunk a)
+      echo c@(Stdout x) = hPutStr stdout x >> return c
+      echo c@(Stderr x) = hPutStr stderr x >> return c
+      echo c = return c
+
+run ::
+    forall a c e m. (HasLoc e, MonadIO m, MonadError e m, ListLikeProcessIO a c)
+    => RunOptions a m
+    -> CreateProcess
+    -> a
+    -> 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
+  finish " <- " p result
+  return result
+    where
+      -- We need the options as a Foldable type
+      opts' :: [RunOptions a m]
+      opts' = case opts of RunOptions xs -> xs; x -> [x]
+      start :: String -> CreateProcess -> m ()
+      start = foldr (\o f -> case o of (StartMessage f') -> f'; _ -> f) (\_ _ -> pure ()) opts'
+      finish :: String -> CreateProcess -> (ExitCode, a, a) -> m ()
+      finish = foldr (\o f -> case o of (FinishMessage f') -> f'; _ -> f) (\_ _ _ -> pure ()) opts'
+      overOutput :: [Chunk a] -> m [Chunk a]
+      overOutput = foldr (\o f -> case o of (OverOutput f') -> f'; _ -> f) return opts'
+
+--runVE :: (Eq c, IsString a, ListLikeProcessIO a c, MonadIO m, MonadCatch m) => CreateProcess -> a -> m (Either SomeException (ExitCode, a, a))
+--runVE p input = try $ runV p input
+
+runV ::
+    (Eq c, IsString a, ListLikeProcessIO a c, HasLoc e, MonadIO m, MonadError e m)
+    => CreateProcess -> a -> m (ExitCode, a, a)
+runV p input = run (StartMessage showCommand <> OverOutput putIndented <> FinishMessage showCommandAndResult) p input
+
+runVE ::
+    (Eq c, IsString a, ListLikeProcessIO a c, MonadCatch m, HasLoc e, Exception e, MonadError e m, MonadIO m)
+    => CreateProcess -> a -> m (Either e (ExitCode, a, a))
+runVE p i = try $ runV p i
+
+--runQE :: (ListLikeProcessIO a c, MonadIO m, MonadCatch m) => CreateProcess -> a -> m (Either SomeException (ExitCode, a, a))
+--runQE p input = try $ runQ p input
+
+runQ ::
+    (ListLikeProcessIO a c, HasLoc e, MonadIO m, MonadError e m)
+    => CreateProcess -> a -> m (ExitCode, a, a)
+runQ p input = run (StartMessage showCommand <> FinishMessage showCommandAndResult) p input
+
+runQE ::
+    (ListLikeProcessIO a c, MonadCatch m, HasLoc e, MonadIO m, MonadError e m, Exception e)
+    => CreateProcess -> a -> m (Either e (ExitCode, a, a))
+runQE p i = try $ runQ p i
+
+runIO :: CreateProcess -> IO L.ByteString
+runIO cp = do
+  (code, out, err) <- readCreateProcessWithExitCode cp L.empty
+  case code of
+    ExitSuccess -> return out
+    ExitFailure _ -> throwError $ userError $ unlines $
+                                       [ show code
+                                       , " command: " ++ showCreateProcessForUser cp
+                                       , " stderr: " ++ unpack (decodeUtf8 (L.toStrict err))
+                                       , " stdout: " ++ unpack (decodeUtf8 (L.toStrict out)) ]
+
+-- | Pure function to indent the text of a chunk list.
+indentChunks :: forall a c. (ListLikeProcessIO a c, Eq c, IsString a) => String -> String -> [Chunk a] -> [Chunk a]
+indentChunks outp errp chunks =
+    evalState (Prelude.concat <$> mapM (indentChunk nl (fromString outp) (fromString errp)) chunks) BOL
+    where
+      nl :: c
+      nl = Data.ListLike.head (fromString "\n" :: a)
+
+-- | The monad state, are we at the beginning of a line or the middle?
+data BOL = BOL | MOL deriving (Eq)
+
+-- | Indent the text of a chunk with the prefixes given for stdout and
+-- stderr.  The state monad keeps track of whether we are at the
+-- beginning of a line - when we are and more text comes we insert one
+-- of the prefixes.
+indentChunk :: forall a c m. (Monad m, ListLikeProcessIO a c, Eq c) => c -> a -> a -> Chunk a -> StateT BOL m [Chunk a]
+indentChunk nl outp errp chunk =
+    case chunk of
+      Stdout x -> doText Stdout outp x
+      Stderr x -> doText Stderr errp x
+      _ -> return [chunk]
+    where
+      doText :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a]
+      doText con pre x = do
+        let (hd, tl) = break (== nl) x
+        (<>) <$> doHead con pre hd <*> doTail con pre tl
+      doHead :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a]
+      doHead _ _ x | null x = return []
+      doHead con pre x = do
+        bol <- get
+        case bol of
+          BOL -> put MOL >> return [con (pre <> x)]
+          MOL -> return [con x]
+      doTail :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a]
+      doTail _ _ x | null x = return []
+      doTail con pre x = do
+        bol <- get
+        put BOL
+        tl <- doText con pre (tail x)
+        return $ (if bol == BOL then [con pre] else []) <> [con (singleton nl)] <> tl
+
+-- | Turn process exit codes into exceptions.
+{-
+throwProcessResult' :: (ExitCode -> Maybe IOError) -> CreateProcess -> [Chunk a] -> IO [Chunk a]
+throwProcessResult' f p chunks = mapResultM (\ code -> maybe (return $ Result code) (throw $ processException p code) (f code)) chunks
+
+-- | Turn process exit codes into exceptions with access to the
+-- original CreateProcess record.
+throwProcessResult'' :: Exception e => (CreateProcess -> ExitCode -> Maybe e) -> CreateProcess -> [Chunk a] -> IO [Chunk a]
+throwProcessResult'' f p chunks = mapResultM (\ code -> maybe (return $ Result code) throw (f p code)) chunks
+
+throwProcessFailure :: CreateProcess -> [Chunk a] -> IO [Chunk a]
+throwProcessFailure p = throwProcessResult' (testExit Nothing (Just . processException p . ExitFailure)) p
+
+mapResultM :: Monad m => (ExitCode -> m (Chunk a)) -> [Chunk a] -> m [Chunk a]
+mapResultM f chunks = mapM (\ x -> case x of Result code -> f code; _ -> return x) chunks
+-}
+
+testExit :: a -> (Int -> a) -> ExitCode -> a
+testExit s _ ExitSuccess = s
+testExit _ f (ExitFailure n) = f n
+
+-- | Copied from "System.Process", the exception thrown when the
+-- process started by 'System.Process.readProcess' gets an
+-- 'ExitFailure'.
+processException :: CreateProcess -> ExitCode -> IOError
+processException p code =
+    mkIOError OtherError (showCreateProcessForUser p ++ maybe "" (\ d -> "(in " ++ show d ++ ")") (cwd p) ++ " -> " ++ show code) Nothing Nothing
+
+-- | Set an environment variable in the CreateProcess, initializing it
+-- with what is in the current environment.
+insertProcessEnv :: [(String, String)] -> CreateProcess -> IO CreateProcess
+insertProcessEnv pairs = modifyProcessEnv (map (second Just) pairs)
+
+modEnv1 :: [(String, String)] -> (String, Maybe String) -> [(String, String)]
+modEnv1 env0 (name, mvalue) = maybe [] (\ v -> [(name, v)]) mvalue ++ filter ((/= name) . fst) env0
+
+modifyProcessEnv :: MonadIO m => [(String, Maybe String)] -> CreateProcess -> m CreateProcess
+modifyProcessEnv pairs p = do
+  env0 <- liftIO $ maybe getEnvironment return (env p)
+  let env' = foldl modEnv1 env0 pairs
+  return $ p {env = Just env'}
+
+runV2 ::
+    (MonadIO m, MonadCatch m, Eq c, IsString a, ListLikeProcessIO a c)
+    => [Loc] -> CreateProcess -> a -> m (ExitCode, a, a)
+runV2 locs p input =
+    run2 locs (StartMessage (showCommand' locs) <> OverOutput putIndented <> FinishMessage showCommandAndResult) p input
+
+runVE2 ::
+    forall a c e m. (Eq c, IsString a, ListLikeProcessIO a c, MonadIO m, MonadCatch m, Exception e)
+    => [Loc] -> CreateProcess -> a -> m (Either e (ExitCode, a, a))
+runVE2 locs p input = do
+    try (runV2 locs p input)
+
+runQ2 ::
+    (MonadIO m, MonadCatch m, ListLikeProcessIO a c)
+    => [Loc] -> CreateProcess -> a -> m (ExitCode, a, a)
+runQ2 locs p input =
+    run2 locs (StartMessage (showCommand' locs) <> FinishMessage showCommandAndResult) p input
+
+runQE2 ::
+    (ListLikeProcessIO a c, MonadIO m, MonadCatch m, Exception e)
+    => [Loc] -> CreateProcess -> a -> m (Either e (ExitCode, a, a))
+runQE2 locs p input =
+    try (runQ2 locs p input)
+
+showCommand' :: MonadIO m => [Loc] -> String -> CreateProcess -> m ()
+showCommand' locs prefix p = do
+  -- key <- view osKey
+  liftIO $ ePutStrLn (prefix ++ showCreateProcessForUser p ++ " (" ++ {-"in " ++ show key ++ ", " ++-} "called from " ++ show (prettyLocs ($here : locs)) ++ ")")
+
+run2 ::
+    forall a c m. (MonadIO m, ListLikeProcessIO a c, MonadCatch m)
+    => [Loc]
+    -> RunOptions a m
+    -> CreateProcess
+    -> a
+    -> m (ExitCode, a, a)
+run2 locs opts p input = do
+  start " -> " p
+  (result :: (ExitCode, a, a)) <- catch (liftIO (readCreateProcessLazy p input) >>= overOutput >>= return . collectOutput)
+                                        (\se -> withException (\e -> liftIO (hPutStrLn stderr ("(at " ++ show (prettyLocs ($here : locs)) ++ ": " ++ show e ++ ") :: " ++ show (typeOf e)))) se >> throw se)
+  finish " <- " p result
+  liftIO $ evaluate result
+    where
+      -- We need the options as a Foldable type
+      opts' :: [RunOptions a m]
+      opts' = case opts of RunOptions xs -> xs; x -> [x]
+      start :: String -> CreateProcess -> m ()
+      start = foldr (\o f -> case o of (StartMessage f') -> f'; _ -> f) (\_ _ -> pure ()) opts'
+      finish :: String -> CreateProcess -> (ExitCode, a, a) -> m ()
+      finish = foldr (\o f -> case o of (FinishMessage f') -> f'; _ -> f) (\_ _ _ -> pure ()) opts'
+      overOutput :: [Chunk a] -> m [Chunk a]
+      overOutput = foldr (\o f -> case o of (OverOutput f') -> f'; _ -> f) return opts'
+
+-- stray copies of the stuff above that I moved here, with MonadApt constraints
+
+runV3 ::
+    (Eq c, IsString a, ListLikeProcessIO a c, HasEnvRoot r, MonadReader r m, MonadIO m, MonadCatch m)
+    => [Loc] -> CreateProcess -> a -> m (ExitCode, a, a)
+runV3 locs p input =
+    run2 locs (StartMessage showCommand3' <> OverOutput putIndented <> FinishMessage showCommandAndResult) p input
+
+{-
+runVE3 ::
+    (Eq c, IsString a, ListLikeProcessIO a c, MonadApt r m, MonadError e m, MonadIO m, MonadCatch m)
+    => [Loc] -> CreateProcess -> a -> m (Either IOException (ExitCode, a, a))
+runVE3 locs p input = try $ runV3 locs p input
+-}
+
+runQ3 ::
+    (ListLikeProcessIO a c, HasEnvRoot r, MonadReader r m, MonadIO m, MonadCatch m)
+    => [Loc] -> CreateProcess -> a -> m (ExitCode, a, a)
+runQ3 locs p input =
+    run2 locs (StartMessage showCommand3' <> FinishMessage showCommandAndResult) p input
+
+runQE3 ::
+    (ListLikeProcessIO a c, HasEnvRoot r, MonadReader r m, MonadIO m, MonadCatch m)
+    => [Loc] -> CreateProcess -> a -> m (Either IOException (ExitCode, a, a))
+runQE3 locs p input = try $ runQ3 locs p input
+
+showCommand3' :: (HasEnvRoot r, MonadReader r m, MonadIO m) => String -> CreateProcess -> m ()
+showCommand3' prefix p = do
+  key <- view (envRootLens . rootPath)
+  liftIO $ ePutStrLn (prefix ++ showCreateProcessForUser p ++ " (in " ++ show key ++ ")")
+
+-- | Modify a value (typically an exception) to include a source code
+-- location: e.g. @withError (withLoc $here) $ tryError action@.
+class HasLoc e where withLoc :: Loc -> e -> e
diff --git a/Extra/SSH.hs b/Extra/SSH.hs
--- a/Extra/SSH.hs
+++ b/Extra/SSH.hs
@@ -4,13 +4,12 @@
     , sshCopy
     ) where
 
-import System.Cmd
 import System.Directory
 import System.Posix.User
 import System.Environment
 import System.Exit
 import System.IO
-import System.Process (readProcessWithExitCode, showCommandForUser)
+import System.Process (readProcessWithExitCode, showCommandForUser, system)
 -- |Set up access to destination (user\@host).
 sshExportDeprecated :: String -> Maybe Int -> IO (Either String ())
 sshExportDeprecated dest port =
@@ -42,12 +41,12 @@
 -- |See if we already have access to the destination (user\@host).
 sshVerify :: String -> Maybe Int -> IO Bool
 sshVerify dest port =
-    do result <- system (sshTestCmd dest port)
+    do result <- system sshTestCmd
        return $ case result of
-                  ExitSuccess -> True		-- We do
-                  ExitFailure _ -> False	-- We do not
+                  ExitSuccess -> True           -- We do
+                  ExitFailure _ -> False        -- We do not
     where
-      sshTestCmd dest port =
+      sshTestCmd =
           ("ssh -o 'PreferredAuthentications hostbased,publickey' " ++
            (maybe "" (("-p " ++) . show) port) ++ " " ++ show dest ++ " pwd > /dev/null && exit 0")
 
@@ -68,15 +67,15 @@
        (code, out, err) <- readFile keypath >>= readProcessWithExitCode "ssh" args
        case code of
          ExitFailure n -> return . Left $ "Failure: " ++ showCommandForUser "ssh" args ++ " -> " ++ show n ++
-	                                  "\n\nstdout: " ++ out ++ "\n\nstderr: " ++ err
+                                          "\n\nstdout: " ++ out ++ "\n\nstderr: " ++ err
          _ -> return . Right $ ()
     where
       sshOpenRemoteCmd =
-          ("chmod g-w . && " ++				-- Ssh will not work if the permissions aren't just so
+          ("chmod g-w . && " ++                         -- Ssh will not work if the permissions aren't just so
            "chmod o-rwx . && " ++
            "mkdir -p .ssh && " ++
            "chmod 700 .ssh && " ++
-           "cat >> .ssh/authorized_keys2 && " ++	-- Add the key to the authorized key list
+           "cat >> .ssh/authorized_keys2 && " ++        -- Add the key to the authorized key list
            "chmod 600 .ssh/authorized_keys2")
 
 -- This used to be main.
diff --git a/Extra/SafeCopy.hs b/Extra/SafeCopy.hs
new file mode 100644
--- /dev/null
+++ b/Extra/SafeCopy.hs
@@ -0,0 +1,104 @@
+-- | This module exports a template haskell function to create
+-- Serialize instances based on the SafeCopy instance, and an
+-- alternative decode function that puts the decode type in the error
+-- message.  It also re-exports all other Data.Serialize symbols
+
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Extra.SafeCopy
+    ( module Data.SafeCopy
+    , DecodeError(..)
+    , HasDecodeError(fromDecodeError)
+    , decode
+    , encode
+    , decode'
+    , decodeM
+    , decodeM'
+    ) where
+
+import Control.Exception (ErrorCall(..), evaluate, )
+import Control.Lens (Getter, _Left, over, 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.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 System.IO.Unsafe (unsafePerformIO)
+
+encode :: SafeCopy a => a -> ByteString
+encode = runPut . safePut
+
+decode :: forall a. (SafeCopy a) => ByteString -> Either String a
+decode b = case runGetState safeGet b 0 of
+             Left s -> Left s
+             Right (a, remaining) | B.null remaining -> Right a
+             Right (a, remaining) -> Left ("decode " <> show b <> " failed to consume " <> show remaining)
+
+-- | Monadic version of decode.
+decodeM ::
+  forall a e m. (SafeCopy a, HasDecodeError e, MonadError e m)
+  => ByteString
+  -> m a
+decodeM bs =
+  case decode bs of
+    Left s -> throwError (fromDecodeError (DecodeError bs s))
+    Right a -> return a
+
+-- | Like 'decodeM', but also catches any ErrorCall thrown and lifts
+-- it into the MonadError instance.  I'm not sure whether this can
+-- actually happen.  What I'm seeing is probably an error call from
+-- 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)
+  => ByteString
+  -> m a
+decodeM' bs = go `catch` handle
+  where
+    go = case decode bs of
+           Left s -> throwError (fromDecodeError (DecodeError bs s))
+           Right a -> return a
+    handle :: ErrorCall -> m a
+    handle (ErrorCall s) = throwError $ fromDecodeError $ DecodeError bs s
+
+-- | Version of decode that catches any thrown ErrorCall and modifies
+-- its message.
+decode' :: forall a. (SafeCopy a) => ByteString -> Either String a
+decode' b =
+  unsafePerformIO (evaluate (decode b :: Either String a) `catch` handle)
+  where
+    handle :: ErrorCall -> IO (Either String a)
+    handle e = return $ Left (show e)
+
+-- | Serialize/deserialize prism.
+deserializePrism :: forall a. (SafeCopy a) => Prism' ByteString a
+deserializePrism = prism encode (\s -> either (\_ -> Left s) Right (decode s :: Either String a))
+
+-- | Inverting a prism turns it into a getter.
+serializeGetter :: forall a. (SafeCopy a) => Getter a ByteString
+serializeGetter = re deserializePrism
diff --git a/Extra/SafeCopyDebug.hs b/Extra/SafeCopyDebug.hs
new file mode 100644
--- /dev/null
+++ b/Extra/SafeCopyDebug.hs
@@ -0,0 +1,102 @@
+-- | This module exports a template haskell function to create
+-- Serialize instances based on the SafeCopy instance, and an
+-- alternative decode function that puts the decode type in the error
+-- message.  It also re-exports all other Data.Serialize symbols
+
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Extra.SafeCopyDebug
+    ( module Extra.SafeCopy
+    , Debug
+    , DecodeError(..)
+    , HasDecodeError(fromDecodeError)
+    , decode
+    , decode'
+    , decodeM
+    , decodeM'
+    ) where
+
+import Control.Exception (ErrorCall(..), evaluate, )
+import Control.Lens (Getter, _Left, over, 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.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.SafeCopy hiding (decode, decode', decodeM, decodeM')
+import Extra.SerializeDebug (Debug, DecodeError(..), HasDecodeError(..))
+import Extra.Time (Zulu(..))
+import Language.Haskell.TH (Dec, Loc, TypeQ, Q)
+import Network.URI (URI(..), URIAuth(..))
+import System.IO.Unsafe (unsafePerformIO)
+
+decode :: forall a. (SafeCopy a, Debug a) => ByteString -> Either String a
+decode b = case runGetState safeGet b 0 of
+             Left s -> Left s
+             Right (a, remaining) | B.null remaining -> Right a
+             Right (a, remaining) -> Left ("decode " <> show b <> " :: " <> show (typeRep (Proxy :: Proxy a)) <> " failed to consume " <> show remaining)
+
+-- | Monadic version of decode.
+decodeM ::
+  forall a e m. (SafeCopy a, Debug a, HasDecodeError e, MonadError e m)
+  => ByteString
+  -> m a
+decodeM bs =
+  case decode bs of
+    Left s -> throwError (fromDecodeError (DecodeError bs s))
+    Right a -> return a
+
+-- | Like 'decodeM', but also catches any ErrorCall thrown and lifts
+-- it into the MonadError instance.  I'm not sure whether this can
+-- actually happen.  What I'm seeing is probably an error call from
+-- outside the serialize package, in which case this (and decode') are
+-- pointless.
+decodeM' ::
+  forall e m a. (SafeCopy a, Debug 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))
+           Right a -> return a
+    handle :: ErrorCall -> m a
+    handle (ErrorCall s) = throwError $ fromDecodeError $ DecodeError bs s
+
+-- | Version of decode that catches any thrown ErrorCall and modifies
+-- its message.
+decode' :: forall a. (SafeCopy a, Debug a) => ByteString -> Either String a
+decode' b =
+  unsafePerformIO (evaluate (decode b :: Either String a) `catch` handle)
+  where
+    handle :: ErrorCall -> IO (Either String a)
+    handle e = return $ Left (show e)
+
+-- | Serialize/deserialize prism.
+deserializePrism :: forall a. (SafeCopy a, Debug a) => Prism' ByteString a
+deserializePrism = prism encode (\s -> either (\_ -> Left s) Right (decode s :: Either String a))
+
+-- | Inverting a prism turns it into a getter.
+serializeGetter :: forall a. (SafeCopy a, Debug a) => Getter a ByteString
+serializeGetter = re deserializePrism
diff --git a/Extra/Serialize.hs b/Extra/Serialize.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Serialize.hs
@@ -0,0 +1,186 @@
+-- | This module exports a template haskell function to create
+-- Serialize instances based on the SafeCopy instance, and an
+-- alternative decode function that puts the decode type in the error
+-- message.  It also re-exports all other Data.Serialize symbols
+
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Extra.Serialize
+    ( DecodeError(..)
+    , HasDecodeError(fromDecodeError)
+    , module Data.Serialize
+    , decodePrism, deserializePrism
+    , encodeGetter, serializeGetter
+    , deriveSerializeViaSafeCopy
+    , decode
+    , Serialize.encode
+    , decode'
+    , decodeM
+    , decodeM'
+    ) where
+
+import Control.Exception (ErrorCall(..), evaluate, )
+import Control.Lens (Getter, _Left, over, 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))
+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.Time (Zulu(..))
+import GHC.Generics (Generic)
+import Language.Haskell.TH (Dec, Loc, TypeQ, Q)
+import Network.URI (URI(..), URIAuth(..))
+import System.IO.Unsafe (unsafePerformIO)
+
+data DecodeError = DecodeError ByteString String deriving (Generic, Eq, Ord)
+
+class HasDecodeError e where fromDecodeError :: DecodeError -> e
+instance HasDecodeError DecodeError where fromDecodeError = id
+instance Serialize DecodeError where get = safeGet; put = safePut
+
+encode :: Serialize a => a -> ByteString
+encode = Serialize.encode
+
+-- | Decode a value from a strict ByteString, reconstructing the original
+-- structure.  Unlike Data.Serialize.decode, this function only succeeds
+-- if all the input is consumed.  Not sure if this is in use anywhere.
+--
+--   > Extra.Serialize.decode (encode 'x' <> encode 'y') :: Either String Char
+--   Left "decode \"xy\" failed to consume \"y\""
+--   > Data.Serialize.decode (encode 'x' <> encode 'y') :: Either String Char
+--   Right 'x'
+decode :: forall a. Serialize a => ByteString -> Either String a
+decode b =
+  case runGetState get b 0 of
+    Left s -> Left s
+    Right (a, remaining) | B.null remaining -> Right a
+    Right (a, remaining) -> Left ("decode " <> show b <> " failed to consume " <> show remaining)
+
+-- | A Serialize instance based on safecopy.  This means that
+-- migrations will be performed upon deserialization, which is handy
+-- if the value is stored in the browser's local storage.  Thus, zero
+-- downtime upgrades!
+deriveSerializeViaSafeCopy :: TypeQ -> Q [Dec]
+deriveSerializeViaSafeCopy typ =
+    [d|instance {-SafeCopy $typ =>-} Serialize $typ where
+          get = safeGet
+          put = safePut|]
+
+instance Serialize T.Text where
+    put = put . TE.encodeUtf8
+    get = TE.decodeUtf8 <$> get
+
+instance Serialize LT.Text where
+    put = put . TLE.encodeUtf8
+    get = TLE.decodeUtf8 <$> get
+
+-- | This is private, we can't create a Generic instance for it.
+instance Serialize DiffTime where
+    get = fromRational <$> get
+    put = put . toRational
+
+instance Serialize UTCTime where
+    get = uncurry UTCTime <$> get
+    put (UTCTime day time) = put (day, time)
+
+instance Serialize Day where
+    get = ModifiedJulianDay <$> get
+    put = put . toModifiedJulianDay
+
+-- deriving instance Generic UUID deriving instance Serialize UUID Use
+-- the SafeCopy methods to implement Serialize.  This is a pretty neat
+-- trick, it automatically does SafeCopy migration on any deserialize
+-- of a type with this implementation.
+instance Serialize UUID where
+    get = safeGet
+    put = safePut
+
+deriving instance Serialize Loc
+deriving instance Serialize URI
+deriving instance Serialize URIAuth
+deriving instance Serialize Zulu
+
+-- | Monadic version of decode.
+decodeM ::
+  forall a e m. (Serialize a, HasDecodeError e, MonadError e m)
+  => ByteString
+  -> m a
+decodeM bs =
+  case decode bs of
+    Left s -> throwError (fromDecodeError (DecodeError bs s))
+    Right a -> return a
+
+-- | Like 'decodeM', but also catches any ErrorCall thrown and lifts
+-- it into the MonadError instance.  I'm not sure whether this can
+-- actually happen.  What I'm seeing is probably an error call from
+-- 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)
+  => ByteString
+  -> m a
+decodeM' bs = go `catch` handle
+  where
+    go = case decode bs of
+           Left s -> throwError (fromDecodeError (DecodeError bs s))
+           Right a -> return a
+    handle :: ErrorCall -> m a
+    handle (ErrorCall s) = throwError $ fromDecodeError $ DecodeError bs s
+
+-- | Version of decode that catches any thrown ErrorCall and modifies
+-- its message.
+decode' :: forall a. (Serialize a) => ByteString -> Either String a
+decode' b =
+  unsafePerformIO (evaluate (decode b :: Either String a) `catch` handle)
+  where
+    handle :: ErrorCall -> IO (Either String a)
+    handle e = return $ Left (show e)
+
+-- | Serialize/deserialize prism.
+deserializePrism :: forall a. (Serialize a) => Prism' ByteString a
+deserializePrism = decodePrism
+{-# DEPRECATED deserializePrism "dumb name - use decodePrism" #-}
+
+-- | Serialize/deserialize prism.
+decodePrism :: forall a. (Serialize a) => Prism' ByteString a
+decodePrism = prism encode (\s -> either (\_ -> Left s) Right (decode s :: Either String a))
+
+-- | Inverting a prism turns it into a getter.
+serializeGetter :: forall a. (Serialize a) => Getter a ByteString
+serializeGetter = re deserializePrism
+{-# DEPRECATED serializeGetter "dumb name - use encodeGetter" #-}
+
+encodeGetter :: forall a. (Serialize a) => Getter a ByteString
+encodeGetter = re deserializePrism
+
+instance SafeCopy DecodeError where version = 1
+
+#ifndef OMIT_DATA_INSTANCES
+deriving instance Data DecodeError
+#endif
+
+#ifndef OMIT_SHOW_INSTANCES
+deriving instance Show DecodeError
+#endif
diff --git a/Extra/SerializeDebug.hs b/Extra/SerializeDebug.hs
new file mode 100644
--- /dev/null
+++ b/Extra/SerializeDebug.hs
@@ -0,0 +1,109 @@
+-- | This module exports a template haskell function to create
+-- Serialize instances based on the SafeCopy instance, and an
+-- alternative decode function that puts the decode type in the error
+-- message.  It also re-exports all other Data.Serialize symbols
+
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Extra.SerializeDebug
+    ( module Extra.Serialize
+    , Debug
+    , DecodeError(..)
+    , HasDecodeError(fromDecodeError)
+    , deserializePrism
+    , serializeGetter
+    , decode
+    , decode'
+    , decodeM
+    , decodeM'
+    ) where
+
+import Control.Exception (ErrorCall(..), evaluate, )
+import Control.Lens (Getter, _Left, over, 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.SafeCopy (base, SafeCopy, safeGet, safePut)
+import Data.Serialize hiding (decode)
+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 hiding (decode, decode', decodeM, decodeM', deserializePrism, serializeGetter)
+import Extra.Time (Zulu(..))
+import Language.Haskell.TH (Dec, Loc, TypeQ, Q)
+import Network.URI (URI(..), URIAuth(..))
+import System.IO.Unsafe (unsafePerformIO)
+
+type Debug a = (Typeable a, Show a)
+
+-- | Decode a value from a strict ByteString, reconstructing the original
+-- structure.  Unlike Data.Serialize.decode, this function only succeeds
+-- if all the input is consumed.
+decode :: forall a. (Serialize a, Debug a) => ByteString -> Either String a
+decode b =
+  case runGetState get b 0 of
+    Left s -> Left s
+    Right (a, remaining) | B.null remaining -> Right a
+    Right (a, remaining) -> Left ("decode " <> show b <> " :: " <> show (typeRep (Proxy :: Proxy a)) <> " failed to consume " <> show remaining)
+
+-- | Monadic version of decode.
+decodeM ::
+  forall a e m. (Serialize a, Debug a, HasDecodeError e, MonadError e m)
+  => ByteString
+  -> m a
+decodeM bs =
+  case decode bs of
+    Left s -> throwError (fromDecodeError (DecodeError bs s))
+    Right a -> return a
+
+-- | Like 'decodeM', but also catches any ErrorCall thrown and lifts
+-- it into the MonadError instance.  I'm not sure whether this can
+-- actually happen.  What I'm seeing is probably an error call from
+-- outside the serialize package, in which case this (and decode') are
+-- pointless.
+decodeM' ::
+  forall e m a. (Serialize a, Debug 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))
+           Right a -> return a
+    handle :: ErrorCall -> m a
+    handle (ErrorCall s) = throwError $ fromDecodeError $ DecodeError bs s
+
+-- | Version of decode that catches any thrown ErrorCall and modifies
+-- its message.
+decode' :: forall a. (Serialize a, Debug a) => ByteString -> Either String a
+decode' b =
+  unsafePerformIO (evaluate (decode b :: Either String a) `catch` handle)
+  where
+    handle :: ErrorCall -> IO (Either String a)
+    handle e = return $ Left (show e)
+
+-- | Serialize/deserialize prism.
+deserializePrism :: forall a. (Serialize a, Debug a) => Prism' ByteString a
+deserializePrism = prism encode (\s -> either (\_ -> Left s) Right (decode s :: Either String a))
+
+-- | Inverting a prism turns it into a getter.
+serializeGetter :: forall a. (Serialize a, Debug a) => Getter a ByteString
+serializeGetter = re deserializePrism
diff --git a/Extra/TH.hs b/Extra/TH.hs
new file mode 100644
--- /dev/null
+++ b/Extra/TH.hs
@@ -0,0 +1,93 @@
+-- | Pretty print Loc info for stack traces
+
+{-# LANGUAGE CPP, FlexibleInstances, ScopedTypeVariables, TemplateHaskell #-}
+{-# OPTIONS -Wall -Wno-orphans #-}
+
+module Extra.TH
+    ( here
+    , Loc
+    , noLoc
+    , prettyLocs
+    , addConstraints
+    , addConstraint
+    , removeConstraints
+    ) where
+
+import Control.Lens (_1, over)
+import Data.Generics (everywhere, mkT)
+import Data.List (intersperse, nub)
+import Data.Map as Map (findWithDefault, fromList, fromListWith, lookup, Map, toList)
+import Data.Maybe (mapMaybe)
+#if !MIN_VERSION_base(4,11,0)
+import Data.Monoid ((<>))
+#endif
+import Data.Tuple (swap)
+import Extra.Generics (gFind)
+import Language.Haskell.TH (appT, conT, Dec(InstanceD), ExpQ, Loc(..), location, Name, nameBase, newName, Q, Type(..), TypeQ, varT)
+import Language.Haskell.TH.Instances ()
+import Language.Haskell.TH.Lift (lift)
+import Text.PrettyPrint.HughesPJClass (Doc, hcat, Pretty(..), text)
+
+here :: ExpQ
+here = lift =<< location
+
+instance Pretty Loc where
+    pPrint = prettyLoc
+
+noLoc :: Loc
+noLoc = Loc "" "" "" (0, 0) (0, 0)
+
+prettyLoc :: Loc -> Doc
+prettyLoc (Loc _filename _package modul (line, col) _) = text (modul <> ":" ++ show line ++ ":" ++ show col)
+
+prettyLocs :: [Loc] -> Doc
+prettyLocs locs = text "[" <> hcat (intersperse (text " ← ") (fmap prettyLoc locs)) <> text "]"
+
+-- | Add some simple constraints to a 'Dec'. The Dec is typically one
+-- emitted by a function such as makeAcidic or deriveSafeCopy.
+addConstraints :: [(Name, String)] -> Dec -> Q Dec
+addConstraints cs (InstanceD mo cxt typ decs) = do
+  let mp :: Map String [Name]
+      mp = Map.fromListWith (<>) (fmap (swap . over _1 (: [])) cs)
+  (extra :: [Type]) <- concat <$> mapM (uncurry constrain) (Map.toList mp)
+  return $ InstanceD mo (cxt ++ extra) typ decs
+    where
+      -- Apply some type constraints to a type variable
+      constrain vstring tnames = do
+        vname <- newName vstring
+        mapM (\tname -> appT (conT tname) (varT vname)) tnames
+addConstraints _ d = return d
+
+-- | Unify the type variables in the existing constraints with those
+-- in the new constraint based on nameBase.  If the type variable does
+-- not appear in the declaration it is an error.
+addConstraint :: Name -> TypeQ -> Dec -> Q Dec
+addConstraint tname typeq (InstanceD mo cxt inst decs) = do
+  let vnames = nub $ mapMaybe isVar (gFind (inst : cxt) :: [Type])
+      mp :: Map String Name
+      mp = Map.fromList (fmap (\n -> (nameBase n, n)) vnames)
+  (extra :: Type) <- everywhere (mkT (fixTypeVar mp)) <$> appT (conT tname) typeq
+  return $ InstanceD mo (cxt ++ [extra]) inst decs
+    where
+      isVar :: Type -> Maybe Name
+      isVar (VarT name) = Just name
+      isVar _ = Nothing
+      fixTypeVar :: Map String Name -> Type -> Type
+      fixTypeVar mp (VarT n) = VarT (maybe n id (Map.lookup (nameBase n) mp))
+      fixTypeVar _mp t = t
+addConstraint _ _ d = return d
+
+-- | Remove simple constraints from a 'Dec' based on type class name
+-- and type variable name.
+removeConstraints :: [(Name, String)] -> Dec -> Q Dec
+removeConstraints cs (InstanceD mo cxt typ decs) = do
+  let mp :: Map String [Name]
+      mp = Map.fromListWith (<>) (fmap (swap . over _1 (: [])) cs)
+  return $ InstanceD mo (filter (testPred mp) cxt) typ decs
+    where
+      testPred :: Map String [Name] -> Type -> Bool
+      -- Discard any predicate that matches a map element
+      testPred mp (AppT (ConT tname) (VarT vname)) =
+          not (elem tname (Map.findWithDefault [] (nameBase vname) mp))
+      testPred _ _ = True -- keep anything else
+removeConstraints _ d = return d
diff --git a/Extra/Text.hs b/Extra/Text.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Text.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE CPP, RankNTypes #-}
+
+module Extra.Text
+    ( diffText
+    , camelWords
+    , capitalize
+    , Describe(describe')
+    , describe
+    , textshow
+    , trunc
+#if !__GHCJS__
+    , tests
+#endif
+    ) where
+
+import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff)
+import Data.Char (isUpper, toUpper)
+import Data.ListLike (groupBy)
+import Data.Text (split, Text, pack, unpack)
+#if !__GHCJS__
+import Test.HUnit (assertEqual, Test(TestCase, TestList))
+#endif
+import qualified Text.PrettyPrint as HPJ
+
+-- | 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
+diffText (nameA, textA) (nameB, textB) =
+    show (prettyContextDiff
+          (HPJ.text nameA)
+          (HPJ.text nameB)
+          (HPJ.text . unpack)
+          (getContextDiff 2 (split (== '\n') textA) (split (== '\n') textB)))
+
+-- | Convert a camel case string (no whitespace) into a natural
+-- language looking phrase:
+--   camelWords "aCamelCaseFOObar123" -> "A Camel Case FOObar123"
+camelWords :: String -> String
+camelWords s =
+    case groupBy (\ a b -> isUpper a == isUpper b) (dropWhile (== '_') s) of -- "aCamelCaseFOObar123"
+      (x : xs) -> concat $ capitalize x : map (\ (c : cs) -> if isUpper c then ' ' : c : cs else c : cs) xs
+      [] -> ""
+
+#if !__GHCJS__
+-- Most of these fail.
+tests :: Test
+tests =
+    TestList
+    [ TestCase (assertEqual "camel words 0" "A Camel Case FOO Bar 123" (camelWords "aCamelCaseFOOBar123"))
+    , TestCase (assertEqual "camel words 1" "My Generator" (camelWords "myGenerator"))
+    , TestCase (assertEqual "camel words 2" "PDF Generator" (camelWords "pDFGenerator"))
+    , TestCase (assertEqual "camel words 3" "PDF Generator" (camelWords "PDFGenerator"))
+    , TestCase (assertEqual "camel words 4" "Report PDF Generator" (camelWords "reportPDFGenerator")) ]
+#endif
+
+capitalize :: String -> String
+capitalize [] = []
+capitalize (c:cs) = (toUpper c) : cs
+
+-- | Override the default description associated with the type of @a@.
+-- The first argument indicates the field of the parent record that
+-- contains the @a@ value, if any.
+class Describe a where
+    describe' :: Maybe String -> a -> Maybe String
+
+describe :: Describe a => a -> Maybe String
+describe = describe' Nothing
+
+-- | 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/Extra/Time.hs b/Extra/Time.hs
--- a/Extra/Time.hs
+++ b/Extra/Time.hs
@@ -1,20 +1,20 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, DeriveAnyClass, DeriveDataTypeable, DeriveGeneric, TemplateHaskell #-}
 module Extra.Time
     ( formatDebianDate
-    , myTimeDiffToString
+    -- , myTimeDiffToString
+    , Zulu(..), utcTime
     ) where
 
 import Control.Exception
-import Data.List
+import Control.Lens (makeLenses)
+import Data.Data (Data)
+import Data.SafeCopy (base, SafeCopy(..))
 import Data.Time
-#if MIN_VERSION_time(1,5,0)
-import qualified System.Locale as Old (defaultTimeLocale)
-import qualified System.Time as Old (formatTimeDiff, tdPicosec)
-#else
-import System.Locale as Old
-import System.Time as Old
+import Extra.Orphans ()
+import GHC.Generics
+#if !__GHCJS__
+import Test.QuickCheck
 #endif
-import Text.Printf
 
 {- This function is so complicated because there seems to be no way
    to get the Data.Time to format seconds without the fractional part,
@@ -51,6 +51,8 @@
           testsecond = 15.29
           teststring = "Tue, 19 Dec 2006 17:19:15 UTC"
 
+#if 0
+-- | Retired due to use of old-time.
 myTimeDiffToString diff =
     do
       case () of
@@ -63,3 +65,20 @@
       ms = ps2ms ps
       ps2ms ps = quot (ps + 500000000) 1000000000
       ps = Old.tdPicosec diff
+#endif
+
+-- | A version of UTCTime with a Show instance that returns a Haskell
+-- expression.
+newtype Zulu = Zulu {_utcTime :: UTCTime} deriving (Eq, Ord, Data, Generic)
+
+$(makeLenses ''Zulu)
+instance SafeCopy Zulu where version = 1; kind = base
+
+#if !__GHCJS__
+instance Arbitrary Zulu where arbitrary = Zulu <$> arbitrary
+#endif
+-- instance ParseTime Zulu
+-- instance FormatTime Zulu
+
+instance Show Zulu where
+  showsPrec d (Zulu t) = showParen (d > 10) $ showString ("Zulu (read " ++ show (show t) ++ ")")
diff --git a/Extra/URI.hs b/Extra/URI.hs
--- a/Extra/URI.hs
+++ b/Extra/URI.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- |Make URI an instance of Read and Ord, and add functions to
 -- manipulate the uriQuery.
 module Extra.URI
@@ -12,15 +14,14 @@
     ) where
 
 import Network.URI -- (URIAuth(..), URI(..), parseURI, uriToString, escapeURIString, isUnreserved, unEscapeString)
-import Data.List(intersperse, groupBy, inits)
-import Data.Maybe(isJust, isNothing, catMaybes)
+import Data.List(intersperse, groupBy)
 import Control.Arrow(second)
 
 -- |Create a relative URI with the given query.
 relURI :: FilePath -> [(String, String)] -> URI
-relURI path pairs = URI {uriScheme = "",
+relURI upath pairs = URI {uriScheme = "",
                    uriAuthority = Nothing,
-                   uriPath = path,
+                   uriPath = upath,
                    uriQuery = formatURIQuery pairs,
                    uriFragment = ""}
 
@@ -70,6 +71,7 @@
 -- Everything else gets escaped.
 escapeURIForQueryValue = escapeURIString isUnreserved
 
+#if 0
 -- Make URI an instance of Read.  This will throw an error if no
 -- prefix up to ten characters long of the argument string looks like
 -- a URI.  If such a prefix is found, it will continue trying longer
@@ -89,3 +91,4 @@
                                (a : _) -> a
                 goodURIs = takeWhile isJust moreURIs
                 (badURIs, moreURIs) = span isNothing allURIs
+#endif
diff --git a/Extra/Verbosity.hs b/Extra/Verbosity.hs
new file mode 100644
--- /dev/null
+++ b/Extra/Verbosity.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE CPP, RankNTypes #-}
+{-# OPTIONS_GHC -Wall #-}
+module Extra.Verbosity
+    ( modifyEnv
+    , qPutStr
+    , qPutStrLn
+    , ePutStr
+    , ePutStrLn
+    , eBracket
+    , quieter
+    , noisier
+    , withVerbosity
+    , withModifiedVerbosity
+    , verbosity
+    ) where
+
+import Control.Monad (when)
+import Control.Monad.Catch (bracket_, MonadMask)
+#ifndef FIXED_VERBOSITY_LEVEL
+import Control.Monad.Catch (bracket)
+#endif
+import Control.Monad.Trans (liftIO, MonadIO)
+import System.IO (hPutStr, hPutStrLn, stderr)
+import System.Posix.Env (getEnv, setEnv, unsetEnv)
+
+-- | Generalization of Posix setEnv/unSetEnv.
+modifyEnv :: String -> (Maybe String -> Maybe String) -> IO ()
+modifyEnv name f =
+    getEnv name >>= maybe (unsetEnv name) (\ x -> setEnv name x True) . f
+
+ePutStr :: MonadIO m => String -> m ()
+ePutStr = liftIO . hPutStr stderr
+ePutStrLn :: MonadIO m => String -> m ()
+ePutStrLn = liftIO . hPutStrLn stderr
+
+qPutStr :: MonadIO m => String -> m ()
+qPutStr s = do
+  v <- verbosity
+  when (v > 0) (ePutStr s)
+
+qPutStrLn :: MonadIO m => String -> m ()
+qPutStrLn s = do
+  v <- verbosity
+  when (v > 0) (ePutStrLn s)
+
+quieter :: (MonadIO m, MonadMask m) => Int -> m a -> m a
+quieter n action = withModifiedVerbosity (\ v -> v - n) action
+
+noisier :: (MonadIO m, MonadMask m) => Int -> m a -> m a
+noisier n action = withModifiedVerbosity (\ v -> v + n) action
+
+withVerbosity :: MonadIO m => Int -> m a -> m a
+withVerbosity v action = liftIO (setEnv "VERBOSITY" (show v) True) >> action
+
+withModifiedVerbosity :: (MonadIO m, MonadMask m) => (Int -> Int) -> m a -> m a
+#ifdef FIXED_VERBOSITY_LEVEL
+withModifiedVerbosity _f action =
+    action
+#else
+withModifiedVerbosity f action =
+    bracket verbosity -- acquire
+            (\ v0 -> liftIO (modifyEnv "VERBOSITY" (const (Just (show v0))))) -- release
+            (\ v0 -> liftIO (modifyEnv "VERBOSITY" (const (Just (show (f v0))))) >> action)
+#endif
+
+verbosity :: MonadIO m => m Int
+#ifdef NO_VERBOSITY_CONTROL
+verbosity = return 1000
+#else
+verbosity = liftIO $ getEnv "VERBOSITY" >>= return . maybe 1 read
+#endif
+
+eBracket :: (MonadIO m, MonadMask m) => String -> m a -> m a
+eBracket message action =
+    bracket_ (ePutStrLn (" -> " ++ message))
+             (ePutStrLn (" <- " ++ message))
+             action
diff --git a/Test/QUnit.hs b/Test/QUnit.hs
--- a/Test/QUnit.hs
+++ b/Test/QUnit.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Test.QUnit
@@ -64,3 +64,6 @@
          QC.GaveUp{} -> let ntest = QC.numTests result in HU.assertFailure $ "Arguments exhausted after" ++ show ntest ++ (if ntest == 1 then " test." else " tests.")
          QC.Failure{} -> let reason = QC.reason result in HU.assertFailure reason
          QC.NoExpectedFailure{} -> HU.assertFailure $ "No Expected Failure"
+#if !MIN_VERSION_QuickCheck(2,11,0)
+         QC.InsufficientCoverage{} -> HU.assertFailure $ "Insufficient Coverage"
+#endif
diff --git a/Test/QuickCheck/Properties.hs b/Test/QuickCheck/Properties.hs
--- a/Test/QuickCheck/Properties.hs
+++ b/Test/QuickCheck/Properties.hs
@@ -2,7 +2,7 @@
 
 import Test.QuickCheck
 
-isIdempotentBy :: (Arbitrary a, Eq a, Show a) => (a -> a) -> Gen a -> Property
+isIdempotentBy :: ({-Arbitrary a,-} Eq a, Show a) => (a -> a) -> Gen a -> Property
 isIdempotentBy f src = forAll src $ \a -> f a == f (f a)
 
 isIdempotent :: (Arbitrary a, Eq a, Show a) => (a -> a) -> Property
diff --git a/sr-extra.cabal b/sr-extra.cabal
--- a/sr-extra.cabal
+++ b/sr-extra.cabal
@@ -1,67 +1,136 @@
 Name:           sr-extra
-Version:        1.46.3.2
+Version:        1.64
 License:        BSD3
-License-File:	COPYING
+License-File:   COPYING
 Author:         David Fox
 Category:       Unclassified
-Description:    A hodge-podge of functions and modules that do not have a better home
+Synopsis:       Module limbo
+Description:
+  A hodge-podge of functions, modules, and instances.  These
+  generally end up here because
+     1. they are needed in two unrelated packages,
+     2. they belong in some upstream module,
+     3. they can't be moved to an upstream module because
+        they would add dependencies, or
+     4. they are deprecated but still in use
 Maintainer:     David Fox <dsf@seereason.com>
 Homepage:       https://github.com/seereason/sr-extra
-Synopsis:       A grab bag of modules.
 Build-Type:     Simple
-Cabal-Version:  >= 1.2
+Cabal-Version:  >= 1.4
+
 flag network-uri
- Description: Get Network.URI from the network-uri package
- Default: True
+  Description: Get Network.URI from the network-uri package rather than the
+   full network package.
+  Default: True
 
+flag omit-serialize
+  Description: Omit all the Serialize instances, on the assumption
+   that we will use SafeCopy instances instead.
+  Default: False
+
 Library
+  GHC-Options: -Wall -Wredundant-constraints
   Build-Depends:
     base < 5,
     bytestring,
     bzlib,
+    Cabal,
     containers,
+    Diff,
     directory,
+    exceptions,
+    fgl,
     filepath,
-    HUnit,
+    generic-data,
+    hslogger,
+    lens,
+    ListLike,
+    mmorph,
     mtl,
-    old-locale,
-    old-time,
     pretty,
-    process,
     pureMD5,
-    QuickCheck >= 2 && < 3,
     random,
-    regex-compat,
+    safecopy >= 0.9.5,
+    show-combinators,
+    syb,
+    template-haskell,
+    text,
+    th-lift,
+    th-lift-instances,
+    th-orphans,
     time >= 1.1,
     unix,
     Unixutils >= 1.51,
+    userid,
+    uuid,
+    uuid-orphans,
+    uuid-types,
     zlib
-  if flag(network-uri)
-    Build-Depends: network-uri >= 2.6
-  else
-    Build-Depends: network >= 2.4
-  ghc-options:	-O2 -W
-  C-Sources:	     cbits/gwinsz.c
+  C-Sources:         cbits/gwinsz.c
   Include-Dirs:        cbits
   Install-Includes:    gwinsz.h
+  Extensions: ConstraintKinds, CPP, DataKinds, DeriveDataTypeable, DeriveFunctor, DeriveGeneric
+  Extensions: FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, RankNTypes
+  Extensions: ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeFamilies
   Exposed-modules:
     Extra.Bool,
-    Extra.CIO,
+    Extra.Debug,
+    Extra.Debug2,
     Extra.Either,
+    Extra.EnvPath,
+    Extra.Except,
     Extra.Exit,
     Extra.Files,
-    Extra.GPGSign,
+    Extra.FP,
+    Extra.Generics,
+    Extra.Generics.Show,
+    Extra.IOThread
     Extra.List,
     Extra.HughesPJ,
-    Extra.Lock,
+    Extra.Log,
     Extra.Misc,
+    Extra.Monad.Supply,
     Extra.Net,
-    Extra.SSH,
+    Extra.Orphans,
+    Extra.Orphans2,
+    Extra.Orphans3,
+    Extra.Pretty,
+    Extra.SafeCopy,
+    Extra.SafeCopyDebug,
+    Extra.Serialize,
+    Extra.SerializeDebug,
+    Extra.Text,
+    Extra.TH,
     Extra.Time,
     Extra.Terminal,
-    Extra.IO,
     Extra.URI,
     Extra.URIQuery,
-    Test.QUnit,
-    Test.QuickCheck.Properties,
-    Extra.IOThread
+    Extra.Verbosity
+  if !impl(ghcjs)
+    Build-Depends:
+      show-please,
+      filemanip,
+      HUnit,
+      process,
+      process-extras,
+      QuickCheck >= 2 && < 3
+    Exposed-Modules:
+      Extra.GPGSign,
+      Extra.Lock,
+      Extra.IO,
+      Extra.Process,
+      Extra.SSH,
+      Test.QUnit,
+      Test.QuickCheck.Properties
+
+  if flag(network-uri)
+    Build-Depends: network-uri >= 2.6
+  else
+    Build-Depends: network >= 2.4
+
+  if flag(omit-serialize)
+    CPP-Options: -DOMIT_SERIALIZE
+    -- We still need cereal to implement instance SafeCopy Proxy
+    Build-Depends: cereal
+  else
+    Build-Depends: cereal