{-# LANGUAGE OverloadedStrings #-}

-- | Pdf file as a set of objects

module Pdf.Core.File
( File(..)
, withPdfFile
, fromHandle
, fromBytes
, fromBuffer
, lastTrailer
, findObject
, streamContent
, rawStreamContent
, EncryptionStatus(..)
, encryptionStatus
, setUserPassword
, setDecryptor
, NotFound(..)
)
where

import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import Data.IORef
import qualified Data.HashMap.Strict as HashMap
import Control.Monad
import Control.Exception (Exception, throwIO, catch)
import System.IO (Handle)
import qualified System.IO as IO
import System.IO.Streams (InputStream)

import Pdf.Core.Object
import Pdf.Core.Object.Util
import Pdf.Core.Exception
import Pdf.Core.XRef
import Pdf.Core.Stream (StreamFilter)
import Pdf.Core.Util
import qualified Pdf.Core.Stream as Stream
import Pdf.Core.IO.Buffer (Buffer)
import qualified Pdf.Core.IO.Buffer as Buffer
import Pdf.Core.Encryption

-- | Pdf file is a collection of 'Object's
data File = File
  { File -> XRef
fileLastXRef :: XRef
  , File -> Buffer
fileBuffer :: Buffer
  , File -> [StreamFilter]
fileFilters :: [StreamFilter]
  , File -> IORef (Maybe Decryptor)
fileDecryptor :: IORef (Maybe Decryptor)
  }

-- | The last trailer is an entry point to PDF file. All other objects
-- usually are referensed from it, directly or indirectly.
lastTrailer :: File -> IO Dict
lastTrailer :: File -> IO Dict
lastTrailer File
file = Buffer -> XRef -> IO Dict
trailer (File -> Buffer
fileBuffer File
file) (File -> XRef
fileLastXRef File
file)

-- | Get an object with the specified ref.
findObject :: File -> Ref -> IO Object
findObject :: File -> Ref -> IO Object
findObject File
file Ref
ref = do
  Maybe Entry
mentry <- (Entry -> Maybe Entry) -> IO Entry -> IO (Maybe Entry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entry -> Maybe Entry
forall a. a -> Maybe a
Just (File -> Ref -> IO Entry
lookupEntryRec File
file Ref
ref)
    IO (Maybe Entry)
-> (UnknownXRefStreamEntryType -> IO (Maybe Entry))
-> IO (Maybe Entry)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(UnknownXRefStreamEntryType Int
_) -> Maybe Entry -> IO (Maybe Entry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Entry
forall a. Maybe a
Nothing
  case Maybe Entry
mentry of
    Maybe Entry
Nothing -> Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
Null
    Just Entry
entry -> File -> Entry -> IO Object
readObjectForEntry File
file Entry
entry

-- | Get content of the stream
--
-- It's decrypted and decoded using registered 'StreamFilter's if necessary.
streamContent :: File -> Ref -> Stream -> IO (InputStream ByteString)
streamContent :: File -> Ref -> Stream -> IO (InputStream ByteString)
streamContent File
file Ref
ref Stream
s = do
  InputStream ByteString
is <- File -> Ref -> Stream -> IO (InputStream ByteString)
rawStreamContent File
file Ref
ref Stream
s
  [StreamFilter]
-> Stream -> InputStream ByteString -> IO (InputStream ByteString)
Stream.decodeStream (File -> [StreamFilter]
fileFilters File
file) Stream
s InputStream ByteString
is

-- | Get content of the stream
--
-- Content would be decrypted if necessary.
rawStreamContent :: File -> Ref -> Stream -> IO (InputStream ByteString)
rawStreamContent :: File -> Ref -> Stream -> IO (InputStream ByteString)
rawStreamContent File
file Ref
ref (S Dict
dict Int64
pos) = do
  Int
len <- do
    Object
obj <- Either String Object -> IO Object
forall a. Either String a -> IO a
sure (Either String Object -> IO Object)
-> Either String Object -> IO Object
forall a b. (a -> b) -> a -> b
$ Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Length" Dict
dict
      Maybe Object -> String -> Either String Object
forall a. Maybe a -> String -> Either String a
`notice` String
"Length missing in stream"
    case Object
obj of
      Number Scientific
_ -> Either String Int -> IO Int
forall a. Either String a -> IO a
sure (Either String Int -> IO Int) -> Either String Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Object -> Maybe Int
intValue Object
obj
        Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"Length should be an integer"
      Ref Ref
r -> do
        Object
o <- File -> Ref -> IO Object
findObject File
file Ref
r
        Either String Int -> IO Int
forall a. Either String a -> IO a
sure (Either String Int -> IO Int) -> Either String Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Object -> Maybe Int
intValue Object
o Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"Length should be an integer"
      Object
_ -> Corrupted -> IO Int
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO Int) -> Corrupted -> IO Int
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted String
"Length should be an integer" []
  InputStream ByteString
is <- Buffer -> Int -> Int64 -> IO (InputStream ByteString)
Stream.rawStreamContent (File -> Buffer
fileBuffer File
file) Int
len Int64
pos
  Maybe Decryptor
mdecryptor <- IORef (Maybe Decryptor) -> IO (Maybe Decryptor)
forall a. IORef a -> IO a
readIORef (File -> IORef (Maybe Decryptor)
fileDecryptor File
file)
  case Maybe Decryptor
mdecryptor of
    Maybe Decryptor
Nothing -> InputStream ByteString -> IO (InputStream ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return InputStream ByteString
is
    Just Decryptor
decryptor -> Decryptor
decryptor Ref
ref DecryptorScope
DecryptStream InputStream ByteString
is

-- | Describes wether PDF file is encrypted, plain or already decrypted
data EncryptionStatus
  = Encrypted  -- ^ requires decryption
  | Decrypted  -- ^ already decrypted
  | Plain      -- ^ doesn't require decryption
  deriving (Int -> EncryptionStatus -> ShowS
[EncryptionStatus] -> ShowS
EncryptionStatus -> String
(Int -> EncryptionStatus -> ShowS)
-> (EncryptionStatus -> String)
-> ([EncryptionStatus] -> ShowS)
-> Show EncryptionStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncryptionStatus] -> ShowS
$cshowList :: [EncryptionStatus] -> ShowS
show :: EncryptionStatus -> String
$cshow :: EncryptionStatus -> String
showsPrec :: Int -> EncryptionStatus -> ShowS
$cshowsPrec :: Int -> EncryptionStatus -> ShowS
Show, EncryptionStatus -> EncryptionStatus -> Bool
(EncryptionStatus -> EncryptionStatus -> Bool)
-> (EncryptionStatus -> EncryptionStatus -> Bool)
-> Eq EncryptionStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncryptionStatus -> EncryptionStatus -> Bool
$c/= :: EncryptionStatus -> EncryptionStatus -> Bool
== :: EncryptionStatus -> EncryptionStatus -> Bool
$c== :: EncryptionStatus -> EncryptionStatus -> Bool
Eq, Int -> EncryptionStatus
EncryptionStatus -> Int
EncryptionStatus -> [EncryptionStatus]
EncryptionStatus -> EncryptionStatus
EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
EncryptionStatus
-> EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
(EncryptionStatus -> EncryptionStatus)
-> (EncryptionStatus -> EncryptionStatus)
-> (Int -> EncryptionStatus)
-> (EncryptionStatus -> Int)
-> (EncryptionStatus -> [EncryptionStatus])
-> (EncryptionStatus -> EncryptionStatus -> [EncryptionStatus])
-> (EncryptionStatus -> EncryptionStatus -> [EncryptionStatus])
-> (EncryptionStatus
    -> EncryptionStatus -> EncryptionStatus -> [EncryptionStatus])
-> Enum EncryptionStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EncryptionStatus
-> EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
$cenumFromThenTo :: EncryptionStatus
-> EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
enumFromTo :: EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
$cenumFromTo :: EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
enumFromThen :: EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
$cenumFromThen :: EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
enumFrom :: EncryptionStatus -> [EncryptionStatus]
$cenumFrom :: EncryptionStatus -> [EncryptionStatus]
fromEnum :: EncryptionStatus -> Int
$cfromEnum :: EncryptionStatus -> Int
toEnum :: Int -> EncryptionStatus
$ctoEnum :: Int -> EncryptionStatus
pred :: EncryptionStatus -> EncryptionStatus
$cpred :: EncryptionStatus -> EncryptionStatus
succ :: EncryptionStatus -> EncryptionStatus
$csucc :: EncryptionStatus -> EncryptionStatus
Enum)

-- | Get encryption status.
--
-- If it's 'Encrypted', you may want to 'setUserPassword' to decrypt it.
encryptionStatus :: File -> IO EncryptionStatus
encryptionStatus :: File -> IO EncryptionStatus
encryptionStatus File
file = do
  Dict
tr <- File -> IO Dict
lastTrailer File
file
  case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Encrypt" Dict
tr of
    Maybe Object
Nothing -> EncryptionStatus -> IO EncryptionStatus
forall (m :: * -> *) a. Monad m => a -> m a
return EncryptionStatus
Plain
    Just Object
_ -> do
      Maybe Decryptor
decr <- IORef (Maybe Decryptor) -> IO (Maybe Decryptor)
forall a. IORef a -> IO a
readIORef (File -> IORef (Maybe Decryptor)
fileDecryptor File
file)
      case Maybe Decryptor
decr of
        Maybe Decryptor
Nothing -> EncryptionStatus -> IO EncryptionStatus
forall (m :: * -> *) a. Monad m => a -> m a
return EncryptionStatus
Encrypted
        Just Decryptor
_ -> EncryptionStatus -> IO EncryptionStatus
forall (m :: * -> *) a. Monad m => a -> m a
return EncryptionStatus
Decrypted

-- | Set user password to decrypt PDF file.
--
-- Use empty bytestring to set the default password.
-- Returns @True@ on success.
-- See also 'setDecryptor'.
setUserPassword :: File -> ByteString -> IO Bool
setUserPassword :: File -> ByteString -> IO Bool
setUserPassword File
file ByteString
password = String -> IO Bool -> IO Bool
forall a. String -> IO a -> IO a
message String
"setUserPassword" (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
  Dict
tr <- File -> IO Dict
lastTrailer File
file
  Dict
enc <-
    case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Encrypt" Dict
tr of
      Maybe Object
Nothing -> Unexpected -> IO Dict
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Unexpected
Unexpected String
"document is not encrypted" [])
      Just Object
o -> do
        Object
o' <- File -> Object -> IO Object
deref File
file Object
o
        case Object
o' of
          Dict Dict
d -> Dict -> IO Dict
forall (m :: * -> *) a. Monad m => a -> m a
return Dict
d
          Object
Null -> Corrupted -> IO Dict
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
"encryption encryption dict is null" [])
          Object
_ -> Corrupted -> IO Dict
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
"document Encrypt should be a dictionary" [])
  let either_decryptor :: Either String (Maybe Decryptor)
