zim-parser 0.2.0.0 → 0.2.1.0
raw patch · 3 files changed
+475/−463 lines, 3 filesdep +base-compatdep +lzmadep −lzma-conduitdep −resourcetPVP ok
version bump matches the API change (PVP)
Dependencies added: base-compat, lzma
Dependencies removed: lzma-conduit, resourcet
API changes (from Hackage documentation)
Files
- src/Codec/Archive/Zim/Parser.hs +427/−416
- test/Codec/Archive/Zim/ParserSpec.hs +2/−3
- zim-parser.cabal +46/−44
src/Codec/Archive/Zim/Parser.hs view
@@ -82,207 +82,214 @@ -- > setHeader "Content-Type" (fromStrict $ decodeUtf8 mimeType) -- > raw content ----- Feedback and contributions are welcome on <http://github.com/robbinch/zim-parser>.+-- Feedback and contributions are welcome on+-- <http://github.com/robbinch/zim-parser>. -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleInstances #-}--module Codec.Archive.Zim.Parser- (- -- * Functions- getHeader- , getMimeList- , getDE- , getMainPageUrl- , getCluster- , getBlob- , getContent- , searchDE- , MimeList- , mkNsTitle- , mkNsTitlePrefix- , mkNsUrl- , RunZim- , ZimGetDE- , ZimSearchDE- , ZimGetContent- -- * Exceptions- , ZimException(..)- -- * ZIM Header- , ZimHeader(..)- -- * ZIM Directory Entry- , ZimDirEntType(..)- , ZimDirEnt(..)- , UrlIndex(..)- , TitleIndex(..)- , ClusterNumber(..)- , BlobNumber(..)- , Cluster(..)- , Blob(..)- , Url(..)- , Title- , TitlePrefix- -- * ZIM file format- -- | Following is a short summary of the ZIM file format.- -- The authoritative reference is at http://www.openzim.org/wiki/ZIM_file_format.- --- -- === 1. ZIM header- -- This is an 80-byte header (see 'ZimHeader'). Among other things, it contains file offsets to the below.- --- -- === 2. List of MIME types- -- This is a sequence of null-terminated strings (eg. @text\/html@, @text\/javascript@). The last string is zero length, so- -- the end always consists of 2 consecutive null bytes.- --- -- === 3. List of URLs- -- This is a sequence of 8-byte file offsets, each pointing to a directory entry. This list is sorted by the directory entries' URL.- --- -- 'getZimDirEntByUrlIndex' looks up this table to return a directory entry.- --- -- === 4. List of Titles- -- This is a sequence of 4-byte indices, each pointing to a URL above (which in turn point to a directory entry).- -- This list is sorted by the directory entries' Title.- --- -- 'getZimDirEntByTitleIndex' uses this table to return a directory entry.- --- -- === 5. Directory Entries- -- This is a sequence of Directory Entries (see 'ZimDirEnt').- -- The first 2 bytes determine the type of this entry, which also determine the length.- -- Contents include:- --- -- ==== a. MIME type- -- This 2-byte field means:- --- -- [@0xffff@] This directory entry is a 'ZimRedirectEntry'.- -- [@0xfffe@] This directory entry is a 'ZimLinkTarget'.- -- [@0xfffd@] This directory entry is a 'ZimDeletedEntry'.- -- [@any other value@] This directory entry is a 'ZimArticleEntry' and this index into the MIME list from above determines its MIME type.- --- -- ==== b. Namespace- -- This single character determines the directory entry's namespace. (eg. __A__ for articles, __I__ for images, etc.)- -- The comprehensive list is at http://www.openzim.org/wiki/ZIM_file_format#Namespaces.- --- -- ==== c. Cluster and Blob number- -- Only for 'ZimArticleEntry', this is the directory entry's Cluster and Blob number.- -- The Cluster number is a 4-byte index into the list of Clusters below.- -- The Blob number refers to a block inside the (decompressed) cluster.- -- Together, they provide the content of this directory entry.- --- -- ==== d. URL and Title- -- These 2 null-terminated strings represent the URL and Title of this directory entry respectively.- -- If the Title is empty, it is taken to be the same as the URL.- --- -- === 6. List of Clusters- -- This is a list of 8-byte file offsets, each pointing to a cluster in the file.- -- The end of a cluster is also the start of the next cluster.- -- Therefore, the length of a cluster is the difference between the adjacent offsets.- -- For the last cluster, the end is the Checksum file offset, as the Checksum is always- -- the last 16 bytes of a ZIM file.- --- -- ==== a. Compression Type- -- The first byte of the cluster determines if it is uncompressed (eg. PNG image) or compressed with LZMA (eg. HTML).- --- -- [@0 or 1@] No compression- -- [@4@] Compressed with LZMA- --- -- ==== b. List of Blobs- -- This is a list of 4-byte offsets, each pointing inside this cluster.- -- The end of a blob is also the start of the next blob.- -- Therefore, the length of a blob is the difference between the adjacent offsets.- -- The last offset points to the end of the data area so there is always one more offset than blobs.- ) where+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Codec.Archive.Zim.Parser (+-- * Functions+ getHeader+, getMimeList+, getDE+, getMainPageUrl+, getCluster+, getBlob+, getContent+, searchDE+, MimeList+, mkNsTitle+, mkNsTitlePrefix+, mkNsUrl+, RunZim+, ZimGetDE+, ZimSearchDE+, ZimGetContent+-- * Exceptions+, ZimException(..)+-- * ZIM Header+, ZimHeader(..)+-- * ZIM Directory Entry+, ZimDirEntType(..)+, ZimDirEnt(..)+, UrlIndex(..)+, TitleIndex(..)+, ClusterNumber(..)+, BlobNumber(..)+, Cluster(..)+, Blob(..)+, Url(..)+, Title+, TitlePrefix+-- * ZIM file format+-- | Following is a short summary of the ZIM file format.+-- The authoritative reference is at+-- http://www.openzim.org/wiki/ZIM_file_format.+--+-- === 1. ZIM header+-- This is an 80-byte header (see 'ZimHeader'). Among other things, it contains+-- file offsets to the below.+--+-- === 2. List of MIME types+-- This is a sequence of null-terminated strings (eg. @text\/html@,+-- @text\/javascript@). The last string is zero length, so the end always+-- consists of 2 consecutive null bytes.+--+-- === 3. List of URLs+-- This is a sequence of 8-byte file offsets, each pointing to a directory+-- entry. This list is sorted by the directory entries' URL.+--+-- === 4. List of Titles+-- This is a sequence of 4-byte indices, each pointing to a URL above (which in+-- turn point to a directory entry). This list is sorted by the directory+-- entries' Title.+--+-- === 5. Directory Entries+-- This is a sequence of Directory Entries (see 'ZimDirEnt').+-- The first 2 bytes determine the type of this entry, which also determine the+-- length.+-- Contents include:+--+-- ==== a. MIME type+-- This 2-byte field means:+--+-- [@0xffff@] This directory entry is a 'ZimRedirectEntry'.+-- [@0xfffe@] This directory entry is a 'ZimLinkTarget'.+-- [@0xfffd@] This directory entry is a 'ZimDeletedEntry'.+-- [@any other value@] This directory entry is a 'ZimArticleEntry' and this+-- index into the MIME list from above determines its MIME type.+--+-- ==== b. Namespace+-- This single character determines the directory entry's namespace.+-- (eg. __A__ for articles, __I__ for images, etc.) The comprehensive list is+-- at http://www.openzim.org/wiki/ZIM_file_format#Namespaces.+--+-- ==== c. Cluster and Blob number+-- Only for 'ZimArticleEntry', this is the directory entry's Cluster and+-- Blob number. The Cluster number is a 4-byte index into the list of Clusters+-- below. The Blob number refers to a block inside the (decompressed) cluster.+-- Together, they provide the content of this directory entry.+--+-- ==== d. URL and Title+-- These 2 null-terminated strings represent the URL and Title of this directory+-- entry respectively. If the Title is empty, it is taken to be the same as the+-- URL.+--+-- === 6. List of Clusters+-- This is a list of 8-byte file offsets, each pointing to a cluster in the+-- file. -- The end of a cluster is also the start of the next cluster.+-- Therefore, the length of a cluster is the difference between the adjacent+-- offsets. For the last cluster, the end is the Checksum file offset, as the+-- Checksum is always the last 16 bytes of a ZIM file.+--+-- ==== a. Compression Type+-- The first byte of the cluster determines if it is uncompressed+-- (eg. PNG image) or compressed with LZMA (eg. HTML).+--+-- [@0 or 1@] No compression+-- [@4@] Compressed with LZMA+--+-- ==== b. List of Blobs+-- This is a list of 4-byte offsets, each pointing inside this cluster.+-- The end of a blob is also the start of the next blob.+-- Therefore, the length of a blob is the difference between the adjacent+-- offsets. The last offset points to the end of the data area so there is+-- always one more offset than blobs.+) where -import Control.Applicative ((<$>), (<*>))-import Control.Exception (Exception, throw)-import Control.Monad (when)-import Data.Char (chr)-import Data.Maybe (fromJust)-import Data.Typeable (Typeable)+import Prelude ()+import Prelude.Compat+import Codec.Compression.Lzma (decompress)+import Control.Exception (Exception, throw)+import Control.Monad (when) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL-import System.IO (Handle, IOMode(ReadMode), withBinaryFile)+import Data.Char (chr)+import Data.Maybe (fromJust)+import Data.Typeable (Typeable)+import System.IO (Handle, IOMode (ReadMode), withBinaryFile) -import Data.Conduit (($$), (=$), await, Sink)-import Control.Monad.Trans.Resource (runResourceT)-import Data.Conduit.Binary (sourceHandleRange, sourceLbs, sinkLbs)-import Data.Conduit.Serialization.Binary (sinkGet, conduitGet)-import Data.Conduit.Lzma (decompress)+import Data.Conduit (Sink, await, ($$), (=$))+import Data.Conduit.Binary (sourceHandleRange, sourceLbs)+import Data.Conduit.Serialization.Binary (conduitGet, sinkGet) -import Data.Array.IArray ((!), listArray, Array)-import Data.Binary.Get (Get, skip, getWord8, getWord16le, getWord32le, getWord64le, getByteString, getLazyByteStringNul, getRemainingLazyByteString)-import Numeric (showHex)+import Data.Array.IArray (Array, listArray, (!))+import Data.Binary.Get+import Numeric (showHex) -- | Other than the below, ErrorCall can be thrown by LZMA library if there is a problem with decompression.-data ZimException = ZimInvalidMagic -- ^ ZIM file has invalid magic number (anything other than 72173914).- | ZimParseError String -- ^ There is an error in parsing.- | ZimIncompleteInput -- ^ There is insufficient bytes required to parse.- | ZimInvalidIndex Int -- ^ The given index (URL, title or cluster) is out of bounds for this ZIM file.- deriving (Show, Typeable)+data ZimException+ = ZimInvalidMagic -- ^ ZIM file has invalid magic number (anything other than 72173914).+ | ZimParseError String -- ^ There is an error in parsing.+ | ZimIncompleteInput -- ^ There is insufficient bytes required to parse.+ | ZimInvalidIndex Int -- ^ The given index (URL, title or cluster) is out of bounds for this ZIM file.+ deriving (Show, Typeable) instance Exception ZimException -- | See http://www.openzim.org/wiki/ZIM_file_format#Header for more details.-data ZimHeader = ZimHeader- {- -- | Magic Number of file (somewhat superfluous as 'getZimHeader' will throw an exception if magic number is anything other than 72173914)- zimMagicNumber :: Int- -- | Version of ZIM header- , zimVersion :: Int- -- | UUID of file- , zimUuid :: B.ByteString- -- | Number of articles- , zimArticleCount :: Int- -- | Number of clusters- , zimClusterCount :: Int- -- | Position of sorted URL pointers- , zimUrlPtrPos :: Integer- -- | Position of sorted Title pointers- , zimTitlePtrPos :: Integer- -- | Position of Cluster pointers- , zimClusterPtrPos :: Integer- -- | Position of MIME list- , zimMimeListPos :: Integer- -- | Index of main page- , zimMainPage :: Maybe Int- -- | Index of layout page- , zimLayoutPage :: Maybe Int- -- | Position of MD5 checksum- , zimChecksumPos :: Integer- } deriving (Show, Eq)+data ZimHeader = ZimHeader {+ -- | Magic Number of file (somewhat superfluous as 'getZimHeader' will throw an exception if magic number is anything other than 72173914)+ zimMagicNumber :: Int+ -- | Version of ZIM header+ , zimVersion :: Int+ -- | UUID of file+ , zimUuid :: B.ByteString+ -- | Number of articles+ , zimArticleCount :: Int+ -- | Number of clusters+ , zimClusterCount :: Int+ -- | Position of sorted URL pointers+ , zimUrlPtrPos :: Integer+ -- | Position of sorted Title pointers+ , zimTitlePtrPos :: Integer+ -- | Position of Cluster pointers+ , zimClusterPtrPos :: Integer+ -- | Position of MIME list+ , zimMimeListPos :: Integer+ -- | Index of main page+ , zimMainPage :: Maybe Int+ -- | Index of layout page+ , zimLayoutPage :: Maybe Int+ -- | Position of MD5 checksum+ , zimChecksumPos :: Integer+ } deriving (Show, Eq) -- | There are 4 types of directory entries. Most content in a ZIM file are -- usually 'ZimArticleEntry' or 'ZimRedirectEntry'.-data ZimDirEntType = ZimArticleEntry- | ZimRedirectEntry- | ZimLinkTarget- | ZimDeletedEntry- deriving (Eq, Show)+data ZimDirEntType+ = ZimArticleEntry+ | ZimRedirectEntry+ | ZimLinkTarget+ | ZimDeletedEntry+ deriving (Eq, Show) --- | See http://www.openzim.org/wiki/ZIM_file_format#Directory_Entries for more details.-data ZimDirEnt = ZimDirEnt- {- -- | Type of this Directory Entry- zimDeType :: ZimDirEntType- -- | Index into MIME list given by 'getZimMimeList'- , zimDeMimeType :: Int- -- | Parameter Length- , zimDeParameterLen :: Int- -- | Namespace- , zimDeNamespace :: Char- -- | Revision- , zimDeRevision :: Int- -- | Redirect Index (only applicable for 'ZimRedirectEntry')- , zimDeRedirectIndex :: Maybe Int- -- | Content is stored in this Cluster Number (only applicable for 'ZimArticleEntry')- , zimDeClusterNumber :: Maybe Int- -- | Content is stored in this Blob Number (only applicable for 'ZimArticleEntry')- , zimDeBlobNumber :: Maybe Int- -- | URL- , zimDeUrl :: B8.ByteString- -- | Title- , zimDeTitle :: B8.ByteString- -- , zimDeParameter :: BL.ByteString -- unused- } deriving (Eq, Show)+-- | See http://www.openzim.org/wiki/ZIM_file_format#Directory_Entries for more+-- details.+data ZimDirEnt = ZimDirEnt {+ -- | Type of this Directory Entry+ zimDeType :: ZimDirEntType+ -- | Index into MIME list given by 'getZimMimeList'+ , zimDeMimeType :: Int+ -- | Parameter Length+ , zimDeParameterLen :: Int+ -- | Namespace+ , zimDeNamespace :: Char+ -- | Revision+ , zimDeRevision :: Int+ -- | Redirect Index (only applicable for 'ZimRedirectEntry')+ , zimDeRedirectIndex :: Maybe Int+ -- | Content is stored in this Cluster Number (only applicable for 'ZimArticleEntry')+ , zimDeClusterNumber :: Maybe Int+ -- | Content is stored in this Blob Number (only applicable for 'ZimArticleEntry')+ , zimDeBlobNumber :: Maybe Int+ -- | URL+ , zimDeUrl :: B8.ByteString+ -- | Title+ , zimDeTitle :: B8.ByteString+ -- , zimDeParameter :: BL.ByteString -- unused+ } deriving (Eq, Show) -- | List of Mime Types type MimeList = Array Int B8.ByteString@@ -321,41 +328,47 @@ parseZimHeader :: Get ZimHeader parseZimHeader = do- magicNumber <- fromIntegral <$> getWord32le- when (magicNumber /= 72173914) $ throw ZimInvalidMagic- version <- fromIntegral <$> getWord32le- uuid <- getByteString 16- articleCount <- fromIntegral <$> getWord32le- clusterCount <- fromIntegral <$> getWord32le- urlPtrPos <- fromIntegral <$> getWord64le- titlePtrPos <- fromIntegral <$> getWord64le- clusterPtrPos <- fromIntegral <$> getWord64le- mimeListPos <- fromIntegral <$> getWord64le- mainPage <- fromIntegral <$> getWord32le- layoutPage <- fromIntegral <$> getWord32le- checksumPos <- fromIntegral <$> getWord64le- return $ ZimHeader magicNumber version uuid articleCount clusterCount- urlPtrPos titlePtrPos clusterPtrPos mimeListPos- (if mainPage == 0xffffffff then Nothing else Just mainPage)- (if layoutPage == 0xffffffff then Nothing else Just layoutPage)- checksumPos+ magicNumber <- fromIntegral <$> getWord32le+ when (magicNumber /= 72173914) $ throw ZimInvalidMagic+ version <- fromIntegral <$> getWord32le+ uuid <- getByteString 16+ articleCount <- fromIntegral <$> getWord32le+ clusterCount <- fromIntegral <$> getWord32le+ urlPtrPos <- fromIntegral <$> getWord64le+ titlePtrPos <- fromIntegral <$> getWord64le+ clusterPtrPos <- fromIntegral <$> getWord64le+ mimeListPos <- fromIntegral <$> getWord64le+ mainPage <- fromIntegral <$> getWord32le+ layoutPage <- fromIntegral <$> getWord32le+ checksumPos <- fromIntegral <$> getWord64le+ return $ ZimHeader magicNumber version uuid articleCount clusterCount+ urlPtrPos titlePtrPos clusterPtrPos mimeListPos+ (maybePage mainPage) (maybePage layoutPage) checksumPos+ where+ maybePage page+ | page == 0xffffffff = Nothing+ | otherwise = Just page --- | Instances of this class represent a Zim File and are able to perform ZIM operations (getMimeList, getContent, etc). Valid instances include a Handle to a ZIM file, a FilePath to a ZIM file, or a (Handle, ZimHeader) where ZimHeader is parsed previously (so it does not need to be reparsed).+-- | Instances of this class represent a Zim File and are able to perform ZIM+-- operations (getMimeList, getContent, etc). Valid instances include a Handle+-- to a ZIM file, a FilePath to a ZIM file, or a (Handle, ZimHeader) where+-- ZimHeader is parsed previously (so it does not need to be reparsed). class RunZim h where- runZim :: h -> (Handle -> ZimHeader -> IO a) -> IO a+ runZim :: h -> (Handle -> ZimHeader -> IO a) -> IO a instance RunZim Handle where- runZim hdl f = do- hdr <- src $$ sinkGet parseZimHeader- f hdl hdr- where (pos, len) = (Just 0, Just 80)- src = sourceHandleRange hdl pos len+ runZim hdl f = do+ hdr <- src $$ sinkGet parseZimHeader+ f hdl hdr+ where+ (pos, len) = (Just 0, Just 80)+ src = sourceHandleRange hdl pos len instance RunZim (Handle, ZimHeader) where- runZim x f = uncurry f x+ runZim x f = uncurry f x instance RunZim FilePath where- runZim fp f = withBinaryFile fp ReadMode $ \hdl -> runZim hdl f+ runZim fp f = withBinaryFile fp ReadMode $ \hdl -> runZim hdl f getHeader :: RunZim h => h -> IO ZimHeader getHeader h = runZim h $ \_ hdr -> return hdr@@ -364,262 +377,260 @@ -- Last entry is zero length (end of block is always 2 null bytes). parseByteStringsNul :: Sink B8.ByteString IO [B8.ByteString] parseByteStringsNul = conduitGet getLazyByteStringNul =$ loop id- where loop :: ([B8.ByteString] -> [B8.ByteString]) -> Sink BL.ByteString IO [B8.ByteString]- loop front = await >>= maybe- (return $ front [])- (\x -> let bs = BL.toStrict x- in if B8.null bs then return (front []) else loop (front . (bs:))- )+ where+ loop :: ([B8.ByteString] -> [B8.ByteString]) -> Sink BL.ByteString IO [B8.ByteString]+ loop front = await >>= maybe+ (return $ front [])+ (\x -> let bs = BL.toStrict x+ in if B8.null $ BL.toStrict x+ then return (front [])+ else loop (front . (bs:))+ ) getMimeList :: RunZim h => h -> IO MimeList getMimeList h = runZim h $ \hdl hdr -> do- let (pos, len) = (Just $ zimMimeListPos hdr, Nothing)- src = sourceHandleRange hdl pos len- mimeList <- src $$ parseByteStringsNul- return $ listArray (0, length mimeList) mimeList+ let (pos, len) = (Just $ zimMimeListPos hdr, Nothing)+ src = sourceHandleRange hdl pos len+ mimeList <- src $$ parseByteStringsNul+ return $ listArray (0, length mimeList) mimeList parseZimDirEnt :: Get ZimDirEnt parseZimDirEnt = do- mimeType <- fromIntegral <$> getWord16le :: Get Int- parmLen <- fromIntegral <$> getWord8- namespace <- chr . fromIntegral <$> getWord8- revision <- fromIntegral <$> getWord32le-- -- parsing of next 3 fields depends on mimeType- let deType = case mimeType of- 0xffff -> ZimRedirectEntry- 0xfffe -> ZimLinkTarget- 0xfffd -> ZimDeletedEntry- _ -> ZimArticleEntry- (redirectIndex, clusterNumber, blobNumber ) <-- case deType of- ZimArticleEntry ->- (\x y -> (Nothing, Just $ fromIntegral x, Just $ fromIntegral y))- <$> getWord32le <*> getWord32le- ZimRedirectEntry ->- (\x -> (Just $ fromIntegral x, Nothing, Nothing))- <$> getWord32le- ZimLinkTarget -> skip 8 >> return (Nothing, Nothing, Nothing)- ZimDeletedEntry -> skip 8 >> return (Nothing, Nothing, Nothing)- :: Get (Maybe Int, Maybe Int, Maybe Int)-- url <- BL.toStrict <$> getLazyByteStringNul- title <- BL.toStrict <$> getLazyByteStringNul- return $ ZimDirEnt deType mimeType parmLen namespace revision redirectIndex- clusterNumber blobNumber url- -- specs: title is same as url if title is empty- (if B.null title then url else title)+ mimeType <- fromIntegral <$> getWord16le+ parmLen <- fromIntegral <$> getWord8+ namespace <- chr . fromIntegral <$> getWord8+ revision <- fromIntegral <$> getWord32le+ let deType = getDEType mimeType+ (redirectIndex, clusterNumber, blobNumber) <- parseRedirectClusterBlob deType+ url <- BL.toStrict <$> getLazyByteStringNul+ title <- BL.toStrict <$> getLazyByteStringNul+ -- specs: title is same as url if title is empty+ let title'+ | B.null title = url+ | otherwise = title+ return $ ZimDirEnt deType mimeType parmLen namespace revision+ redirectIndex clusterNumber blobNumber url title'+ where+ getDEType mimeType = case mimeType of+ 0xffff -> ZimRedirectEntry+ 0xfffe -> ZimLinkTarget+ 0xfffd -> ZimDeletedEntry+ _ -> ZimArticleEntry+ offset = Just . fromIntegral+ parseRedirectClusterBlob deType = case deType of+ ZimArticleEntry -> (\x y -> (Nothing, offset x, offset y)) <$> getWord32le <*> getWord32le+ ZimRedirectEntry -> (\x -> (offset x, Nothing, Nothing )) <$> getWord32le+ ZimLinkTarget -> skip 8 >> return (Nothing, Nothing, Nothing)+ ZimDeletedEntry -> skip 8 >> return (Nothing, Nothing, Nothing) class ZimGetDE k where- getDE :: RunZim h => h -> k -> IO ZimDirEnt+ getDE :: RunZim h => h -> k -> IO ZimDirEnt instance ZimGetDE UrlIndex where- getDE h (UrlIndex i) = runZim h $ \hdl hdr -> do- let urlPtrPos = Just $ zimUrlPtrPos hdr + 8 * fromIntegral i- when (i < 0 || i >= zimArticleCount hdr) . throw $ ZimInvalidIndex i- dePos <- sourceHandleRange hdl urlPtrPos Nothing $$ sinkGet getWord64le- let srcDirEnt = sourceHandleRange hdl (Just $ fromIntegral dePos) Nothing- srcDirEnt $$ sinkGet parseZimDirEnt+ getDE h (UrlIndex i) = runZim h $ \hdl hdr -> do+ let urlPtrPos = zimUrlPtrPos hdr + 8 * toInteger i+ srcStart pos = sourceHandleRange hdl (Just $ fromIntegral pos) Nothing+ when (i < 0 || i >= zimArticleCount hdr) . throw $ ZimInvalidIndex i+ dePos <- srcStart urlPtrPos $$ sinkGet getWord64le+ srcStart dePos $$ sinkGet parseZimDirEnt instance ZimGetDE TitleIndex where- getDE h (TitleIndex i) = runZim h $ \hdl hdr -> do- let titlePtrPos = Just $ zimTitlePtrPos hdr + 4 * fromIntegral i- srcTitle = sourceHandleRange hdl titlePtrPos Nothing- when (i < 0 || i >= zimArticleCount hdr) . throw $ ZimInvalidIndex i- urlIndex <- srcTitle $$ sinkGet getWord32le- (hdl, hdr) `getDE` (UrlIndex $ fromIntegral urlIndex)+ getDE h (TitleIndex i) = runZim h $ \hdl hdr -> do+ let titlePtrPos = Just $ zimTitlePtrPos hdr + 4 * fromIntegral i+ srcTitle = sourceHandleRange hdl titlePtrPos Nothing+ when (i < 0 || i >= zimArticleCount hdr) . throw $ ZimInvalidIndex i+ urlIndex <- srcTitle $$ sinkGet getWord32le+ (hdl, hdr) `getDE` (UrlIndex $ fromIntegral urlIndex) getCluster :: RunZim h => h -> ClusterNumber -> IO Cluster getCluster h (ClusterNumber i) = runZim h $ \hdl hdr -> do- let limit = zimClusterCount hdr - 1- when (i < 0 || i > limit) . throw $ ZimInvalidIndex i- let clusterPos = Just $ zimClusterPtrPos hdr + 8 * fromIntegral i- src = sourceHandleRange hdl clusterPos Nothing- (pos0, pos1) <- src $$ sinkGet $ (,) <$> getWord64le <*> getWord64le- -- length of last cluster is determined by checksum pos instead of next cluster pos- let len = if i == limit- then fromIntegral (zimChecksumPos hdr) - pos0- else pos1 - pos0- toI = Just . fromIntegral- srcCluster = sourceHandleRange hdl (toI pos0) (toI len)- bs <- srcCluster $$ sinkGet getRemainingLazyByteString-- case BL.uncons bs of- Just (0, cluster) -> return $ Cluster cluster- Just (1, cluster) -> return $ Cluster cluster- Just (4, cluster) ->- Cluster <$> (runResourceT $ sourceLbs cluster $$ decompress Nothing =$ sinkLbs)- Just (x, _) -> throw . ZimParseError $- "Cluster " ++ show i ++- " (offset: " ++ showHex pos0 "" ++ ", length: " ++ show len ++- ") compressed with unsupported type: " ++ show x- Nothing -> throw . ZimParseError $- "Insufficient bytes for cluster " ++ show i+ let limit = zimClusterCount hdr - 1+ when (i < 0 || i > limit) . throw $ ZimInvalidIndex i+ let clusterPos = Just $ zimClusterPtrPos hdr + 8 * fromIntegral i+ src = sourceHandleRange hdl clusterPos Nothing+ (pos0, pos1) <- src $$ sinkGet $ (,) <$> getWord64le <*> getWord64le+ -- length of last cluster is determined by checksum pos instead of next cluster pos+ let+ len+ | i == limit = fromIntegral (zimChecksumPos hdr) - pos0+ | otherwise = pos1 - pos0+ toI = Just . fromIntegral+ srcCluster = sourceHandleRange hdl (toI pos0) (toI len)+ bs <- srcCluster $$ sinkGet getRemainingLazyByteString+ case BL.uncons bs of+ Just (0, cluster) -> return $ Cluster cluster+ Just (1, cluster) -> return $ Cluster cluster+ Just (4, cluster) -> return . Cluster $ decompress cluster+ Just (x, _) -> throw . ZimParseError $+ "Cluster " ++ show i ++ " (offset: " ++ showHex pos0 "" ++ ", length: " ++ show len ++ ") compressed with unsupported type: " ++ show x+ Nothing -> throw . ZimParseError $+ "Insufficient bytes for cluster " ++ show i getBlob :: RunZim h => h -> (ClusterNumber, BlobNumber) -> IO Blob getBlob h (c, BlobNumber b) = do- Cluster cluster <- h `getCluster` c- let src = sourceLbs (BL.drop (4 * fromIntegral b) cluster)- (pos0, pos1) <- src $$ sinkGet $ (,) <$> getWord32le <*> getWord32le- let len = pos1 - pos0- return . Blob . BL.take (fromIntegral len) $ BL.drop (fromIntegral pos0) cluster+ Cluster cluster <- h `getCluster` c+ let src = sourceLbs (BL.drop (4 * fromIntegral b) cluster)+ (pos0, pos1) <- src $$ sinkGet $ (,) <$> getWord32le <*> getWord32le+ let len = pos1 - pos0+ return . Blob $ getRange pos0 len cluster+ where+ getRange p l = BL.take (fromIntegral l) . BL.drop (fromIntegral p) -- | Returns URL of main page in ZIM. -- This URL can be used for redirecting to the actual page. getMainPageUrl :: RunZim h => h -> IO (Maybe Url) getMainPageUrl h = runZim h $ \hdl hdr ->- case zimMainPage hdr of- Nothing -> return Nothing- Just i -> do- de <- (hdl, hdr) `getDE` UrlIndex i- return . Just $ mkNsUrl (zimDeNamespace de) (zimDeUrl de)+ case zimMainPage hdr of+ Nothing -> return Nothing+ Just i -> do+ de <- (hdl, hdr) `getDE` UrlIndex i+ return . Just $ mkNsUrl (zimDeNamespace de) (zimDeUrl de) class ZimGetContent k where- -- | Get (MIME type, Content). Note that Content is lazy.- getContent :: RunZim h => h -> k -> IO (Maybe (B.ByteString, BL.ByteString))+ -- | Get (MIME type, Content). Note that Content is lazy.+ getContent :: RunZim h => h -> k -> IO (Maybe (B.ByteString, BL.ByteString)) instance ZimGetContent (MimeList, ZimDirEnt) where- getContent h (ml, de) = runZim h $ \hdl hdr -> do- case zimDeType de of- ZimRedirectEntry ->- let u = UrlIndex . fromJust $ zimDeRedirectIndex de- in (hdl, hdr) `getDE` u >>= ((hdl, hdr) `getContent`)-- ZimArticleEntry -> do- let (Just c, Just b) = (zimDeClusterNumber de, zimDeBlobNumber de)- content <- unBlob <$> (hdl, hdr) `getBlob` (ClusterNumber c, BlobNumber b)- return $ Just (ml ! zimDeMimeType de, content)-- _ ->- return $ Just (ml ! zimDeMimeType de, BL.empty)+ getContent h (ml, de) = runZim h $ \hdl hdr -> do+ case zimDeType de of+ ZimRedirectEntry -> do+ let u = UrlIndex . fromJust $ zimDeRedirectIndex de+ (hdl, hdr) `getDE` u >>= ((hdl, hdr) `getContent`)+ ZimArticleEntry -> do+ let (Just c, Just b) = (zimDeClusterNumber de, zimDeBlobNumber de)+ content <- unBlob <$> (hdl, hdr) `getBlob` (ClusterNumber c, BlobNumber b)+ return $ Just (ml ! zimDeMimeType de, content)+ _ -> return $ Just (ml ! zimDeMimeType de, BL.empty) instance ZimGetContent ZimDirEnt where- getContent h de = runZim h $ \hdl hdr -> do- ml <- getMimeList (hdl, hdr)- (hdl, hdr) `getContent` (ml, de)+ getContent h de = runZim h $ \hdl hdr -> do+ ml <- getMimeList (hdl, hdr)+ (hdl, hdr) `getContent` (ml, de) instance ZimGetContent (MimeList, Url) where- getContent h (ml, url) = runZim h $ \hdl hdr -> do- des <- (hdl, hdr) `searchDE` url- case des of- [] -> return Nothing- ((_, de) : _) -> (hdl, hdr) `getContent` (ml, de)+ getContent h (ml, url) = runZim h $ \hdl hdr -> do+ des <- (hdl, hdr) `searchDE` url+ case des of+ [] -> return Nothing+ ((_, de) : _) -> (hdl, hdr) `getContent` (ml, de) instance ZimGetContent Url where- getContent h url = runZim h $ \hdl hdr -> do- ml <- getMimeList (hdl, hdr)- (hdl, hdr) `getContent` (ml, url)+ getContent h url = runZim h $ \hdl hdr -> do+ ml <- getMimeList (hdl, hdr)+ (hdl, hdr) `getContent` (ml, url) instance ZimGetContent (MimeList, Title) where- getContent h (ml, title) = runZim h $ \hdl hdr -> do- des <- (hdl, hdr) `searchDE` title- case des of- [] -> return Nothing- ((_, de) : _) -> (hdl, hdr) `getContent` (ml, de)+ getContent h (ml, title) = runZim h $ \hdl hdr -> do+ des <- (hdl, hdr) `searchDE` title+ case des of+ [] -> return Nothing+ ((_, de) : _) -> (hdl, hdr) `getContent` (ml, de)+ instance ZimGetContent Title where- getContent h title = runZim h $ \hdl hdr -> do- ml <- getMimeList (hdl, hdr)- (hdl, hdr) `getContent` (ml, title)+ getContent h title = runZim h $ \hdl hdr -> do+ ml <- getMimeList (hdl, hdr)+ (hdl, hdr) `getContent` (ml, title) instance ZimGetContent (MimeList, UrlIndex) where- getContent h (ml, u) = runZim h $ \hdl hdr -> do- de <- (hdl, hdr) `getDE` u- (hdl, hdr) `getContent` (ml, de)+ getContent h (ml, u) = runZim h $ \hdl hdr -> do+ de <- (hdl, hdr) `getDE` u+ (hdl, hdr) `getContent` (ml, de)+ instance ZimGetContent UrlIndex where- getContent h u = runZim h $ \hdl hdr -> do- ml <- getMimeList (hdl, hdr)- (hdl, hdr) `getContent` (ml, u)+ getContent h u = runZim h $ \hdl hdr -> do+ ml <- getMimeList (hdl, hdr)+ (hdl, hdr) `getContent` (ml, u) instance ZimGetContent (MimeList, TitleIndex) where- getContent h (ml, t) = runZim h $ \hdl hdr -> do- de <- (hdl, hdr) `getDE` t- (hdl, hdr) `getContent` (ml, de)+ getContent h (ml, t) = runZim h $ \hdl hdr -> do+ de <- (hdl, hdr) `getDE` t+ (hdl, hdr) `getContent` (ml, de)+ instance ZimGetContent TitleIndex where- getContent h t = runZim h $ \hdl hdr -> do- ml <- getMimeList (hdl, hdr)- (hdl, hdr) `getContent` (ml, t)+ getContent h t = runZim h $ \hdl hdr -> do+ ml <- getMimeList (hdl, hdr)+ (hdl, hdr) `getContent` (ml, t) -- Binary Search implementation used for searching sorted URL and Title lists. binarySearch :: (Int -> IO (Ordering, a)) -> Int -> Int -> IO (Maybe a)-binarySearch f low high =- if high < low- then return Nothing- else do- let mid = (low + high) `div` 2- (o, x) <- f mid- case o of- LT -> binarySearch f low (mid -1)- GT -> binarySearch f (mid + 1) high- EQ -> return $ Just x+binarySearch f low high+ | high < low = return Nothing+ | otherwise = do+ let mid = (low + high) `div` 2+ (o, x) <- f mid+ case o of+ LT -> binarySearch f low (mid -1)+ GT -> binarySearch f (mid + 1) high+ EQ -> return $ Just x class ZimSearchDE k where- -- | Search for a Directory Entry on a RunZim.- -- When searching for a:- --- -- [@Url@] Returns either 0 (not found) or 1 element.- -- [@Title@] Returns either 0 (not found) or 1 element.- -- [@TitlePrefix@] Returns either 0 (not found) or 2 elements corresponding to lower and upper bound of titles containing the prefix.- --- searchDE :: RunZim h => h -> k -> IO [(Int, ZimDirEnt)]+ -- | Search for a Directory Entry on a RunZim.+ -- When searching for a:+ --+ -- [@Url@] Returns either 0 (not found) or 1 element.+ -- [@Title@] Returns either 0 (not found) or 1 element.+ -- [@TitlePrefix@] Returns either 0 (not found) or 2 elements corresponding to lower and upper bound of titles containing the prefix.+ --+ searchDE :: RunZim h => h -> k -> IO [(Int, ZimDirEnt)] instance ZimSearchDE Url where- searchDE h url = runZim h $ \hdl hdr -> do- let f i = do- de <- (hdl, hdr) `getDE` UrlIndex i- let v = mkNsUrl (zimDeNamespace de) (zimDeUrl de)- return (compare url v, (UrlIndex i, de))- res <- binarySearch f 0 (zimArticleCount hdr - 1)- return $ maybe [] (\(UrlIndex i, r) -> [(i, r)]) res+ searchDE h url = runZim h $ \hdl hdr -> do+ let+ f i = do+ de <- (hdl, hdr) `getDE` UrlIndex i+ let v = mkNsUrl (zimDeNamespace de) (zimDeUrl de)+ return (compare url v, (UrlIndex i, de))+ res <- binarySearch f 0 (zimArticleCount hdr - 1)+ return $ maybe [] (\(UrlIndex i, r) -> [(i, r)]) res instance ZimSearchDE Title where- searchDE h title = runZim h $ \hdl hdr -> do- let f i = do- de <- (hdl, hdr) `getDE` TitleIndex i- let v = mkNsTitle (zimDeNamespace de) (zimDeTitle de)- return (compare title v, (TitleIndex i, de))- res <- binarySearch f 0 (zimArticleCount hdr - 1)- return $ maybe [] (\(TitleIndex i, r) -> [(i, r)]) res+ searchDE h title = runZim h $ \hdl hdr -> do+ let+ f i = do+ de <- (hdl, hdr) `getDE` TitleIndex i+ let v = mkNsTitle (zimDeNamespace de) (zimDeTitle de)+ return (compare title v, (TitleIndex i, de))+ res <- binarySearch f 0 (zimArticleCount hdr - 1)+ return $ maybe [] (\(TitleIndex i, r) -> [(i, r)]) res instance ZimSearchDE TitlePrefix where- searchDE h (TitlePrefix pre) = runZim h $ \hdl hdr -> do- let preLen = B8.length pre - 2 -- minus namespace prefix- limit = zimArticleCount hdr - 1- -- extracts title to compare from Directory Entry- mkT x = mkNsTitle (zimDeNamespace x) (B8.take preLen (zimDeTitle x))- g idx = (\x -> (x, mkT x)) <$> (hdl, hdr) `getDE` idx- -- i has to be the entry just before prefix matches- lowerBound i = do- de <- (hdl, hdr) `getDE` TitleIndex i- case compare (Title pre) (mkT de) of- -- if prefix matches, we still return LT as we want to find the entry BEFORE.- -- special case: if i = 0, then this is the lower bound.- EQ -> if i == 0- then return (EQ, (TitleIndex i, de))- else return (LT, (TitleIndex i, de))- lgt -> do- -- if succeeding entry has prefix, that is the lower bound.- (de', Title v') <- g $ TitleIndex (i + 1)- if pre `B8.isPrefixOf` v'- then return (EQ, (TitleIndex $ i + 1, de'))- else return (lgt, (TitleIndex i, de))- upperBound i = do- de <- (hdl, hdr) `getDE` TitleIndex i- case compare (Title pre) (mkT de) of- EQ -> if i == limit- then return (EQ, (TitleIndex i, de))- else return (GT, (TitleIndex i, de))- lgt -> do- (de', Title v') <- g $ TitleIndex (i - 1)- if pre `B8.isPrefixOf` v'- then return (EQ, (TitleIndex $ i - 1, de'))- else return (lgt, (TitleIndex i, de))-- lb <- binarySearch lowerBound 0 limit- case lb of- Nothing -> return []- _ -> do- ub <- binarySearch upperBound 0 limit- let Just (TitleIndex lbi, lb') = lb- Just (TitleIndex ubi, ub') = ub- return [(lbi, lb'), (ubi, ub')]+ searchDE h (TitlePrefix pre) = runZim h $ \hdl hdr -> do+ let+ preLen = B8.length pre - 2 -- minus namespace prefix+ limit = zimArticleCount hdr - 1+ -- extracts title to compare from Directory Entry+ mkT x = mkNsTitle (zimDeNamespace x) (B8.take preLen (zimDeTitle x))+ g idx = (\x -> (x, mkT x)) <$> (hdl, hdr) `getDE` idx+ -- i has to be the entry just before prefix matches+ lowerBound i = do+ de <- (hdl, hdr) `getDE` TitleIndex i+ case compare (Title pre) (mkT de) of+ -- if prefix matches, we still return LT as we want to find the entry BEFORE.+ -- special case: if i = 0, then this is the lower bound.+ EQ | i == 0 -> return (EQ, (TitleIndex i, de))+ | otherwise -> return (LT, (TitleIndex i, de))+ lgt -> do+ -- if succeeding entry has prefix, that is the lower bound.+ (de', Title v') <- g $ TitleIndex (i + 1)+ if pre `B8.isPrefixOf` v'+ then return (EQ, (TitleIndex $ i + 1, de'))+ else return (lgt, (TitleIndex i, de))+ upperBound i = do+ de <- (hdl, hdr) `getDE` TitleIndex i+ case compare (Title pre) (mkT de) of+ EQ | i == limit -> return (EQ, (TitleIndex i, de))+ | otherwise -> return (GT, (TitleIndex i, de))+ lgt -> do+ (de', Title v') <- g $ TitleIndex (i - 1)+ if pre `B8.isPrefixOf` v'+ then return (EQ, (TitleIndex $ i - 1, de'))+ else return (lgt, (TitleIndex i, de)) + lb <- binarySearch lowerBound 0 limit+ case lb of+ Nothing -> return []+ _ -> do+ ub <- binarySearch upperBound 0 limit+ let Just (TitleIndex lbi, lb') = lb+ Just (TitleIndex ubi, ub') = ub+ return [(lbi, lb'), (ubi, ub')]
test/Codec/Archive/Zim/ParserSpec.hs view
@@ -2,7 +2,8 @@ {-# LANGUAGE FlexibleContexts #-} module Codec.Archive.Zim.ParserSpec (main, spec) where -import Control.Applicative ((<$>))+import Prelude ()+import Prelude.Compat import Control.Monad (forM_) import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL@@ -156,5 +157,3 @@ it "can get content from all URLs" $ \(hdl, hdr) -> do getAllArticles hdl hdr 457--
zim-parser.cabal view
@@ -1,27 +1,27 @@--- This file has been generated from package.yaml by hpack version 0.8.0.+-- This file has been generated from package.yaml by hpack version 0.14.1. -- -- see: https://github.com/sol/hpack -name: zim-parser-version: 0.2.0.0-synopsis: Read and parse ZIM files-description: zim-parser is a library to read and parse ZIM (http://openzim.org) files.- ZiM files contain offline web content (eg. Wikipedia) which can be browsed- locally without an Internet connection.-category: Codec-stability: alpha-homepage: https://github.com/robbinch/zim-parser#readme-bug-reports: https://github.com/robbinch/zim-parser/issues-author: Robbin C. <robbinch33@gmail.com>-maintainer: Robbin C. <robbinch33@gmail.com>-copyright: Copyright (c) 2015 Robbin C.-license: GPL-3-license-file: LICENSE-build-type: Simple-cabal-version: >= 1.10+name: zim-parser+version: 0.2.1.0+synopsis: Read and parse ZIM files+description: zim-parser is a library to read and parse ZIM (http://openzim.org) files.+ ZiM files contain offline web content (eg. Wikipedia) which can be browsed+ locally without an Internet connection.+category: Codec+stability: alpha+homepage: https://github.com/robbinch/zim-parser#readme+bug-reports: https://github.com/robbinch/zim-parser/issues+author: Robbin C. <robbinch33@gmail.com>+maintainer: Robbin C. <robbinch33@gmail.com>+copyright: Copyright (c) 2015 Robbin C.+license: GPL-3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10 extra-source-files:- test/wikipedia_en_ray_charles_2015-06.zim+ test/wikipedia_en_ray_charles_2015-06.zim source-repository head type: git@@ -29,41 +29,43 @@ library hs-source-dirs:- src+ src ghc-options: -Wall build-depends:- base == 4.*,- array,- binary,- bytestring,- resourcet,- conduit,- conduit-extra,- binary-conduit,- lzma-conduit+ base == 4.*+ , base-compat+ , array+ , binary+ , bytestring+ , conduit+ , conduit-extra+ , binary-conduit+ , lzma exposed-modules:- Codec.Archive.Zim.Parser+ Codec.Archive.Zim.Parser+ other-modules:+ Paths_zim_parser default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs:- src,- test+ src+ , test ghc-options: -Wall build-depends:- base == 4.*,- array,- binary,- bytestring,- resourcet,- conduit,- conduit-extra,- binary-conduit,- lzma-conduit,- hspec == 2.*+ base == 4.*+ , base-compat+ , array+ , binary+ , bytestring+ , conduit+ , conduit-extra+ , binary-conduit+ , lzma+ , hspec == 2.* other-modules:- Codec.Archive.Zim.Parser- Codec.Archive.Zim.ParserSpec+ Codec.Archive.Zim.Parser+ Codec.Archive.Zim.ParserSpec default-language: Haskell2010