rakhana 0.1.0.1 → 0.2.0.0

raw patch · 6 files changed

+106/−88 lines, 6 filesdep −exceptionsPVP ok

version bump matches the API change (PVP)

Dependencies removed: exceptions

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +4/−0
• Data/Rakhana.hs +2/−0
• Data/Rakhana/Nursery.hs +68/−38
• Data/Rakhana/Util/Drive.hs +8/−23
• Data/Rakhana/XRef.hs +22/−23
• rakhana.cabal +2/−4

@@ -1,3 +1,7 @@+0.2.0.0+-------+* Migrate from MonadThrow to MonadError constraint+ 0.1.0.1 ------- * Added Cross-reference Streams support

@@ -18,12 +18,14 @@     , NReq     , NResp     , Number+    , NurseryException(..)     , Playground     , Reference     , Stream     , Tape     , TReq     , TResp+    , XRefException(..)     -- Prisms     , _Array     , _Boolean

@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts   #-} {-# LANGUAGE OverloadedStrings  #-} {-# LANGUAGE RankNTypes         #-} --------------------------------------------------------------------------------@@ -16,6 +17,8 @@     ( Playground     , NReq     , NResp+    , NurseryException(..)+    , XRefException(..)     , nurseryGetInfo     , nurseryGetHeader     , nurseryGetPages@@ -35,7 +38,7 @@ -------------------------------------------------------------------------------- import           Codec.Compression.Zlib (decompress) import           Control.Lens-import           Control.Monad.Catch+import           Control.Monad.Error.Class import           Control.Monad.Reader import           Control.Monad.State.Strict import           Data.Attoparsec.ByteString.Char8@@ -103,9 +106,6 @@     deriving Show  ---------------------------------------------------------------------------------instance Exception NurseryException---------------------------------------------------------------------------------- data NurseryState     = NurseryState       { nurseryHeader :: !Header@@ -120,7 +120,7 @@ bufferSize = 64  ---------------------------------------------------------------------------------nursery :: MonadCatch m => Nursery m a+nursery :: MonadError NurseryException m => Nursery m a nursery     = do h         <- getHeader          initState <- regularPDFAccess h@@ -135,16 +135,25 @@     dispatch s RqReferences         = serveReferences s  ---------------------------------------------------------------------------------regularPDFAccess :: MonadThrow m => Header -> Nursery m NurseryState+regularPDFAccess :: MonadError NurseryException m+                 => Header+                 -> Nursery m NurseryState regularPDFAccess h-    = do pos   <- getXRefPos-         xrefE <- getXRef h pos-         case xrefE of-             Left e     -> throwM $ NurseryXRefException e-             Right xref -> nurseryState h xref+    = do posE  <- getXRefPos+         case posE of+             Left e+                 -> throwError $ NurseryXRefException e+             Right pos+                 -> do xrefE <- getXRef h pos+                       case xrefE of+                           Left e     -> throwError $ NurseryXRefException e+                           Right xref -> nurseryState h xref  ---------------------------------------------------------------------------------nurseryState :: MonadThrow m => Header -> XRef -> Nursery m NurseryState+nurseryState :: MonadError NurseryException m+             => Header+             -> XRef+             -> Nursery m NurseryState nurseryState h xref     = do info  <- getInfo xref          root  <- getRoot xref@@ -177,7 +186,7 @@     pages = nurseryPages s  ---------------------------------------------------------------------------------serveResolve :: MonadThrow m+serveResolve :: MonadError NurseryException m              => NurseryState              -> Reference              -> Nursery m (NResp, NurseryState)@@ -188,7 +197,7 @@     xref = nurseryXRef s  ---------------------------------------------------------------------------------serveLoadStream :: MonadThrow m+serveLoadStream :: MonadError NurseryException m                 => NurseryState                 -> Stream                 -> Nursery m (NResp, NurseryState)@@ -199,7 +208,10 @@     xref = nurseryXRef s  ---------------------------------------------------------------------------------loadStream :: MonadThrow m => XRef -> Stream -> Nursery m BL.ByteString+loadStream :: MonadError NurseryException m+           => XRef+           -> Stream+           -> Nursery m BL.ByteString loadStream xref stream     = do mLen <- dict ^!? dictKey "Length"                       . act (resolveIfRef xref)@@ -207,7 +219,7 @@                       . _Natural          case mLen of              Nothing-                 -> throwM NurseryInvalidStreamObject+                 -> throwError NurseryInvalidStreamObject              Just len                  -> do driveSeek pos                        bs <- driveGetLazy $ fromIntegral len@@ -229,11 +241,15 @@     rs = M.keys $ xrefUTable $ nurseryXRef s  ---------------------------------------------------------------------------------getHeader :: MonadThrow m => Nursery m Header-getHeader = driveParse 8 parseHeader+getHeader :: MonadError NurseryException m => Nursery m Header+getHeader+    = do hE <- driveParse 8 parseHeader+         case hE of+             Left e  -> throwError $ NurseryParsingException e+             Right h -> return h  ---------------------------------------------------------------------------------getInfo :: MonadThrow m => XRef -> Nursery m Dictionary+getInfo :: MonadError NurseryException m => XRef -> Nursery m Dictionary getInfo xref = perform action trailer   where     trailer = xrefTrailer xref@@ -244,18 +260,18 @@              . _Dict  ---------------------------------------------------------------------------------getRoot :: MonadThrow m => XRef -> Nursery m Root+getRoot :: MonadError NurseryException m => XRef -> Nursery m Root getRoot xref     = maybe (trailerRoot xref) (streamRoot xref) xstreamM   where     xstreamM = xrefStream xref  ---------------------------------------------------------------------------------trailerRoot :: MonadThrow m => XRef -> Nursery m Root+trailerRoot :: MonadError NurseryException m => XRef -> Nursery m Root trailerRoot xref     = do mR <- trailer ^!? action          case mR of-             Nothing -> throwM NurseryRootNotFound+             Nothing -> throwError NurseryRootNotFound              Just r  -> return r   where     trailer = xrefTrailer xref@@ -267,11 +283,14 @@           . _Dict  ---------------------------------------------------------------------------------streamRoot :: MonadThrow m => XRef -> XRefStream -> Nursery m Root+streamRoot :: MonadError NurseryException m+           => XRef+           -> XRefStream+           -> Nursery m Root streamRoot xref xstream     = do mR <- dict ^!? action          case mR of-             Nothing -> throwM NurseryRootNotFound+             Nothing -> throwError NurseryRootNotFound              Just r  -> return r   where     dict = xrefStreamDict xstream@@ -283,11 +302,11 @@           . _Dict  ---------------------------------------------------------------------------------getPages :: MonadThrow m => XRef -> Root -> Nursery m Pages+getPages :: MonadError NurseryException m => XRef -> Root -> Nursery m Pages getPages xref root     = do mP <- root ^!? action          case mP of-             Nothing -> throwM NurseryPagesNotFound+             Nothing -> throwError NurseryPagesNotFound              Just p  -> return p   where     action@@ -297,12 +316,18 @@           . _Dict  ---------------------------------------------------------------------------------resolveIfRef :: MonadThrow m => XRef -> Object -> Nursery m Object+resolveIfRef :: MonadError NurseryException m+             => XRef+             -> Object+             -> Nursery m Object resolveIfRef xref (Ref i g) = resolveObject xref (i,g) resolveIfRef _ obj          = return obj  ---------------------------------------------------------------------------------resolveObject :: MonadThrow m => XRef -> Reference -> Nursery m Object+resolveObject :: MonadError NurseryException m+              => XRef+              -> Reference+              -> Nursery m Object resolveObject xref ref     = do driveTop          driveForward@@ -318,23 +343,23 @@               Just e                   -> do let offset = uObjOff e                         driveSeek offset-                        rE <- driveParseObjectE bufferSize+                        rE <- driveParseObject bufferSize                         case rE of-                            Left e' -> throwM $ NurseryParsingException e'+                            Left e' -> throwError $ NurseryParsingException e'                             Right r ->                                 case r ^. _3 of                                     Ref nidx ngen -> loop (nidx,ngen)                                     _             -> return $ r ^. _3  ---------------------------------------------------------------------------------resolveCompressedObject :: MonadThrow m+resolveCompressedObject :: MonadError NurseryException m                         => XRef                         -> Reference                         -> Nursery m Object resolveCompressedObject xref ref@(idx,gen)     = case M.lookup ref centries of           Nothing-              -> throwM $ NurseryUnresolvedObject idx gen+              -> throwError $ NurseryUnresolvedObject idx gen           Just cObj               -> let objsNum = cObjNum cObj                      sRef    = (objsNum, 0) in@@ -342,12 +367,12 @@                     let mPos = sObj ^? _Stream                     case mPos of                         Nothing-                            -> throwM NurseryExpectedStreamObject+                            -> throwError NurseryExpectedStreamObject                         Just stream                             -> do bs <- loadStream xref stream                                   case validateObjStm stream bs of                                       Left e-                                          -> throwM e+                                          -> throwError e                                       Right o                                           -> lookupObjStm ref o   where@@ -396,17 +421,20 @@     pos  = stream ^. streamPos  ---------------------------------------------------------------------------------lookupObjStm :: MonadThrow m => Reference -> ObjStm -> Nursery m Object+lookupObjStm :: MonadError NurseryException m+             => Reference+             -> ObjStm+             -> Nursery m Object lookupObjStm (idx,_) stm     = case M.lookup (fromIntegral idx) reg of-          Nothing -> throwM $ NurseryUnresolvedObjectInObjStm idx+          Nothing -> throwError $ NurseryUnresolvedObjectInObjStm idx           Just off               -> do let skipN   = fromIntegral (first+off)                         stream' = BL.drop skipN stream                      case PL.parse parser stream' of                         PL.Fail _ _ e-                            -> throwM $ NurseryParsingExceptionInObjStm e+                            -> throwError $ NurseryParsingExceptionInObjStm e                         PL.Done _ obj                             -> return obj   where@@ -417,7 +445,9 @@     first  = objStmFirst stm  ---------------------------------------------------------------------------------withNursery :: MonadCatch m => Client' NReq NResp m a -> Drive m a+withNursery :: MonadError NurseryException m+            => Client' NReq NResp m a+            -> Drive m a withNursery user = nursery >>~ const user  --------------------------------------------------------------------------------

