Fixes for GHC 8.0.1

26 files changed, 214 insertions, 113 deletions

diff --git a/bbcode/bbcode.cabal b/bbcode/bbcode.cabal
index 6309fc0..e26dfb7 100644
--- a/bbcode/bbcode.cabal
+++ b/bbcode/bbcode.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                bbcode
-version:             3.1.0
+version:             3.1.1
 synopsis:            A parser for bbcode
 -- description:         
 homepage:            http://dirty-haskell.org/tags/thermoprint.html
@@ -25,7 +25,7 @@ library
                      , DeriveGeneric
                      , DeriveAnyClass
                      , OverloadedLists
-  build-depends:       base >=4.8 && <4.9
+  build-depends:       base >=4.8 && <5
                      , attoparsec >=0.13.0 && <1
                      , text >=1.2.1 && <2
                      , containers >=0.4.0 && <1
diff --git a/client/src/Thermoprint/Client.hs b/client/src/Thermoprint/Client.hs
index 7072ad0..448a912 100644
--- a/client/src/Thermoprint/Client.hs
+++ b/client/src/Thermoprint/Client.hs
@@ -1,7 +1,10 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 -- | A client library for 'Thermoprint.API'
 module Thermoprint.Client
@@ -12,8 +15,8 @@ module Thermoprint.Client
        , ServantError(..)
        , module Thermoprint.API
        , module Servant.Common.BaseUrl
-       , module Control.Monad.Trans.Either
-       , module Servant.Server.Internal.Enter
+       , module Control.Monad.Except
+       , module Servant.Utils.Enter
        ) where
 
 import Thermoprint.API
@@ -24,19 +27,20 @@ import Data.Time (UTCTime)
 import Servant.Client hiding (HasClient(..))
 import qualified Servant.Client as S
 import Servant.Common.BaseUrl
+import Network.HTTP.Client (Manager, ManagerSettings, newManager, defaultManagerSettings)
 import Servant.API
-import Servant.Server.Internal.Enter
-import Control.Monad.Trans.Either
+import Servant.Utils.Enter
+import Control.Monad.Except (ExceptT, runExceptT)
 
+import Control.Monad.Reader (ReaderT, runReaderT, ask)
 import Control.Monad.Catch (Exception, MonadThrow(..))
 import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Trans (lift)
 
 import Control.Monad
 import Control.Category
 import Prelude hiding (id, (.))
 
-instance Exception ServantError
-
 -- | All 'ThermoprintAPI'-functions as a record
 --
 -- Use like this:
@@ -46,7 +50,7 @@ instance Exception ServantError
 -- > main :: IO ()
 -- > -- ^ Display a list of printers with their status
 -- > main = print =<< printers
