* Eliminate error type parameter file FileCacheT, it is always FileError

* Add newtype FileCacheT to replace ExceptT FileError to avoid MonadIO instance

Appraisal/FileCache.hs

@@ -149,7 +149,7 @@ md5' = show . md5 . Lazy.fromChunks . (: [])
 -- use writeFileReadable because the files we create need to be
 -- read remotely by our backup program.
 fileFromBytes ::
-    forall e m a. MonadFileCache e m
+    forall m a. MonadFileCache m
     => (P.ByteString -> m a)
     -> (a -> String)
     -> P.ByteString
@@ -167,7 +167,7 @@ fileFromBytes byteStringInfo toFileExt bytes =
 
 -- |Read the contents of a local path into a File.
 fileFromPath ::
-    forall e m a. MonadFileCache e m
+    forall m a. MonadFileCache m
     => (P.ByteString -> m a)
     -> (a -> String)
     -> FilePath
@@ -179,7 +179,7 @@ fileFromPath byteStringInfo toFileExt path = do
 
 -- | A shell command whose output becomes the contents of the file.
 fileFromCmd ::
-    forall e m a. MonadFileCache e m
+    forall m a. MonadFileCache m
     => (P.ByteString -> m a)
     -> (a -> String)
     -> String
@@ -195,7 +195,7 @@ fileFromCmd byteStringInfo toFileExt cmd = do
 
 -- |Retrieve a URI using curl and turn the resulting data into a File.
 fileFromURI ::
-    forall e m a. (MonadFileCache e m)
+    forall m a. (MonadFileCache m)
     => (P.ByteString -> m a)
     -> (a -> String)
     -> String
@@ -215,7 +215,7 @@ fileFromURI byteStringInfo toFileExt uri =
 -- is to avoid reading the file contents into a Haskell ByteString, which
 -- may be slower than using a unix pipeline.  Though it shouldn't be.
 fileFromCmdViaTemp ::
-    forall e m. MonadFileCache e m
+    forall m. MonadFileCache m
     => String
     -> String
     -> m File
@@ -235,7 +235,7 @@ fileFromCmdViaTemp ext exe = do
 
 -- | Move a file into the file cache and incorporate it into a File.
 fileFromPathViaRename ::
-    forall e m. (MonadFileCache e m)
+    forall m. (MonadFileCache m)
     => (CommandInfo -> FileError) -- ^ Use this to customize exception thrown here
     -> String
     -> FilePath
@@ -258,7 +258,7 @@ fileFromPathViaRename err ext path = do
 
 -- | Move a file into the file cache and incorporate it into a File.
 fileFromPathViaCopy ::
-    forall e m. MonadFileCache e m
+    forall m. MonadFileCache m
     => String
     -> FilePath
     -> m File
@@ -276,19 +276,19 @@ fileFromPathViaCopy ext path = do
 -- | Given a file and a ByteString containing the expected contents,
 -- verify the contents.  If it isn't installed or isn't correct,
 -- (re)install it.
-cacheFile :: MonadFileCache e m => File -> P.ByteString -> m File
+cacheFile :: MonadFileCache m => File -> P.ByteString -> m File
 cacheFile file bytes = do
   path <- fileCachePath file
   (loadBytesUnsafe file >>= checkBytes) `catchError`
-    (\ (_e :: e) -> liftIO (writeFileReadable path bytes) >> return file)
+    (\ (_e :: FileError) -> liftIO (writeFileReadable path bytes) >> return file)
     where
       checkBytes loaded = if loaded == bytes
                           -- then throwError (fromFileError (FunctionName "cacheFile" (SomeFileError "Checksum error")))
-                          then throwError (fromFileError CacheDamage)
+                          then throwError CacheDamage
                           else return file
 
 -- | Read and return the contents of the file from the cache as a ByteString.
-loadBytesSafe :: MonadFileCache e m => File -> m P.ByteString
+loadBytesSafe :: MonadFileCache m => File -> m P.ByteString
 loadBytesSafe file =
     do path <- fileCachePath file
        bytes <- liftIO (P.readFile path)
@@ -300,7 +300,7 @@ loadBytesSafe file =
            throwError (fromFileError CacheDamage)
 
 -- | Load an image file without verifying its checksum