either_decryptor = Dict -> Dict -> ByteString -> Either String (Maybe Decryptor)
mkStandardDecryptor Dict
tr Dict
enc
        (Int -> ByteString -> ByteString
ByteString.take Int
32 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
password ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
defaultUserPassword)
  case Either String (Maybe Decryptor)
either_decryptor of
    Left String
err -> Corrupted -> IO Bool
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO Bool) -> Corrupted -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted String
err []
    Right Maybe Decryptor
Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Right (Just Decryptor
decryptor) -> do
      File -> Decryptor -> IO ()
setDecryptor File
file Decryptor
decryptor
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  where
  deref :: File -> Object -> IO Object
deref File
f (Ref Ref
ref) = File -> Ref -> IO Object
findObject File
f Ref
ref
  deref File
_ Object
o = Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
o

-- | Decrypt file using the specified decryptor.
--
-- Use it if 'setUserPassword' doesn't work for you.
setDecryptor :: File -> Decryptor -> IO ()
setDecryptor :: File -> Decryptor -> IO ()
setDecryptor File
file Decryptor
decryptor =
  IORef (Maybe Decryptor) -> Maybe Decryptor -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (File -> IORef (Maybe Decryptor)
fileDecryptor File
file) (Decryptor -> Maybe Decryptor
forall a. a -> Maybe a
Just Decryptor
decryptor)