@@ -20,7 +20,6 @@ -------------------------------------------------------------------------------- import Control.Exception import Control.Lens-import Control.Monad.Catch (MonadThrow(..)) import Data.Attoparsec.ByteString import Pipes.Safe () @@ -36,8 +35,8 @@ instance Exception ParsingException  ---------------------------------------------------------------------------------parseRepeatedly :: Monad m => Int -> Parser a -> Drive m (Either String a)-parseRepeatedly bufferSize parser+driveParse :: Monad m => Int -> Parser a -> Drive m (Either String a)+driveParse bufferSize parser     = loop Nothing   where     loop mK@@ -50,25 +49,11 @@                                   return $ Right a  ---------------------------------------------------------------------------------driveParse :: MonadThrow m => Int -> Parser a -> Drive m a-driveParse bufSize parser-    = do eR <- parseRepeatedly bufSize parser-         case eR of-             Left e  -> throwM $ ParsingException e-             Right a -> return a-----------------------------------------------------------------------------------driveParseObject :: MonadThrow m => Int -> Drive m (Int, Int, Object)-driveParseObject i-    = do rE <- driveParseObjectE i-         either (throwM . ParsingException) return rE-----------------------------------------------------------------------------------driveParseObjectE :: Monad m-                  => Int-                  -> Drive m (Either String (Int, Int, Object))-driveParseObjectE bufSize-    = do rE <- parseRepeatedly bufSize parseIndirectObject+driveParseObject :: Monad m+                 => Int+                 -> Drive m (Either String (Int, Int, Object))+driveParseObject bufSize+    = do rE <- driveParse bufSize parseIndirectObject          case rE of              Left e -> return $ Left e              Right r@@ -78,7 +63,7 @@                    -> return $ Right r   where     couldBeStreamObject (idx, gen) d-        = do eR <- parseRepeatedly 16 parseStreamHeader+        = do eR <- driveParse 16 parseStreamHeader              case eR of                  Left _                      -> return $ Right $ (idx, gen, Dict d)

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts   #-} {-# LANGUAGE OverloadedStrings  #-} {-# LANGUAGE RankNTypes         #-}@@ -36,13 +35,11 @@ import qualified Data.Map.Strict       as M import           Data.Maybe (fromMaybe) import           Data.Word-import           Data.Typeable  -------------------------------------------------------------------------------- import           Codec.Compression.Zlib import           Codec.Compression.Zlib.Internal import           Control.Lens-import           Control.Monad.Catch (Exception, MonadThrow(..)) import           Control.Monad.State.Strict import           Data.Attoparsec.ByteString import qualified Data.Attoparsec.ByteString.Lazy as PL@@ -149,10 +146,7 @@     | UnsupportedFilter B.ByteString     | UnsupportedPredictor Integer     | ZLibException String String-    deriving (Show, Typeable)-----------------------------------------------------------------------------------instance Exception XRefException+    deriving Show  -------------------------------------------------------------------------------- data ExtractState@@ -193,17 +187,21 @@ bufferSize = 4096  ---------------------------------------------------------------------------------getXRefPos :: MonadThrow m => Drive m Integer+getXRefPos :: Monad m => Drive m (Either XRefException Integer) getXRefPos     = do driveBottom          driveBackward          skipEOL-         parseEOF-         skipEOL-         p <- parseXRefPosInteger-         skipEOL-         parseStartXRef-         return p+         mE <- parseEOF+         case mE of+             Just e+                 -> return $ Left e+             Nothing+                 -> do skipEOL+                       p <- parseXRefPosInteger+                       skipEOL+                       mR <- parseStartXRef+                       return $ maybe (Right p) Left mR  -------------------------------------------------------------------------------- getXRef :: Monad m => Header -> Integer -> Drive m (Either XRefException XRef)@@ -223,7 +221,7 @@     = do driveTop          driveForward          driveSeek pos-         eR <- parseRepeatedly bufferSize parseXRef+         eR <- driveParse bufferSize parseXRef          return $ either (Left . XRefParsingException) Right eR  --------------------------------------------------------------------------------@@ -289,7 +287,7 @@     = do driveTop          driveForward          driveSeek offset-         rE <- driveParseObjectE 128+         rE <- driveParseObject 128          case rE of              Left e  -> return $ Left $ XRefParsingException e              Right r ->@@ -555,15 +553,15 @@              _ -> return ()  ---------------------------------------------------------------------------------parseEOF :: MonadThrow m => Drive m ()+parseEOF :: Monad m => Drive m (Maybe XRefException) parseEOF     = do bs <- driveGet 5          case bs of-             "%%EOF" -> return ()-             _       -> throwM $ XRefParsingException "Expected %%EOF"+             "%%EOF" -> return Nothing+             _       -> return $ Just $ XRefParsingException "Expected %%EOF"  ---------------------------------------------------------------------------------parseXRefPosInteger :: MonadThrow m => Drive m Integer+parseXRefPosInteger :: Monad m => Drive m Integer parseXRefPosInteger = go []   where     go cs = do bs <- drivePeek 1@@ -574,12 +572,13 @@                    _ -> return $ read cs  ---------------------------------------------------------------------------------parseStartXRef :: MonadThrow m => Drive m ()+parseStartXRef :: Monad m => Drive m (Maybe XRefException) parseStartXRef     = do bs <- driveGet 9          case bs of-             "startxref" -> return ()-             _           -> throwM $ XRefParsingException "Expected startxref"+             "startxref" -> return Nothing+             _           -> return $ Just  $+                            XRefParsingException "Expected startxref"  -------------------------------------------------------------------------------- -- Parsers

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.0.1+version:             0.2.0.0  -- A short (one-line) description of the package. synopsis: Stream based PDF library@@ -66,8 +66,7 @@                  Data.Rakhana.XRef    -- LANGUAGE extensions used by modules in this package.-  other-extensions: DeriveDataTypeable-                    FlexibleContexts+  other-extensions: FlexibleContexts                     OverloadedStrings                     RankNTypes                     TemplateHaskell@@ -77,7 +76,6 @@                      , attoparsec   == 0.12.*                      , bytestring                      , containers   == 0.5.*-                     , exceptions   == 0.6.*                      , lens         == 4.4.*                      , mtl                      , pipes        == 4.*