-loadBytesUnsafe :: MonadFileCache e m => File -> m P.ByteString
+loadBytesUnsafe :: MonadFileCache m => File -> m P.ByteString
 loadBytesUnsafe file = fileCachePath file >>= liftIO . P.readFile
 
 instance Pretty File where
@@ -316,7 +316,7 @@ oldFileCachePath file = fileCacheTop >>= \(FileCacheTop ver) -> return $ ver <++
 fileCacheDir :: HasFileCacheTop m => File -> m FilePath
 fileCacheDir file = fileCacheTop >>= \(FileCacheTop ver) -> return $ ver <++> fileDir file
 
-fileCachePathIO :: MonadFileCache e m => File -> m FilePath
+fileCachePathIO :: MonadFileCache m => File -> m FilePath
 fileCachePathIO file = do
   dir <- fileCacheDir file
   liftIO $ createDirectoryIfMissing True dir
@@ -336,7 +336,7 @@ instance Arbitrary FileSource where
 
 -- | Scan all the file cache directories for files without using
 -- the database.
-allFiles :: (MonadIO m, MonadReader (st, FilePath) (FileCacheT st FileError m)) => FileCacheT st FileError m [FilePath]
+allFiles :: (MonadIO m, MonadReader (st, FilePath) (FileCacheT st m)) => FileCacheT st m [FilePath]
 allFiles = do
   FileCacheTop top <- fileCacheTop
   dirs <- liftIO $ listDirectory top

Appraisal/FileCacheT.hs

@@ -32,16 +32,16 @@ module Appraisal.FileCacheT
     , runFileCacheT
     , runFileCacheTop
     , runFileCache
-    , mapFileCacheT
+    -- , mapFileCacheT
     ) where
 
 import Appraisal.FileError
 import Control.Lens (_2, view)
 import Control.Monad.Except -- (ExceptT(ExceptT), liftEither, MonadError(..), runExceptT, withExceptT)
 import Control.Monad.Identity (Identity, runIdentity)
-import Control.Monad.Reader (mapReaderT, MonadReader(ask, local), ReaderT, runReaderT)
+import Control.Monad.Reader ({-mapReaderT,-} MonadReader(ask, local), ReaderT, runReaderT)
 import Control.Monad.Trans (lift, MonadIO(..), MonadTrans)
-import Debug.Show (V)
+--import Debug.Show (V)
 import System.Directory (createDirectoryIfMissing)
 
 newtype FileCacheTop = FileCacheTop {unFileCacheTop :: FilePath} deriving Show
@@ -52,62 +52,57 @@ newtype FileCacheTop = FileCacheTop {unFileCacheTop :: FilePath} deriving Show
 class Monad m => HasFileCacheTop m where
     fileCacheTop :: m FileCacheTop
 
-newtype FileCacheT st e m a =
-    FileCacheT {unFileCacheT :: ReaderT (st, FilePath) (ExceptT e m) a}
+newtype FileCacheT st m a =
+    FileCacheT {unFileCacheT :: ReaderT (st, FilePath) (FileErrorT m) a}
     deriving (Monad, Applicative, Functor)
 
-type FileCache st e a = FileCacheT st e Identity a
+type FileCache st a = FileCacheT st Identity a
 
-instance MonadTrans (FileCacheT st e) where
+instance MonadTrans (FileCacheT st) where
     lift = FileCacheT . lift . lift
 
-instance MonadIO m => MonadIO (FileCacheT st e m) where
+instance MonadIO m => MonadIO (FileCacheT st m) where
     liftIO = lift . liftIO
 
-type MonadFileCache e m = (MonadIO m, IsFileError e, Show e, Show (V e), MonadError e m, HasFileCacheTop m)
+type MonadFileCache m = (MonadIO m, MonadError FileError m, HasFileCacheTop m)
 
-#if !MIN_VERSION_mtl(2,2,2)
-liftEither :: MonadError e m => Either e a -> m a
-liftEither = either throwError return
-#endif
-
-instance (Monad m, MonadReader (st, FilePath) (FileCacheT st FileError m)) => HasFileCacheTop (FileCacheT st FileError m) where
+instance (Monad m, MonadReader (st, FilePath) (FileCacheT st m)) => HasFileCacheTop (FileCacheT st m) where
     fileCacheTop = (FileCacheTop . view _2) <$> ask
 