-- | Create file from a buffer.
--
-- You may use 'Stream.knownFilters' as the first argument.
fromBuffer :: [StreamFilter] -> Buffer -> IO File
fromBuffer :: [StreamFilter] -> Buffer -> IO File
fromBuffer [StreamFilter]
filters Buffer
buffer = do
  XRef
xref <- Buffer -> IO XRef
lastXRef Buffer
buffer
  IORef (Maybe Decryptor)
decryptor <- Maybe Decryptor -> IO (IORef (Maybe Decryptor))
forall a. a -> IO (IORef a)
newIORef Maybe Decryptor
forall a. Maybe a
Nothing
  File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File :: XRef -> Buffer -> [StreamFilter] -> IORef (Maybe Decryptor) -> File
File
    { fileLastXRef :: XRef
fileLastXRef = XRef
xref
    , fileBuffer :: Buffer
fileBuffer = Buffer
buffer
    , fileFilters :: [StreamFilter]
fileFilters = [StreamFilter]
filters
    , fileDecryptor :: IORef (Maybe Decryptor)
fileDecryptor = IORef (Maybe Decryptor)
decryptor
    }

-- | Create file from a binary handle.
--
-- You may use 'Stream.knownFilters' as the first argument.
fromHandle :: [StreamFilter] -> Handle -> IO File
fromHandle :: [StreamFilter] -> Handle -> IO File
fromHandle [StreamFilter]
filters Handle
handle = do
  Buffer
