Testing error handling with classy prisms

LensError.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module LensError where

import Control.Lens
import Control.Monad.Error.Lens

data User
  = User
      { _userName :: String
      , _userAge  :: Int
      , _userPet  :: Pet
      }
  deriving Show

data Pet
  = Pet
      { _petType :: PetType
      , _petName :: String
      }
  deriving Show

data PetType
  = Dog
  | Cat
  deriving Show

makeClassy ''User
makeClassy ''Pet

alex :: User
alex = User "Alex" 27 azor

azor :: Pet
azor = Pet Dog "Azor"

instance HasPet User where
  pet = userPet
  petType = userPet . petType
  petName = userPet . petName

data AppError
  = AppFileError FileError
  | AppDbError DbError
  deriving Show

data FileError
  = FileNotFound String
  | FileInvalidPermissions String
  deriving Show

data DbError
  = DbNotFound String
  | DbInvalidPermissions String
  deriving Show

makeClassyPrisms ''AppError
makeClassyPrisms ''FileError
makeClassyPrisms ''DbError

instance AsFileError AppError where
  _FileError = _AppFileError . _FileError

instance AsDbError AppError where
  _DbError = _AppDbError . _DbError

fileOp :: AsFileError e => String -> Either e String
fileOp s
  = case s of
      "badfile" -> throwing _FileInvalidPermissions "bad file"
      s -> Right s

dbOp :: AsDbError e => String -> Either e String
dbOp s
  = case s of
      "baddb" ->  throwing _DbNotFound "bad db"
      s -> Right s

-- ops :: (AsFileError e, AsDbError e) => Either e String
ops :: () => Either AppError String
ops = do
  f <- fileOp "baddb"
  -- d <- dbOp f
  catching _DbNotFound (dbOp f) (\e -> Right ("caught: " ++ show e))