--- >   where Client{..} = mkClient' $ Http "localhost" 3000
+-- >   where Client{..} = mkClient' defaultManagerSettings $ Http "localhost" 3000
 data Client m = Client
   { printers :: m (Map PrinterId PrinterStatus)
                 -- ^ List all printers
@@ -86,27 +90,55 @@ withArgs :: (x -> a :<|> b) -> ((x -> a) :<|> (x -> b))
 -- ^ Undo factoring of APIs
 withArgs subAPI = (\(a :<|> _) -> a) . subAPI :<|> (\(_ :<|> b) -> b) . subAPI
 
-mkClient :: (EitherT ServantError IO :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can do 'IO' and handle errors
-         -> BaseUrl
-         -> Client m
+mkClientS :: Monad m
+          => (ClientM :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can do 'IO' and handle errors
+          -> ManagerSettings
+          -> BaseUrl
+          -> Client m
 -- ^ Generate a 'Client'
-mkClient n url = Client{..}
+mkClientS n mgrS url = Client
+                       { printers = clientF n printers
+                       , jobs = \a b c -> clientF n $ jobs a b c
+                       , jobCreate = \a b -> clientF n $ jobCreate a b
+                       , job = \a -> clientF n $ job a
+                       , jobStatus = \a -> clientF n $ jobStatus a
+                       , jobDelete = \a -> clientF n $ jobDelete a
+                       , drafts = clientF n drafts
+                       , draftCreate = \a b -> clientF n $ draftCreate a b
+                       , draftReplace = \a b c -> clientF n $ draftReplace a b c
+                       , draft = \a -> clientF n $ draft a
+                       , draftDelete = \a -> clientF n $ draftDelete a
+                       , draftPrint = \a b -> clientF n $ draftPrint a b
+                       }
   where
+    clientF :: Monad m => (ClientM :~> m) -> (Manager -> BaseUrl -> m a) -> m a
+    clientF n f = do
+      mgr <- unNat n $ (liftIO $ newManager mgrS :: ClientM Manager)
+      f mgr url
     printers
       :<|> (jobs :<|> jobCreate)
       :<|> (withArgs -> job :<|> (withArgs -> jobStatus :<|> jobDelete))
       :<|> (drafts :<|> draftCreate)
       :<|> (withArgs -> draftReplace :<|> (withArgs -> draft :<|> (withArgs -> draftDelete :<|> draftPrint)))
-      = enter n $ client thermoprintAPI url
+      = enter n $ client thermoprintAPI
 
+mkClient :: Monad m
+         => (ClientM :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can do 'IO' and handle errors
+         -> BaseUrl
+         -> Client m
+mkClient n url = mkClientS n defaultManagerSettings url
+  
 mkClient' :: (MonadThrow m, MonadIO m) => BaseUrl -> Client m
 -- ^ @mkClient' = mkClient $ ioNat . throwNat@
 mkClient' = mkClient $ ioNat . throwNat
 
-throwNat :: (Exception e, MonadThrow m) => EitherT e m :~> m
+throwNat :: (Exception e, MonadThrow m) => ExceptT e m :~> m
 -- ^ Squash a layer of 'EitherT' into the underlying monad supporting 'throwM'
-throwNat = Nat $ either throwM return <=< runEitherT
+throwNat = Nat $ either throwM return <=< runExceptT
 
 ioNat :: MonadIO m => IO :~> m
 -- ^ @ioNat = Nat liftIO@
 ioNat = Nat liftIO
+
+readerNat :: a -> ReaderT a m :~> m
+readerNat a = Nat $ flip runReaderT a
diff --git a/client/thermoprint-client.cabal b/client/thermoprint-client.cabal
index 9567971..9c481e3 100644
--- a/client/thermoprint-client.cabal
+++ b/client/thermoprint-client.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                thermoprint-client
-version:             0.0.0
+version:             1.0.0
 synopsis:            Client for thermoprint-spec
 -- description:         
 homepage:            http://dirty-haskell.org/tags/thermoprint.html
@@ -21,7 +21,7 @@ library
   -- other-modules:       
   -- other-extensions:    
   build-depends:       base >=4.8 && <5
-                     , thermoprint-spec ==3.0.*
+                     , thermoprint-spec ==4.0.*
                      , servant >=0.4.4 && <1
                      , servant-client >=0.4.4 && <1
                      , servant-server >=0.4.4 && <1
@@ -30,6 +30,8 @@ library
                      , time >=1.5.0 && <2
                      , exceptions >=0.8.2 && <1
                      , transformers >=0.4.2 && <1
+                     , http-client >=0.4.28 && <1
+                     , mtl >=2.2.1 && <3
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall
diff --git a/default.nix b/default.nix
index 7ffadea..0aa8c9e 100644
--- a/default.nix
+++ b/default.nix
@@ -1,5 +1,5 @@
 { pkgs ? (import <nixpkgs> {})
-, compilerName ? "ghc7103"
+, compilerName ? "ghc801"
 }:
 
 rec {
diff --git a/server/default-conf/Main.hs b/server/default-conf/Main.hs
index 7c4bfc7..35088e8 100644
--- a/server/default-conf/Main.hs
+++ b/server/default-conf/Main.hs
@@ -20,6 +20,10 @@ main = thermoprintServer True (Nat runSqlite) $ def `withPrinters` printers
     runSqlite :: ReaderT ConnectionPool (LoggingT IO) a -> IO a
     runSqlite = runStderrLoggingT . withSqlitePool "thermoprint.sqlite" 1 . runReaderT
 
+    printers :: [( ResourceT (ReaderT ConnectionPool (LoggingT IO)) PrinterMethod
+                 , QMConfig (ResourceT (ReaderT ConnectionPool (LoggingT IO)))
+                 )
+                ]
     printers = [ (pure debugPrint, def)
                , (pure $ delayedDebugPrint (10 * 10^6), def)
                ]
diff --git a/server/src/Thermoprint/Server.hs b/server/src/Thermoprint/Server.hs
index 07462da..15fb651 100644
--- a/server/src/Thermoprint/Server.hs
+++ b/server/src/Thermoprint/Server.hs
@@ -13,7 +13,7 @@ module Thermoprint.Server
        , Config(..), QMConfig(..)
        , withPrinters
        , module Data.Default.Class
-       , module Servant.Server.Internal.Enter
+       , module Servant.Utils.Enter
        , module Thermoprint.Server.Printer
        , module Thermoprint.Server.Queue
        , module Thermoprint.Server.Queue.Utils
@@ -62,7 +62,7 @@ import qualified Network.Wai.Handler.Warp as Warp
 import Network.Wai (Application)
 
 import Servant.Server (serve)
-import Servant.Server.Internal.Enter (enter, (:~>)(..))
+import Servant.Utils.Enter (enter, (:~>)(..))
 import Servant.API
 import Servant.Utils.Links
 import Network.URI
@@ -137,16 +137,16 @@ thermoprintServer :: ( MonadLoggerIO m
                      -> (m :~> IO) -- ^ 'dyre' controls the base of the monad-transformer-stack ('IO') but we let the user specify much of the rest of it (we handle 'ResourceT' ourselves, since we need it to fork properly). Therefore we require a specification of how to collapse the stack.
                      -> ResourceT m (Config (ResourceT m)) -> IO ()
 -- ^ Run the server
-thermoprintServer dyre io = do
+thermoprintServer dyre io cfg = do
   cfgDir <- lookupEnv "THERMOPRINT_CONFIG"
   cacheDir <- lookupEnv "THERMOPRINT_CACHE"
-  Dyre.wrapMain $ Dyre.defaultParams
+  flip Dyre.wrapMain cfg $ Dyre.defaultParams
     { Dyre.projectName = "thermoprint-server"
     , Dyre.realMain    = realMain
     , Dyre.showError   = flip (\msg -> fmap (\cfg -> cfg { dyreError = Just msg }))
     , Dyre.configCheck = dyre
-    , Dyre.configDir   = cfgDir
-    , Dyre.cacheDir    = cacheDir
+    , Dyre.configDir   = return <$> cfgDir
+    , Dyre.cacheDir    = return <$> cacheDir
     }
   where
     realMain cfg = unNat (io . Nat runResourceT) $ do
@@ -164,6 +164,6 @@ thermoprintServer dyre io = do
         nChan <- liftIO $ newBroadcastTChanIO
         let
           printerUrl :: API.PrinterId -> URI
-          printerUrl = safeLink thermoprintAPI (Proxy :: Proxy ("jobs" :> QueryParam "printer" API.PrinterId :> Get '[JSON] (Seq (API.JobId, UTCTime, JobStatus))))
+          printerUrl = safeLink thermoprintAPI (Proxy :: Proxy ("jobs" :> QueryParam "printer" API.PrinterId :> Get '[JSON] (Seq (API.JobId, UTCTime, JobStatus)))) . Just
         mapM_ (fork tMgr . uncurry (notifyOnChange nChan ((==) `on` fromZipper)) . bimap printerUrl queue) $ Map.toList printers
         liftIO . Warp.runSettings warpSettings . withPush nChan . serve thermoprintAPI . flip enter API.thermoprintServer =<< handlerNat printers nChan
diff --git a/server/src/Thermoprint/Server/API.hs b/server/src/Thermoprint/Server/API.hs
index cbf727c..8e17eb4 100644
--- a/server/src/Thermoprint/Server/API.hs
+++ b/server/src/Thermoprint/Server/API.hs
@@ -27,15 +27,15 @@ import qualified Data.Map as Map
 
 import qualified Data.Text as T
 
-import           Servant
-import           Servant.Server
-import           Servant.Server.Internal.Enter
+import           Servant hiding (Handler)
+import           Servant.Server hiding (Handler)
+import           Servant.Utils.Enter
 import           Servant.Utils.Links
 
 import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
-import           Control.Monad.Trans.Either
+import           Control.Monad.Except
 import           Control.Monad.IO.Class
 
 import           Control.Concurrent.STM
@@ -65,7 +65,7 @@ import           Control.Monad.Catch (handle, catch)
 import           Data.Time
 
 type ProtoHandler = ReaderT HandlerInput (LoggingT (ResourceT IO))
-type Handler      = EitherT ServantErr ProtoHandler
+type Handler      = ExceptT ServantErr ProtoHandler
 
 -- ^ Runtime configuration of our handlers
 data HandlerInput = HandlerInput { sqlPool  :: ConnectionPool -- ^ How to interact with 'persistent' storage
@@ -73,13 +73,10 @@ data HandlerInput = HandlerInput { sqlPool  :: ConnectionPool -- ^ How to intera
                                  , nChan    :: TChan Notification
                                  }
 
-instance MonadLogger m => MonadLogger (EitherT a m) where
-  monadLoggerLog loc src lvl = lift . monadLoggerLog loc src lvl
-
 handlerNat :: ( MonadReader ConnectionPool m
               , MonadLoggerIO m
-              ) => Map PrinterId Printer -> TChan Notification -> m (Handler :~> EitherT ServantErr IO)
--- ^ Servant requires its handlers to be 'EitherT ServantErr IO'
+              ) => Map PrinterId Printer -> TChan Notification -> m (Handler :~> ExceptT ServantErr IO)
+-- ^ Servant requires its handlers to be 'ExceptT ServantErr IO'
 --
 -- This generates a 'Nat'ural transformation for squashing the monad-transformer-stack we use in our handlers to the monad 'servant-server' wants
 handlerNat printerMap nChan = do
@@ -116,11 +113,11 @@ lookupPrinter :: Maybe PrinterId -> Handler (PrinterId, Printer)
 lookupPrinter pId = asks printers >>= maybePrinter' pId
   where
     maybePrinter' Nothing printerMap
-      | Map.null printerMap = left $ err501 { errBody = "No printers available" }
+      | Map.null printerMap = throwError $ err501 { errBody = "No printers available" }
       | otherwise = return $ Map.findMin printerMap
     maybePrinter' (Just pId) printerMap
       | Just printer <- Map.lookup pId printerMap = return (pId, printer)
-      | otherwise = left $ err404 { errBody = "No such printer" }
+      | otherwise = throwError $ err404 { errBody = "No such printer" }
 
 queue' :: MonadIO m => Printer -> m Queue
 -- ^ Call 'queue' and handle concurrency
@@ -160,10 +157,10 @@ listJobs pId     idR timeR = fmap (filterJobs . extractJobs) . (\(a, b) -> (,) a
                             )
 
 getJob :: API.JobId -> Handler Printout
-getJob jobId = fmap jobContent . maybe (left err404) return =<< runSqlPool (get $ castId jobId) =<< asks sqlPool
+getJob jobId = fmap jobContent . maybe (throwError err404) return =<< runSqlPool (get $ castId jobId) =<< asks sqlPool
 
 jobStatus :: API.JobId -> Handler JobStatus
-jobStatus jobId = maybe (left err404) return . lookup jobId . map (\(id, _, st) -> (id, st)) . toList =<< listJobs Nothing Nothing Nothing
+jobStatus jobId = maybe (throwError err404) return . lookup jobId . map (\(id, _, st) -> (id, st)) . toList =<< listJobs Nothing Nothing Nothing
 
 abortJob :: API.JobId -> Handler ()
 abortJob needle = do
@@ -179,7 +176,7 @@ abortJob needle = do
       $(logInfo) $ "Removed job #" <> (T.pack $ show (castId needle :: Integer)) <> " from " <> (T.pack . show $ pId')
       notify $ safeLink thermoprintAPI (Proxy :: Proxy ("jobs" :> Get '[JSON] (Seq (API.JobId, UTCTime, JobStatus))))
     return found
-  when (not found) $ left err404
+  when (not found) $ throwError err404
 
 listDrafts :: Handler (Map API.DraftId (Maybe DraftTitle))
 listDrafts = asks sqlPool >>= runSqlPool (selectSourceRes [] []) >>= flip with toMap
@@ -194,13 +191,13 @@ addDraft title content = do
   return id
 
 updateDraft :: API.DraftId -> Maybe DraftTitle -> Printout -> Handler ()
-updateDraft draftId title content = handle (\(KeyNotFound _) -> left $ err404) $ do
+updateDraft draftId title content = handle (\(KeyNotFound _) -> throwError $ err404) $ do
   runSqlPool (update (castId draftId) [ DraftTitle =. title, DraftContent =. content ]) =<< asks sqlPool
   $(logInfo) $ "Updated draft #" <> (T.pack $ show (castId draftId :: Integer))
   notify $ safeLink thermoprintAPI (Proxy :: Proxy ("draft" :> Capture "draftId" API.DraftId :> Get '[JSON] (Maybe DraftTitle, Printout))) $ draftId
 
 getDraft :: API.DraftId -> Handler (Maybe DraftTitle, Printout)
-getDraft draftId = fmap (\(Draft title content) -> (title, content)) . maybe (left err404) return =<< runSqlPool (get $ castId draftId) =<< asks sqlPool
+getDraft draftId = fmap (\(Draft title content) -> (title, content)) . maybe (throwError err404) return =<< runSqlPool (get $ castId draftId) =<< asks sqlPool
 
 deleteDraft :: API.DraftId -> Handler ()
 deleteDraft draftId = do
@@ -209,4 +206,4 @@ deleteDraft draftId = do
   notify $ safeLink thermoprintAPI (Proxy :: Proxy ("drafts" :> Get '[JSON] (Map API.DraftId (Maybe DraftTitle))))
 
 printDraft :: API.DraftId -> Maybe PrinterId -> Handler API.JobId
-printDraft draftId printerId = (\(Draft _ content) -> queueJob printerId content) =<< maybe (left err404) return =<< runSqlPool (get $ castId draftId) =<< asks sqlPool
+printDraft draftId printerId = (\(Draft _ content) -> queueJob printerId content) =<< maybe (throwError err404) return =<< runSqlPool (get $ castId draftId) =<< asks sqlPool
diff --git a/server/src/Thermoprint/Server/Printer/Debug.hs b/server/src/Thermoprint/Server/Printer/Debug.hs
index d7ee12a..b8580b8 100644
--- a/server/src/Thermoprint/Server/Printer/Debug.hs
+++ b/server/src/Thermoprint/Server/Printer/Debug.hs
@@ -26,7 +26,7 @@ debugPrint :: PrinterMethod
 debugPrint = PM $ (>> return Nothing) . $(logDebugS) "Printer.Debug" . T.pack . show . cotext' 
 
 cotext' :: Printout -> Text
-cotext' = mconcat . intersperse "\n\n" . map (mconcat . map cotext'' . toList) . toList
+cotext' = mconcat . intersperse "\n\n" . map (mconcat . map cotext'' . toList . getChunks) . toList . getParagraphs
   where
     cotext'' (Cooked b) = cotext b
     cotext'' (Raw _)    = "[Raw]"
diff --git a/server/src/Thermoprint/Server/Printer/Generic.hs b/server/src/Thermoprint/Server/Printer/Generic.hs
index df84e06..f431e4f 100644
--- a/server/src/Thermoprint/Server/Printer/Generic.hs
+++ b/server/src/Thermoprint/Server/Printer/Generic.hs
@@ -114,10 +114,10 @@ intersperse' :: Monad m => m b -> (a -> m b) -> Seq a -> m ()
 intersperse' b f = sequence_ . intersperse b f
 
 render :: Printout -> Put
-render = intersperse' (newls' 2) renderPar
+render = intersperse' (newls' 2) renderPar . getParagraphs
 
 renderPar :: Paragraph -> Put
-renderPar = mapM_ renderChunk
+renderPar = mapM_ renderChunk . getChunks
   where
     renderChunk (Raw bs)       = mapM_ pushWord8 $ LBS.unpack bs
     renderChunk (Cooked block) = renderDoc $ execState (renderBlock block) (initDoc width)
diff --git a/server/src/Thermoprint/Server/Queue/Utils.hs b/server/src/Thermoprint/Server/Queue/Utils.hs
index 86b0162..745053e 100644
--- a/server/src/Thermoprint/Server/Queue/Utils.hs
+++ b/server/src/Thermoprint/Server/Queue/Utils.hs
@@ -17,7 +17,7 @@ import Data.Time
 import Control.Monad.State
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Identity
-import Servant.Server.Internal.Enter
+import Servant.Utils.Enter
 
 import Thermoprint.Server.Queue
 
diff --git a/server/test/Thermoprint/ServerSpec.hs b/server/test/Thermoprint/ServerSpec.hs
index 028ba2d..8af210d 100644
--- a/server/test/Thermoprint/ServerSpec.hs
+++ b/server/test/Thermoprint/ServerSpec.hs
@@ -145,7 +145,7 @@ spec = withSetup $ do
     drafts `shouldReturn` []
     dId <- draftCreate Nothing mempty
     draft dId `shouldReturn` (Nothing, mempty)
-    drafts `shouldReturn` [(dId, mempty)]
+    drafts `shouldReturn` [(dId, Nothing :: Maybe DraftTitle)]
     p <- generate arbitrary
     draftReplace dId (Just "Title") p
     draft dId `shouldReturn` (Just "Title", p)
@@ -154,6 +154,6 @@ spec = withSetup $ do
     draftDelete dId
     drafts `shouldReturn` []
   where
-    Client{..} = mkClient' $ BaseUrl Http "localhost" 3000
+    Client{..} = mkClient' $ BaseUrl Http "localhost" 3000 ""
     
     
diff --git a/server/thermoprint-server.cabal b/server/thermoprint-server.cabal
index 62eb0ca..37cf065 100644
--- a/server/thermoprint-server.cabal
+++ b/server/thermoprint-server.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                thermoprint-server
-version:             1.1.0
+version:             2.0.0
 synopsis:            Server for thermoprint-spec
 -- description:         
 homepage:            http://dirty-haskell.org/tags/thermoprint.html
@@ -50,7 +50,7 @@ library
                      , servant-server >=0.4.4 && <1
                      , stm >=2.4.4 && <3
                      , text >=1.2.1 && <2
-                     , thermoprint-spec ==3.0.*
+                     , thermoprint-spec ==4.0.*
                      , time >=1.5.0 && <2
                      , wai >=3.0.4 && <4
                      , warp >=3.1.9 && <4
@@ -75,8 +75,8 @@ Test-Suite tests
   hs-source-dirs:      test
   main-is:             Spec.hs
   build-depends:       base >=4.8.1 && <5
-                     , thermoprint-server ==1.1.*
-                     , thermoprint-client ==0.0.*
+                     , thermoprint-server ==2.0.*
+                     , thermoprint-client ==1.0.*
                      , thermoprint-spec -any
                      , hspec >=2.2.1 && <3
                      , QuickCheck >=2.8.1 && <3
diff --git a/shell.nix b/shell.nix
index 638a9df..f0a69b4 100644
--- a/shell.nix
+++ b/shell.nix
@@ -6,7 +6,7 @@ let
   thermoprintPackages = builtins.attrValues (import ./default.nix {});
   ghc = haskellPackages.ghcWithPackages
     (ps: thermoprintPackages ++ utilities ps ++ testDeps ps);
-  utilities = (ps: with ps; [ hlint cabal2nix cabal-install ]);
+  utilities = (ps: with ps; [ hlint cabal2nix ]);
   testDeps = (ps: with ps; [ temporary hspec ]);
 in
 pkgs.stdenv.mkDerivation rec {
diff --git a/spec/src/Thermoprint/API.hs b/spec/src/Thermoprint/API.hs
index 9e91487..8e98db8 100644
--- a/spec/src/Thermoprint/API.hs
+++ b/spec/src/Thermoprint/API.hs
@@ -100,12 +100,6 @@ instance Exception PrintingError
 
 type DraftTitle = Text
 
-instance FromText UTCTime where
-  fromText = parseTimeM True defaultTimeLocale "%F_%T%Q" . T.unpack
-
-instance ToText UTCTime where
-  toText = T.pack . formatTime defaultTimeLocale "%F_%T%Q"
-
 data Range a = Min a | Max a | Through a a
   deriving (Show, Eq, Generic)
 
@@ -121,17 +115,19 @@ contains (Min min) x = min <= x
 contains (Max max) x = max >= x
 contains (Through min max) x = min <= x && x <= max
 
-instance ToText a => ToText (Range a) where
-  toText (Min min) = toText min <> "-"
-  toText (Max max) = "-" <> toText max
-  toText (Through min max) = toText min <> "-" <> toText max
+instance ToHttpApiData a => ToHttpApiData (Range a) where
+  toUrlPiece (Min min) = toUrlPiece min <> "-"
+  toUrlPiece (Max max) = "-" <> toUrlPiece max
+  toUrlPiece (Through min max) = toUrlPiece min <> "-" <> toUrlPiece max
   
-instance FromText a => FromText (Range a) where
-  fromText t = listToMaybe $ through <> max <> min
+instance FromHttpApiData a => FromHttpApiData (Range a) where
+  parseUrlPiece t = listToEither $ through <> max <> min
     where
-      through = [ Through min max | ((fromText -> Just min), (T.uncons -> Just ('-', (fromText -> Just max)))) <- zip (T.inits t) (T.tails t) ]
-      min = [ Min min | (fromText -> Just min) <- T.inits t ]
-      max = [ Max max | (fromText -> Just max) <- T.tails t ]
+      through = [ Through min max | ((parseUrlPiece -> Right min), (T.uncons -> Just ('-', (parseUrlPiece -> Right max)))) <- zip (T.inits t) (T.tails t) ]
+      min = [ Min min | (parseUrlPiece -> Right min) <- T.inits t ]
+      max = [ Max max | (parseUrlPiece -> Right max) <- T.tails t ]
+      listToEither [x] = Right x 
+      listToEither _   = Left t
 
 type ThermoprintAPI = "printers" :> Get '[JSON] (Map PrinterId PrinterStatus)
                       :<|> "jobs" :> (
@@ -144,16 +140,16 @@ type ThermoprintAPI = "printers" :> Get '[JSON] (Map PrinterId PrinterStatus)
                       :<|> "job" :> Capture "jobId" JobId :> (
                         Get '[JSON] Printout
                         :<|> "status" :> Get '[JSON] JobStatus
-                        :<|> Delete '[PlainText] ()
+                        :<|> Delete '[JSON] ()
                       )
                       :<|> "drafts" :> (
                         Get '[JSON] (Map DraftId (Maybe DraftTitle))
                         :<|> QueryParam "title" DraftTitle :> ReqBody '[JSON] Printout :> Post '[JSON] DraftId
                       )
                       :<|> "draft" :> Capture "draftId" DraftId :> (
-                        QueryParam "title" DraftTitle :> ReqBody '[JSON] Printout :> Put '[PlainText] ()
+                        QueryParam "title" DraftTitle :> ReqBody '[JSON] Printout :> Put '[JSON] ()
                         :<|> Get '[JSON] (Maybe DraftTitle, Printout)
-                        :<|> Delete '[PlainText] ()
+                        :<|> Delete '[JSON] ()
                         :<|> QueryParam "printer" PrinterId :> Post '[JSON] JobId
                       )
 
diff --git a/spec/src/Thermoprint/Identifiers.hs b/spec/src/Thermoprint/Identifiers.hs
index ed8534e..2a07318 100644
--- a/spec/src/Thermoprint/Identifiers.hs
+++ b/spec/src/Thermoprint/Identifiers.hs
@@ -12,17 +12,17 @@ import Data.Typeable (Typeable)
 import GHC.Generics (Generic)
 import Control.DeepSeq (NFData)
 
-import Servant.API (ToText, FromText)
+import Servant.API (ToHttpApiData, FromHttpApiData)
 import Data.Aeson (FromJSON, ToJSON)
 
 newtype PrinterId = PrinterId Integer
-                  deriving (Show, Read, Eq, Ord, Num, Real, Integral, Enum, FromText, ToText, FromJSON, ToJSON, Typeable, Generic, NFData)
+                  deriving (Show, Read, Eq, Ord, Num, Real, Integral, Enum, FromHttpApiData, ToHttpApiData, FromJSON, ToJSON, Typeable, Generic, NFData)
 
 newtype JobId = JobId Integer
-              deriving (Show, Read, Eq, Ord, Num, Real, Integral, Enum, FromText, ToText, FromJSON, ToJSON, Typeable, Generic, NFData)
+              deriving (Show, Read, Eq, Ord, Num, Real, Integral, Enum, FromHttpApiData, ToHttpApiData, FromJSON, ToJSON, Typeable, Generic, NFData)
 
 newtype DraftId = DraftId Integer
-              deriving (Show, Read, Eq, Ord, Num, Real, Integral, Enum, FromText, ToText, FromJSON, ToJSON, Typeable, Generic, NFData)
+              deriving (Show, Read, Eq, Ord, Num, Real, Integral, Enum, FromHttpApiData, ToHttpApiData, FromJSON, ToJSON, Typeable, Generic, NFData)
 
 castId :: (Integral a, Enum b) => a -> b
 castId = toEnum . fromInteger . toInteger
diff --git a/spec/src/Thermoprint/Printout.hs b/spec/src/Thermoprint/Printout.hs
index 2be0a83..8c33e07 100644
--- a/spec/src/Thermoprint/Printout.hs
+++ b/spec/src/Thermoprint/Printout.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 -- | This module contains the definition of the structure -- 'Printout' -- used to represent the content of a job
@@ -63,19 +63,47 @@ import Prelude hiding (fold)
 
 
 -- | A 'Printout' is a sequence of visually seperated 'Paragraph's
-type Printout = Seq Paragraph
+newtype Printout = Printout { getParagraphs :: Seq Paragraph }
+  deriving (Show, Generic, NFData)
+
+instance Eq Paragraph => Eq Printout where
+  (==) = (==) `on` getParagraphs
+
+instance Monoid Printout where
+  mempty = Printout mempty
+  mappend a b = Printout $ (mappend `on` getParagraphs) a b
+
+instance FromJSON Printout where
+  parseJSON = fmap Printout . parseJSON
+
+instance ToJSON Printout where
+  toJSON = toJSON . getParagraphs
+
+instance Arbitrary Printout where
+  arbitrary = Printout <$> arbitrary
 
 -- | A 'Paragraph' is a non-seperated sequence of 'Chunk's
-type Paragraph = Seq Chunk
+newtype Paragraph = Paragraph { getChunks :: Seq Chunk }
+  deriving (Show, Generic, NFData)
+
+instance Eq Chunk => Eq Paragraph where
+  (==) = (==) `on` getChunks
+
+instance Monoid Paragraph where
+  mempty = Paragraph mempty
+  mappend a b = Paragraph $ (mappend `on` getChunks) a b
+
+instance Arbitrary Paragraph where
+  arbitrary = Paragraph <$> arbitrary
 
 instance FromJSON Paragraph where
-  parseJSON o@(Array _)  = Seq.fromList  <$> parseJSON o
-  parseJSON o@(Object _) = Seq.singleton <$> parseJSON o
-  parseJSON o@(String _) = Seq.singleton <$> parseJSON o
+  parseJSON o@(Array _)  = Paragraph . Seq.fromList  <$> parseJSON o
+  parseJSON o@(Object _) = Paragraph . Seq.singleton <$> parseJSON o
+  parseJSON o@(String _) = Paragraph . Seq.singleton <$> parseJSON o
   parseJSON v = typeMismatch "Paragraph" v
 
 instance ToJSON Paragraph where
-  toJSON cs
+  toJSON (Paragraph cs)
     | (a :< as) <- viewl cs
     , Seq.null as = toJSON a
     | otherwise = toJSON $ toList cs
diff --git a/spec/thermoprint-spec.cabal b/spec/thermoprint-spec.cabal
index e236e05..28680fb 100644
--- a/spec/thermoprint-spec.cabal
+++ b/spec/thermoprint-spec.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                thermoprint-spec
-version:             3.0.0
+version:             4.0.0
 synopsis:            A specification of the API and the payload datatypes and associated utilities
 -- description:         
 homepage:            http://dirty-haskell.org/tags/thermoprint.html
diff --git a/threepenny.patch b/threepenny.patch
index 1feb733..5dbb84f 100644
--- a/threepenny.patch
+++ b/threepenny.patch
@@ -1,7 +1,46 @@
-From 480675cba32803ab74ec064e14ed6b2001c8e071 Mon Sep 17 00:00:00 2001
+From 86574dffb26128252159a6f25a3ea29be965047f Mon Sep 17 00:00:00 2001
+From: Heinrich Apfelmus <apfelmus@quantentunnel.de>
+Date: Fri, 27 May 2016 22:47:04 +0200
+Subject: [PATCH 1/3] Fix #138: Update the use of `GHC.mkWeak#` to GHC 8.0.1
+
+---
+ src/Foreign/RemotePtr.hs | 10 +++++++---
+ 1 file changed, 7 insertions(+), 3 deletions(-)
+
+diff --git a/src/Foreign/RemotePtr.hs b/src/Foreign/RemotePtr.hs
+index b534b74..fce37bc 100644
+--- a/src/Foreign/RemotePtr.hs
++++ b/src/Foreign/RemotePtr.hs
+@@ -33,14 +33,18 @@ import qualified GHC.IORef as GHC
+ import qualified GHC.STRef as GHC
+ 
+ mkWeakIORefValue :: IORef a -> value -> IO () -> IO (Weak value)
+-mkWeakIORefValue r@(GHC.IORef (GHC.STRef r#)) v f = GHC.IO $ \s ->
+-  case GHC.mkWeak# r# v f s of (# s1, w #) -> (# s1, GHC.Weak w #)
+-
+ #if CABAL
+ #if MIN_VERSION_base(4,6,0)
+ #else
+ atomicModifyIORef' = atomicModifyIORef
+ #endif
++#if MIN_VERSION_base(4,9,0)
++mkWeakIORefValue r@(GHC.IORef (GHC.STRef r#)) v (GHC.IO f) = GHC.IO $ \s ->
++  case GHC.mkWeak# r# v f s of (# s1, w #) -> (# s1, GHC.Weak w #)
++#endif
++#else
++mkWeakIORefValue r@(GHC.IORef (GHC.STRef r#)) v f = GHC.IO $ \s ->
++  case GHC.mkWeak# r# v f s of (# s1, w #) -> (# s1, GHC.Weak w #)
+ #endif
+ 
+ type Map = Map.Map
+-- 
+2.9.0
+
+
+From 0ed2c2ebb64b24fdcded4e273bfda1583763a815 Mon Sep 17 00:00:00 2001
 From: Gregor Kleen <gkleen@yggdrasil.li>
 Date: Tue, 23 Feb 2016 18:14:48 +0000
-Subject: [PATCH 1/2] Switched to using location.host
+Subject: [PATCH 2/3] Switched to using location.host
 
 ---
  js/comm.js | 2 +-
@@ -21,13 +60,13 @@ index 2d24f08..01763ba 100644
    
    // Close WebSocket when the browser window is closed.
 -- 
-2.7.0
+2.9.0
 
 
-From 52f45089ccf786c13d185faf1ad7436a63c13002 Mon Sep 17 00:00:00 2001
+From 4fb9b3304467a48d8ebeec85803464ec1a2aeeb6 Mon Sep 17 00:00:00 2001
 From: Gregor Kleen <gkleen@yggdrasil.li>
 Date: Tue, 1 Mar 2016 00:22:01 +0100
-Subject: [PATCH 2/2] Now manipulating the location object
+Subject: [PATCH 3/3] Now manipulating the location object
 
 ---
  js/comm.js                          |  3 +-
@@ -148,5 +187,5 @@ index 0d2a564..ceec6f4 100644
      , [include|js/comm.js|]
      , [include|js/ffi.js|]
 -- 
-2.7.0
+2.9.0
 
diff --git a/tp-bbcode/src/Thermoprint/Printout/BBCode.hs b/tp-bbcode/src/Thermoprint/Printout/BBCode.hs
index cbe2618..dd5edb0 100644
--- a/tp-bbcode/src/Thermoprint/Printout/BBCode.hs
+++ b/tp-bbcode/src/Thermoprint/Printout/BBCode.hs
@@ -104,7 +104,7 @@ morph :: DomForest -> Either SemanticError Printout
 -- ^ Parse a list of paragraphs
 --
 -- Since we permit only cooked input via 'Raw' 'Paragraph' is identical to 'Block'
-morph = fmap Seq.fromList . mapM (\t -> Seq.singleton . Cooked <$> parse BlockCtx t)
+morph = fmap (Printout . Seq.fromList) . mapM (\t -> Paragraph . Seq.singleton . Cooked <$> parse BlockCtx t)
 
 parseDom :: DomTree -> ParseResult
 -- ^ Invoke 'asLine' and 'asBlock' to parse a single 'DomTree'
diff --git a/tp-bbcode/src/Thermoprint/Printout/BBCode/Inverse.hs b/tp-bbcode/src/Thermoprint/Printout/BBCode/Inverse.hs
index edd4c5a..8e15417 100644
--- a/tp-bbcode/src/Thermoprint/Printout/BBCode/Inverse.hs
+++ b/tp-bbcode/src/Thermoprint/Printout/BBCode/Inverse.hs
@@ -24,10 +24,10 @@ import Data.Monoid
 import Thermoprint.Printout
 
 cobbcode :: Printout -> Either UnicodeException Text
-cobbcode (toList -> ps) = mconcat . intersperse "\n\n" <$> mapM handlePar ps
+cobbcode (toList . getParagraphs -> ps) = mconcat . intersperse "\n\n" <$> mapM handlePar ps
 
-handlePar :: Seq Chunk -> Either UnicodeException Text
-handlePar (toList -> cs) = mconcat <$> mapM handleChunk cs
+handlePar :: Paragraph -> Either UnicodeException Text
+handlePar (toList . getChunks -> cs) = mconcat <$> mapM handleChunk cs
 
 handleChunk :: Chunk -> Either UnicodeException Text
 handleChunk (Cooked b) = Right $ handleBlock b
diff --git a/tp-bbcode/test/Thermoprint/Printout/BBCodeSpec.hs b/tp-bbcode/test/Thermoprint/Printout/BBCodeSpec.hs
index 09b3147..7909360 100644
--- a/tp-bbcode/test/Thermoprint/Printout/BBCodeSpec.hs
+++ b/tp-bbcode/test/Thermoprint/Printout/BBCodeSpec.hs
@@ -53,7 +53,7 @@ normalize = (!! 3) . iterate normalize' . first (const ())
     join' _ = Left ()
 
 pOut :: Seq Block -> Printout
-pOut = fmap (pure . Cooked)
+pOut = Printout . fmap (Paragraph . pure . Cooked)
 
 examples :: [(Text, Either BBCodeError (Seq Block))]
 examples = [ ("Hello World!"
diff --git a/tp-bbcode/thermoprint-bbcode.cabal b/tp-bbcode/thermoprint-bbcode.cabal
index 8773b89..29855e2 100644
--- a/tp-bbcode/thermoprint-bbcode.cabal
+++ b/tp-bbcode/thermoprint-bbcode.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                thermoprint-bbcode
-version:             1.0.0
+version:             2.0.0
 synopsis:            Parse bbcode for use in thermoprint
 -- description:         
 homepage:            http://dirty-haskell.org/tags/thermoprint.html
@@ -24,8 +24,8 @@ library
                      , OverloadedLists
   -- other-extensions:    
   build-depends:       base >=4.8.1 && <5
-                     , thermoprint-spec ==3.0.*
-                     , bbcode >=3.0 && <4
+                     , thermoprint-spec ==4.0.*
+                     , bbcode >=3.1.1 && <4
                      , containers -any
                      , text -any
                      , case-insensitive -any
@@ -44,7 +44,7 @@ Test-Suite tests
                      , OverloadedLists
   build-depends:       base >=4.8.1 && <5
                      , thermoprint-bbcode -any
-                     , thermoprint-spec ==3.0.*
+                     , thermoprint-spec ==4.0.*
                      , hspec >=2.2.1 && <3
                      , QuickCheck >=2.8.1 && <3
                      , quickcheck-instances >=0.3.11 && <4
diff --git a/tprint/src/Options.hs b/tprint/src/Options.hs
index 1ad6c47..e146f91 100644
--- a/tprint/src/Options.hs
+++ b/tprint/src/Options.hs
@@ -26,6 +26,8 @@ import Instances ()
 import Paths_tprint (version)
 import Data.Version (showVersion)
 
+import Data.Bifunctor (Bifunctor(..))
+
 data TPrint = TPrint
   { baseUrl :: BaseUrl
   , dryRun :: Bool
@@ -148,7 +150,7 @@ pOperation = hsubparser $ mconcat [ command "printers" cmdPrinters
                                   ]
 
 pTPrint :: Parser TPrint
-pTPrint = TPrint <$> option (eitherReader parseBaseUrl) (metavar "URL" <> long "baseurl" <> short 'u' <> help "Server to interact with" <> value (BaseUrl Http "localhost" 3000) <> showDefaultWith showBaseUrl)
+pTPrint = TPrint <$> option (eitherReader $ first show . parseBaseUrl) (metavar "URL" <> long "baseurl" <> short 'u' <> help "Server to interact with" <> value (BaseUrl Http "localhost" 3000 "") <> showDefaultWith showBaseUrl)
   <*> switch (long "dry-run" <> short 'n' <> help "Don't send any requests that would be expected to change the servers state")
   <*> pOutput
   <*> pOperation
diff --git a/tprint/tprint.cabal b/tprint/tprint.cabal
index d6fc422..5fcd00b 100644
--- a/tprint/tprint.cabal
+++ b/tprint/tprint.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                tprint
-version:             1.0.0
+version:             2.0.0
 synopsis:            A CLI for thermoprint-client
 -- description:         
 homepage:            http://dirty-haskell.org/tags/thermoprint.html
@@ -22,9 +22,9 @@ executable tprint
                      , Options.Utils
                      , Instances
   -- other-extensions:    
-  build-depends:       base >=4.8 && <4.9
-                     , thermoprint-bbcode >=1.0.0 && <2
-                     , thermoprint-client ==0.0.*
+  build-depends:       base >=4.8 && <5
+                     , thermoprint-bbcode >=2.0.0 && <3
+                     , thermoprint-client ==1.0.*
                      , optparse-applicative >=0.12.1 && <1
                      , containers >=0.5.6 && <1
                      , time >=1.5.0 && <2
diff --git a/webgui/src/Main.hs b/webgui/src/Main.hs
index a295fd9..252e933 100644
--- a/webgui/src/Main.hs
+++ b/webgui/src/Main.hs
@@ -86,6 +86,7 @@ config = do
     <*> (BaseUrl Http
          <$> Opt.strOption (Opt.long "target-addr" <> Opt.short 'A' <> Opt.metavar "HOST" <> Opt.help "Host to connect to" <> Opt.value "localhost" <> Opt.showDefault)
          <*> Opt.option Opt.auto (Opt.long "target-port" <> Opt.short 'P' <> Opt.metavar "PORT" <> Opt.help "Port to connect to" <> Opt.value 3000 <> Opt.showDefault)
+         <*> Opt.strOption (Opt.long "target-path" <> Opt.short 'F' <> Opt.metavar "PATH" <> Opt.help "Path we expect to find Thermoprint.Server under" <> Opt.value "" <> Opt.showDefault)
         )
   where
     port def = Opt.long "port"
@@ -151,8 +152,8 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
       return (status, triggerStatusChange)
 
     Client{..} = mkClient (hoistNat $ Nat liftIO) server
-    withFatal :: EitherT ServantError UI a -> UI a
-    withFatal a = either (fatal . ("Error while communicating to Thermoprint.Server: " ++) . show) return =<< runEitherT a
+    withFatal :: ExceptT ServantError UI a -> UI a
+    withFatal a = either (fatal . ("Error while communicating to Thermoprint.Server: " ++) . show) return =<< runExceptT a
 
     handleEditor selectedPrinter (_, modifyFocusedJobs) = do
       title <- fatal' "Could not find editor title field" =<< getElementById window "editorTitle"
@@ -256,7 +257,7 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
 
       
       enactDeletion <- fatal' "Could not find deletion button" =<< getElementById window "enactDeletion"
-      on UI.click enactDeletion . const $ currentValue marking >>= mapM_ (runEitherT . draftDelete) >> updateMarking Set.empty
+      on UI.click enactDeletion . const $ currentValue marking >>= mapM_ (runExceptT . draftDelete) >> updateMarking Set.empty
       -- deletion' <- allowDeletion # get UI.checked
       let
         updateMarking' = callFunction (mangle <$> ffi getChecked) >>= updateMarking
@@ -342,7 +343,7 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
       (marking, (liftIO .) -> updateMarking) <- stepper' $ Set.empty
       
       enactAbortion <- fatal' "Could not find deletion button" =<< getElementById window "enactAbortion"
-      on UI.click enactAbortion . const $ currentValue marking >>= mapM_ (runEitherT . jobDelete) >> updateMarking Set.empty
+      on UI.click enactAbortion . const $ currentValue marking >>= mapM_ (runExceptT . jobDelete) >> updateMarking Set.empty
         
       (selectedPrinter, updatePrinter) <- do
         autoselectPrinter <- fatal' "Could not find printer autoselect switch" =<< getElementById window "autoselectPrinter"
diff --git a/webgui/thermoprint-webgui.cabal b/webgui/thermoprint-webgui.cabal
index 024bcf6..03aa9b2 100644
--- a/webgui/thermoprint-webgui.cabal
+++ b/webgui/thermoprint-webgui.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                thermoprint-webgui
-version:             0.0.0
+version:             1.0.0
 synopsis:            Threepenny interface for thermoprint-spec compliant servers
 -- description:         
 homepage:            http://dirty-haskell.org/tags/thermoprint.html
@@ -25,9 +25,9 @@ executable thermoprint-webgui
   main-is:             Main.hs
   -- other-modules:       
   -- other-extensions:    
-  build-depends:       base >=4.8 && <4.9
-                     , thermoprint-bbcode >=1.0.0 && <2
-                     , thermoprint-client ==0.0.*
+  build-depends:       base >=4.8 && <5
+                     , thermoprint-bbcode >=2.0.0 && <3
+                     , thermoprint-client ==1.0.*
                      , threepenny-gui >=0.6.0 && <1
                      , optparse-applicative >=0.12.1 && <1
                      , bytestring >=0.10.6 && <1