Free: Add Typeable instance to PandocActionError

This commit is contained in:
Jesse Rosenthal 2016-11-18 20:39:26 -05:00 committed by John MacFarlane
parent 2ea3e77172
commit f404412331

View file

@ -1,4 +1,4 @@
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFunctor, DeriveDataTypeable #-}
{-
Copyright (C) 2016 Jesse Rosenthal <jrosenthal@jhu.edu>
@ -90,6 +90,7 @@ import qualified System.FilePath.Glob as IO (glob)
import Control.Monad.State hiding (fail)
import Control.Monad.Reader hiding (fail)
import Data.Word (Word8)
import Data.Typeable
data PandocActionF nxt =
LookupEnv String (Maybe String -> nxt)
@ -219,7 +220,7 @@ data TestEnv = TestEnv { envEnv :: [(String, String)]
}
data TestException = TestException
deriving (Show)
deriving (Show, Typeable)
instance E.Exception TestException