-instance (Monad m, e ~ FileError) => MonadError e (FileCacheT st e m) where
-    throwError :: e -> FileCacheT st FileError m a
+instance (Monad m, e ~ FileError) => MonadError e (FileCacheT st m) where
+    throwError :: e -> FileCacheT st m a
     throwError e = FileCacheT $ throwError e
-    catchError :: FileCacheT st FileError m a -> (e -> FileCacheT st FileError m a) -> FileCacheT st FileError m a
+    catchError :: FileCacheT st m a -> (e -> FileCacheT st m a) -> FileCacheT st m a
     catchError (FileCacheT m) c = FileCacheT $ m `catchError` (unFileCacheT . c)
 
-instance Monad m => MonadReader (st, FilePath) (FileCacheT st FileError m) where
+instance Monad m => MonadReader (st, FilePath) (FileCacheT st m) where
     ask = FileCacheT ask
     local f action = FileCacheT (local f (unFileCacheT action))
 
 runFileCacheT ::
        st
     -> FileCacheTop
-    -> FileCacheT st FileError m a
+    -> FileCacheT st m a
     -> m (Either FileError a)
 runFileCacheT fileAcidState (FileCacheTop fileCacheDir) action =
-    runExceptT (runReaderT (unFileCacheT action) (fileAcidState, fileCacheDir))
+    runFileErrorT (runReaderT (unFileCacheT action) (fileAcidState, fileCacheDir))
 
 runFileCacheTop ::
        FileCacheTop
-    -> FileCacheT () e m a
-    -> m (Either e a)
+    -> FileCacheT () m a
+    -> m (Either FileError a)
 runFileCacheTop (FileCacheTop fileCacheDir) action =
-    runExceptT (runReaderT (unFileCacheT action) ((), fileCacheDir))
+    runFileErrorT (runReaderT (unFileCacheT action) ((), fileCacheDir))
 
 runFileCache ::
        FileCacheTop
-    -> FileCache () () a
+    -> FileCache () a
     -> a
 runFileCache (FileCacheTop fileCacheDir) action =
-    (\(Right x) -> x) $ runIdentity (runExceptT (runReaderT (unFileCacheT action) ((), fileCacheDir)))
+    (\(Right x) -> x) $ runIdentity (runFileErrorT (runReaderT (unFileCacheT action) ((), fileCacheDir)))
 