buffer <- Handle -> IO Buffer
Buffer.fromHandle Handle
handle
  [StreamFilter] -> Buffer -> IO File
fromBuffer [StreamFilter]
filters Buffer
buffer

-- | Create file from a ByteString.
--
-- You may use 'Stream.knownFilters' as the first argument.
fromBytes :: [StreamFilter] -> ByteString -> IO File
fromBytes :: [StreamFilter] -> ByteString -> IO File
fromBytes [StreamFilter]
filters ByteString
bytes = do
  Buffer
buffer <- ByteString -> IO Buffer
Buffer.fromBytes ByteString
bytes
  [StreamFilter] -> Buffer -> IO File
fromBuffer [StreamFilter]
filters Buffer
buffer

-- | Open Pdf file
--
-- You may want to check 'encryptionStatus' and 'setUserPassword' if
-- file is encrypted.
withPdfFile :: FilePath -> (File -> IO a) -> IO a
withPdfFile :: String -> (File -> IO a) -> IO a
withPdfFile String
path File -> IO a
action =
  String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
IO.withBinaryFile String
path IOMode
IO.ReadMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle
handle -> do
    File
file <- [StreamFilter] -> Handle -> IO File
fromHandle [StreamFilter]
Stream.knownFilters Handle
handle
    File -> IO a
action File
file

lookupEntryRec :: File -> Ref -> IO Entry
lookupEntryRec :: File -> Ref -> IO Entry
lookupEntryRec File
file Ref
ref = XRef -> IO Entry
loop (File -> XRef
fileLastXRef File
file)
  where
  loop :: XRef -> IO Entry
loop XRef
xref = do
    Maybe Entry
res <- File -> Ref -> XRef -> IO (Maybe Entry)
lookupEntry File
file Ref
ref XRef
xref
    case Maybe Entry
res of
      Just Entry
e -> Entry -> IO Entry
forall (m :: * -> *) a. Monad m => a -> m a
return Entry
e
      Maybe Entry
Nothing -> do
        Maybe XRef
prev <- Buffer -> XRef -> IO (Maybe XRef)
prevXRef (File -> Buffer
fileBuffer File
file) XRef
xref
        case Maybe XRef
prev of
          Just XRef
p -> XRef -> IO Entry
loop XRef
p
          Maybe XRef
Nothing -> NotFound -> IO Entry
forall e a. Exception e => e -> IO a
throwIO (String -> NotFound
NotFound (String -> NotFound) -> String -> NotFound
forall a b. (a -> b) -> a -> b
$ String
"The Ref not found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ref -> String
forall a. Show a => a -> String
show Ref
ref)

