Simplify instances in Class by parameterizing on MonadTrans.

1 files changed, 21 insertions, 67 deletions

diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 25d6d2927..aebe617b1 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 {-
 Copyright (C) 2016-17 Jesse Rosenthal <jrosenthal@jhu.edu>
@@ -123,11 +124,9 @@ import System.FilePath ((</>), (<.>), takeDirectory,
 import qualified System.FilePath.Glob as IO (glob)
 import qualified System.Directory as IO (getModificationTime)
 import Control.Monad as M (fail)
-import Control.Monad.Reader (ReaderT)
 import Control.Monad.State.Strict
 import Control.Monad.Except
-import Control.Monad.Writer (WriterT)
-import Control.Monad.RWS (RWST)
+import Control.Monad.Trans (MonadTrans)
 import Data.Word (Word8)
 import Data.Default
 import System.IO.Error
@@ -841,53 +840,13 @@ instance PandocMonad PandocPure where
 
   logOutput _msg = return ()
 
-instance PandocMonad m => PandocMonad (ParsecT s st m) where
-  lookupEnv = lift . lookupEnv
-  getCurrentTime = lift getCurrentTime
-  getCurrentTimeZone = lift getCurrentTimeZone
-  newStdGen = lift newStdGen
-  newUniqueHash = lift newUniqueHash
-  openURL = lift . openURL
-  readFileLazy = lift . readFileLazy
-  readFileStrict = lift . readFileStrict
-  glob = lift . glob
-  fileExists = lift . fileExists
-  getDataFileName = lift . getDataFileName
-  getModificationTime = lift . getModificationTime
-  getCommonState = lift getCommonState
-  putCommonState = lift . putCommonState
-  trace msg = do
-    tracing <- getsCommonState stTrace
-    when tracing $ do
-      pos <- getPosition
-      Debug.Trace.trace
-        ("[trace] Parsed " ++ msg ++ " at line " ++
-            show (sourceLine pos) ++
-            if sourceName pos == "chunk"
-               then " of chunk"
-               else "")
-        (return ())
-  logOutput = lift . logOutput
-
-
-instance PandocMonad m => PandocMonad (ReaderT r m) where
-  lookupEnv = lift . lookupEnv
-  getCurrentTime = lift getCurrentTime
-  getCurrentTimeZone = lift getCurrentTimeZone
-  newStdGen = lift newStdGen
-  newUniqueHash = lift newUniqueHash
-  openURL = lift . openURL
-  readFileLazy = lift . readFileLazy
-  readFileStrict = lift . readFileStrict
-  glob = lift . glob
-  fileExists = lift . fileExists
-  getDataFileName = lift . getDataFileName
-  getModificationTime = lift . getModificationTime
-  getCommonState = lift getCommonState
-  putCommonState = lift . putCommonState
-  logOutput = lift . logOutput
-
-instance (PandocMonad m, Monoid w) => PandocMonad (WriterT w m) where
+-- This requires UndecidableInstances.  We could avoid that
+-- by repeating the definitions below for every monad transformer
+-- we use: ReaderT, WriterT, StateT, RWST.  But this seems to
+-- be harmless.
+instance (MonadTrans t, PandocMonad m, Functor (t m),
+          MonadError PandocError (t m), Monad (t m),
+          Applicative (t m)) => PandocMonad (t m) where
   lookupEnv = lift . lookupEnv
   getCurrentTime = lift getCurrentTime
   getCurrentTimeZone = lift getCurrentTimeZone
@@ -904,7 +863,7 @@ instance (PandocMonad m, Monoid w) => PandocMonad (WriterT w m) where
   putCommonState = lift . putCommonState
   logOutput = lift . logOutput
 
-instance (PandocMonad m, Monoid w) => PandocMonad (RWST r w st m) where
+instance {-# OVERLAPS #-} PandocMonad m => PandocMonad (ParsecT s st m) where
   lookupEnv = lift . lookupEnv
   getCurrentTime = lift getCurrentTime
   getCurrentTimeZone = lift getCurrentTimeZone
@@ -919,21 +878,16 @@ instance (PandocMonad m, Monoid w) => PandocMonad (RWST r w st m) where
   getModificationTime = lift . getModificationTime
   getCommonState = lift getCommonState
   putCommonState = lift . putCommonState
+  trace msg = do
+    tracing <- getsCommonState stTrace
+    when tracing $ do
+      pos <- getPosition
+      Debug.Trace.trace
+        ("[trace] Parsed " ++ msg ++ " at line " ++
+            show (sourceLine pos) ++
+            if sourceName pos == "chunk"
+               then " of chunk"
+               else "")
+        (return ())
   logOutput = lift . logOutput
 
-instance PandocMonad m => PandocMonad (StateT st m) where
-  lookupEnv = lift . lookupEnv
-  getCurrentTime = lift getCurrentTime
-  getCurrentTimeZone = lift getCurrentTimeZone
-  newStdGen = lift newStdGen
-  newUniqueHash = lift newUniqueHash
-  openURL = lift . openURL
-  readFileLazy = lift . readFileLazy
-  readFileStrict = lift . readFileStrict
-  glob = lift . glob
-  fileExists = lift . fileExists
-  getDataFileName = lift . getDataFileName
-  getModificationTime = lift . getModificationTime
-  getCommonState = lift getCommonState
-  putCommonState = lift . putCommonState
-  logOutput = lift . logOutput