-mapFileCacheT :: Functor m => (e -> e') -> FileCacheT st e m a -> FileCacheT st e' m a
-mapFileCacheT f = FileCacheT . mapReaderT (withExceptT f) . unFileCacheT
+-- mapFileCacheT :: Functor m => (e -> e') -> FileCacheT st m a -> FileCacheT st m a
+-- mapFileCacheT f = FileCacheT . mapReaderT (withExceptT f) . unFileCacheT
 
-ensureFileCacheTop :: MonadIO m => FileCacheT st FileError m ()
+ensureFileCacheTop :: MonadIO m => FileCacheT st m ()
 ensureFileCacheTop = fileCacheTop >>= lift . liftIO . createDirectoryIfMissing True . unFileCacheTop

Appraisal/FileError.hs

@@ -25,6 +25,8 @@
 
 module Appraisal.FileError
     ( FileError(..)
+    , FileErrorT
+    , runFileErrorT
     , CommandInfo(..)
     , IsFileError(fromFileError)
     , logFileError
@@ -33,8 +35,8 @@ module Appraisal.FileError
 
 import Control.Exception as E (ErrorCall(ErrorCallWithLocation), fromException, IOException, SomeException, throw, try)
 import Control.Monad (msum)
-import Control.Monad.Except (ExceptT(ExceptT))
-import Control.Monad.Trans (MonadIO(liftIO))
+import Control.Monad.Except (ExceptT(ExceptT), MonadError(catchError, throwError), runExceptT)
+import Control.Monad.Trans (MonadIO(liftIO), MonadTrans(lift))
 #ifdef LAZYIMAGES
 import qualified Data.ByteString.Lazy as P
 #else
@@ -84,13 +86,28 @@ logCommandInfo prefix (CommandInput bs e) = logM prefix ERROR (" - command input
 logCommandInfo prefix (CommandOut bs e) = logM prefix ERROR (" - command stdout: " <> show (P.take 1000 bs)) >> logCommandInfo prefix e
 logCommandInfo prefix (CommandErr bs e) = logM prefix ERROR (" - command stderr: " <> show (P.take 1000 bs)) >> logCommandInfo prefix e
 
+newtype FileErrorT m a = FileErrorT {unFileErrorT :: ExceptT FileError m a}
+    deriving (Monad, Applicative, Functor)
+
+instance MonadTrans FileErrorT where
+    lift = FileErrorT . lift
+
+instance Monad m => MonadError FileError (FileErrorT m) where
+    throwError :: FileError -> FileErrorT m a
+    throwError e = FileErrorT $ throwError e
+    catchError :: FileErrorT m a -> (FileError -> FileErrorT m a) -> FileErrorT m a
+    catchError (FileErrorT m) c = FileErrorT $ m `catchError` (unFileErrorT . c)
+
+runFileErrorT :: FileErrorT m a -> m (Either FileError a)
+runFileErrorT action = runExceptT (unFileErrorT action)
+
 -- | Turn any caught IOException and ErrorCall into FileError.  Log
 -- any intercepted IO errors.
-instance MonadIO m => MonadIO (ExceptT FileError m) where
+instance MonadIO m => MonadIO (FileErrorT m) where
   liftIO =
+    FileErrorT .
     (ExceptT :: m (Either FileError a) -> ExceptT FileError m a) .
     ((\io -> either (Left . toFileError) Right <$> io) :: m (Either SomeException a) -> m (Either FileError a)) .
-    -- (liftFileError' :: m (Either SomeException a) -> m (Either FileError a)) .
     logErrorCall .
     liftIO .
     try

Appraisal/ImageCache.hs

@@ -87,28 +87,28 @@ imageFilePath :: HasFileCacheTop m => ImageFile -> m FilePath
 imageFilePath img = fileCachePath (view imageFile img)
 
 -- | Find or create a cached image matching this ByteString.
-imageFileFromBytes :: forall e m. MonadFileCache e m => ByteString -> m ImageFile
+imageFileFromBytes :: forall m. MonadFileCache m => ByteString -> m ImageFile
 imageFileFromBytes bs = fileFromBytes (liftIO . getFileType) fileExtension bs >>= makeImageFile
 
 -- | Find or create a cached image file by downloading from this URI.
-imageFileFromURI :: MonadIO m => URI -> FileCacheT st FileError m ImageFile
+imageFileFromURI :: MonadIO m => URI -> FileCacheT st m ImageFile
 imageFileFromURI uri = fileFromURI (liftIO . getFileType) fileExtension (uriToString id uri "") >>= makeImageFile
 
 -- | Find or create a cached image file by reading from local file.
-imageFileFromPath :: MonadIO m => FilePath -> FileCacheT st FileError m ImageFile
+imageFileFromPath :: MonadIO m => FilePath -> FileCacheT st m ImageFile
 imageFileFromPath path = fileFromPath (liftIO . getFileType) fileExtension path >>= makeImageFile
 
 -- | Create an image file from a 'File'.  An ImageFile value implies
 -- that the image has been found in or added to the acid-state cache.
-makeImageFile :: forall e m. MonadFileCache e m => (File, ImageType) -> m ImageFile
+makeImageFile :: forall m. MonadFileCache m => (File, ImageType) -> m ImageFile
 makeImageFile (file, ityp) = do
     -- logM "Appraisal.ImageFile.makeImageFile" INFO ("Appraisal.ImageFile.makeImageFile - INFO file=" ++ show file) >>
     path <- fileCachePath file
     $logException ERROR (imageFileFromType path file ityp)
 
 -- | Helper function to build an image once its type is known - JPEG,
 -- GIF, etc.
-imageFileFromType :: MonadFileCache e m => FilePath -> File -> ImageType -> m ImageFile
+imageFileFromType :: MonadFileCache m => FilePath -> File -> ImageType -> m ImageFile
 imageFileFromType path file typ = do
   -- logM "Appraisal.ImageFile.imageFileFromType" DEBUG ("Appraisal.ImageFile.imageFileFromType - typ=" ++ show typ) >>
   let cmd = case typ of
@@ -125,7 +125,7 @@ imageFileFromType path file typ = do
     ExitFailure _ -> error $ "Failure building image file:\n " ++ showCmdSpec (cmdspec cmd) ++ " -> " ++ show code
 
 -- | Helper function to load a PNM file.
-imageFileFromPnmfileOutput :: MonadFileCache e m => File -> ImageType -> P.ByteString -> m ImageFile
+imageFileFromPnmfileOutput :: MonadFileCache m => File -> ImageType -> P.ByteString -> m ImageFile
 imageFileFromPnmfileOutput file typ out =
         case matchRegex pnmFileRegex (P.toString out) of
           Just [width, height, _, maxval] ->
@@ -146,7 +146,7 @@ imageFileFromPnmfileOutput file typ out =
 -- | Find or create a version of some image with its orientation
 -- corrected based on the EXIF orientation flag.  If the image is
 -- already upright this will return the original ImageFile.
-uprightImage :: MonadFileCache e m => ImageFile -> m ImageFile
+uprightImage :: MonadFileCache m => ImageFile -> m ImageFile
 uprightImage orig = do
   -- path <- _fileCachePath (imageFile orig)
   bs <- $logException ERROR (loadBytesSafe (view imageFile orig))
@@ -156,7 +156,7 @@ uprightImage orig = do
 -- | Find or create a cached image resized by decoding, applying
 -- pnmscale, and then re-encoding.  The new image inherits attributes
 -- of the old other than size.
-scaleImage :: forall e m. MonadFileCache e m => Double -> ImageFile -> m ImageFile
+scaleImage :: forall m. MonadFileCache m => Double -> ImageFile -> m ImageFile
 scaleImage scale orig | approx (toRational scale) == 1 = return orig
 scaleImage scale orig = $logException ERROR $ do
     path <- fileCachePath (view imageFile orig)
@@ -181,7 +181,7 @@ scaleImage scale orig = $logException ERROR $ do
 
 -- | Find or create a cached image which is a cropped version of
 -- another.
-editImage :: MonadFileCache e m => ImageCrop -> ImageFile -> m ImageFile
+editImage :: MonadFileCache m => ImageCrop -> ImageFile -> m ImageFile
 editImage crop file = $logException ERROR $
     case commands of
       [] ->
@@ -280,7 +280,7 @@ pipe' = intercalate " | "
 
 $(makeLensesFor [("imageFile", "imageFileL")] ''ImageFile)
 
-type ImageCacheT m = FileCacheT (AcidState (Map ImageKey ImageFile)) FileError m
+type ImageCacheT m = FileCacheT (AcidState (Map ImageKey ImageFile)) m
 
 {-
 type MonadImageCache m = MonadCache ImageKey ImageFile m
@@ -310,6 +310,6 @@ runImageCacheIO ::
     (MonadIO m)
     => AcidState (Map key val)
     -> FileCacheTop
-    -> FileCacheT (AcidState (Map key val)) FileError m a
+    -> FileCacheT (AcidState (Map key val)) m a
     -> m (Either FileError a)
 runImageCacheIO = runFileCacheT

Tests/Main.hs

@@ -10,6 +10,7 @@ module Main where
 import Appraisal.AcidCache
 import Appraisal.FileCache
 import Appraisal.FileCacheT
+import Appraisal.FileError
 import Control.Exception (IOException)
 import Control.Monad.Reader (ask, ReaderT)
 import Control.Monad.Trans (lift)
@@ -48,7 +49,7 @@ oldfile :: FilePath
 oldfile = "/usr/share/doc/cron/THANKS"
 
 type AcidM = ReaderT (AcidState (Map String String)) IO
-type FileM = FileCacheT (AcidState (Map String String)) IOException IO
+type FileM = FileCacheT (AcidState (Map String String)) IO
 
 -- | A simple cache - its builder simply reverses the key.  The
 -- IO monad is required to query and update the acid state database.
@@ -83,7 +84,7 @@ file1 = TestCase $ do
       f :: AcidState (Map String String) -> ExceptT FileError IO (Either FileError (File, ByteString))
       f fileAcidState =
           runFileCacheT fileAcidState fileCacheDir'
-            (fileFromPath return (pure "") oldfile :: FileCacheT st FileError (ExceptT FileError IO) (File, ByteString))
+            (fileFromPath return (pure "") oldfile :: FileCacheT st (ExceptT FileError IO) (File, ByteString))
              {-liftIO (try (fileFromPath return (pure "") oldfile) >>= either (throwError . IOException) return)-}
       expected :: (File, ByteString)
       expected = (File {_fileSource = Just (ThePath "/usr/share/doc/cron/THANKS"),