lookupEntry :: File -> Ref -> XRef -> IO (Maybe Entry)
lookupEntry :: File -> Ref -> XRef -> IO (Maybe Entry)
lookupEntry File
file Ref
ref xref :: XRef
xref@(XRefTable Int64
_) =
  Buffer -> XRef -> Ref -> IO (Maybe Entry)
lookupTableEntry (File -> Buffer
fileBuffer File
file) XRef
xref Ref
ref
lookupEntry File
file Ref
ref (XRefStream Int64
_ s :: Stream
s@(S Dict
dict Int64
_)) = do
  InputStream ByteString
content <- File -> Ref -> Stream -> IO (InputStream ByteString)
streamContent File
file Ref
ref Stream
s
  Dict -> InputStream ByteString -> Ref -> IO (Maybe Entry)
lookupStreamEntry Dict
dict InputStream ByteString
content Ref
ref

readObjectForEntry :: File -> Entry -> IO Object

readObjectForEntry :: File -> Entry -> IO Object
readObjectForEntry File
_ EntryFree{} = Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
Null

readObjectForEntry File
file (EntryUsed Int64
off Int
gen) = do
  (Ref
ref, Object
obj) <- Buffer -> Int64 -> IO (Ref, Object)
readObjectAtOffset (File -> Buffer
fileBuffer File
file) Int64
off
  let R Int
_ Int
gen' = Ref
ref
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
gen' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
gen) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Corrupted -> IO ()
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
"readObjectForEntry" [String
"object generation missmatch"])
  File -> Ref -> Object -> IO Object
decrypt File
file Ref
ref Object
obj

readObjectForEntry File
file (EntryCompressed Int
index Int
num) = do
  let ref :: Ref
ref= Int -> Int -> Ref
R Int
index Int
0
  objStream :: Stream
objStream@(S Dict
dict Int64
_) <- do
    Object
o <- File -> Ref -> IO Object
findObject File
file Ref
ref
    Either String Stream -> IO Stream
forall a. Either String a -> IO a
sure (Either String Stream -> IO Stream)
-> Either String Stream -> IO Stream
forall a b. (a -> b) -> a -> b
$ Object -> Maybe Stream
streamValue Object
o Maybe Stream -> String -> Either String Stream
forall a. Maybe a -> String -> Either String a
`notice` String
"Compressed entry should be in stream"
  Int
first <- Either String Int -> IO Int
forall a. Either String a -> IO a
sure (Either String Int -> IO Int) -> Either String Int -> IO Int
forall a b. (a -> b) -> a -> b
$ (Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"First" Dict
dict Maybe Object -> (Object -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Maybe Int
intValue)
      Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"First should be an integer"
  InputStream ByteString
content <- File -> Ref -> Stream -> IO (InputStream ByteString)
streamContent File
file Ref
ref Stream
objStream
  InputStream ByteString -> Int64 -> Int -> IO Object
readCompressedObject InputStream ByteString
content (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
first) Int
num

decrypt :: File -> Ref -> Object -> IO Object
decrypt :: File -> Ref -> Object -> IO Object
decrypt File
file Ref
ref Object
o = do
  Maybe Decryptor
maybe_decr <- IORef (Maybe Decryptor) -> IO (Maybe Decryptor)
forall a. IORef a -> IO a
readIORef (File -> IORef (Maybe Decryptor)
fileDecryptor File
file)
  case Maybe Decryptor
maybe_decr of
    Maybe Decryptor
Nothing -> Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
o
    Just Decryptor
decr -> Decryptor -> Ref -> Object -> IO Object
decryptObject Decryptor
decr Ref
ref Object
o

data NotFound = NotFound String
  deriving (Int -> NotFound -> ShowS
[NotFound] -> ShowS
NotFound -> String
(Int -> NotFound -> ShowS)
-> (NotFound -> String) -> ([NotFound] -> ShowS) -> Show NotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotFound] -> ShowS
$cshowList :: [NotFound] -> ShowS
show :: NotFound -> String
$cshow :: NotFound -> String
showsPrec :: Int -> NotFound -> ShowS
$cshowsPrec :: Int -> NotFound -> ShowS
Show)

instance Exception NotFound