zim-parser 0.1.0.0 → 0.2.0.0
raw patch · 3 files changed
+359/−270 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Codec.Archive.Zim.Parser: getZimBlob :: ZimHeader -> Handle -> Int -> Int -> IO ByteString
- Codec.Archive.Zim.Parser: getZimCluster :: ZimHeader -> Handle -> Int -> IO ByteString
- Codec.Archive.Zim.Parser: getZimContentByUrlIndex :: ZimHeader -> Handle -> Int -> IO ByteString
- Codec.Archive.Zim.Parser: getZimDirEntByTitleIndex :: ZimHeader -> Handle -> Int -> IO ZimDirEnt
- Codec.Archive.Zim.Parser: getZimDirEntByUrlIndex :: ZimHeader -> Handle -> Int -> IO ZimDirEnt
- Codec.Archive.Zim.Parser: getZimHeader :: Handle -> IO ZimHeader
- Codec.Archive.Zim.Parser: getZimMainPageUrl :: FilePath -> IO (Maybe ByteString)
- Codec.Archive.Zim.Parser: getZimMimeList :: ZimHeader -> Handle -> IO (Array Int ByteString)
- Codec.Archive.Zim.Parser: getZimUrlContent :: FilePath -> ByteString -> IO (Maybe (ByteString, ByteString))
- Codec.Archive.Zim.Parser: searchZimDirEntByTitle :: ZimHeader -> Handle -> Char -> ByteString -> IO (Maybe (Int, ZimDirEnt))
- Codec.Archive.Zim.Parser: searchZimDirEntByTitlePrefix :: ZimHeader -> Handle -> Char -> ByteString -> IO (Maybe ((Int, ZimDirEnt), (Int, ZimDirEnt)))
- Codec.Archive.Zim.Parser: searchZimDirEntByUrl :: ZimHeader -> Handle -> ByteString -> IO (Maybe (Int, ZimDirEnt))
+ Codec.Archive.Zim.Parser: Blob :: ByteString -> Blob
+ Codec.Archive.Zim.Parser: BlobNumber :: Int -> BlobNumber
+ Codec.Archive.Zim.Parser: Cluster :: ByteString -> Cluster
+ Codec.Archive.Zim.Parser: ClusterNumber :: Int -> ClusterNumber
+ Codec.Archive.Zim.Parser: TitleIndex :: Int -> TitleIndex
+ Codec.Archive.Zim.Parser: Url :: ByteString -> Url
+ Codec.Archive.Zim.Parser: UrlIndex :: Int -> UrlIndex
+ Codec.Archive.Zim.Parser: [unBlob] :: Blob -> ByteString
+ Codec.Archive.Zim.Parser: [unCluster] :: Cluster -> ByteString
+ Codec.Archive.Zim.Parser: class RunZim h
+ Codec.Archive.Zim.Parser: class ZimGetContent k
+ Codec.Archive.Zim.Parser: class ZimGetDE k
+ Codec.Archive.Zim.Parser: class ZimSearchDE k
+ Codec.Archive.Zim.Parser: data Title
+ Codec.Archive.Zim.Parser: data TitlePrefix
+ Codec.Archive.Zim.Parser: getBlob :: RunZim h => h -> (ClusterNumber, BlobNumber) -> IO Blob
+ Codec.Archive.Zim.Parser: getCluster :: RunZim h => h -> ClusterNumber -> IO Cluster
+ Codec.Archive.Zim.Parser: getContent :: (ZimGetContent k, RunZim h) => h -> k -> IO (Maybe (ByteString, ByteString))
+ Codec.Archive.Zim.Parser: getDE :: (ZimGetDE k, RunZim h) => h -> k -> IO ZimDirEnt
+ Codec.Archive.Zim.Parser: getHeader :: RunZim h => h -> IO ZimHeader
+ Codec.Archive.Zim.Parser: getMainPageUrl :: RunZim h => h -> IO (Maybe Url)
+ Codec.Archive.Zim.Parser: getMimeList :: RunZim h => h -> IO MimeList
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.RunZim (GHC.IO.Handle.Types.Handle, Codec.Archive.Zim.Parser.ZimHeader)
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.RunZim GHC.IO.FilePath
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.RunZim GHC.IO.Handle.Types.Handle
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimGetContent (Codec.Archive.Zim.Parser.MimeList, Codec.Archive.Zim.Parser.Title)
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimGetContent (Codec.Archive.Zim.Parser.MimeList, Codec.Archive.Zim.Parser.TitleIndex)
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimGetContent (Codec.Archive.Zim.Parser.MimeList, Codec.Archive.Zim.Parser.Url)
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimGetContent (Codec.Archive.Zim.Parser.MimeList, Codec.Archive.Zim.Parser.UrlIndex)
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimGetContent (Codec.Archive.Zim.Parser.MimeList, Codec.Archive.Zim.Parser.ZimDirEnt)
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimGetContent Codec.Archive.Zim.Parser.Title
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimGetContent Codec.Archive.Zim.Parser.TitleIndex
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimGetContent Codec.Archive.Zim.Parser.Url
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimGetContent Codec.Archive.Zim.Parser.UrlIndex
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimGetContent Codec.Archive.Zim.Parser.ZimDirEnt
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimGetDE Codec.Archive.Zim.Parser.TitleIndex
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimGetDE Codec.Archive.Zim.Parser.UrlIndex
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimSearchDE Codec.Archive.Zim.Parser.Title
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimSearchDE Codec.Archive.Zim.Parser.TitlePrefix
+ Codec.Archive.Zim.Parser: instance Codec.Archive.Zim.Parser.ZimSearchDE Codec.Archive.Zim.Parser.Url
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Eq Codec.Archive.Zim.Parser.BlobNumber
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Eq Codec.Archive.Zim.Parser.ClusterNumber
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Eq Codec.Archive.Zim.Parser.Title
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Eq Codec.Archive.Zim.Parser.TitleIndex
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Eq Codec.Archive.Zim.Parser.TitlePrefix
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Eq Codec.Archive.Zim.Parser.Url
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Eq Codec.Archive.Zim.Parser.UrlIndex
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Ord Codec.Archive.Zim.Parser.BlobNumber
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Ord Codec.Archive.Zim.Parser.ClusterNumber
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Ord Codec.Archive.Zim.Parser.Title
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Ord Codec.Archive.Zim.Parser.TitleIndex
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Ord Codec.Archive.Zim.Parser.TitlePrefix
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Ord Codec.Archive.Zim.Parser.Url
+ Codec.Archive.Zim.Parser: instance GHC.Classes.Ord Codec.Archive.Zim.Parser.UrlIndex
+ Codec.Archive.Zim.Parser: instance GHC.Show.Show Codec.Archive.Zim.Parser.BlobNumber
+ Codec.Archive.Zim.Parser: instance GHC.Show.Show Codec.Archive.Zim.Parser.ClusterNumber
+ Codec.Archive.Zim.Parser: instance GHC.Show.Show Codec.Archive.Zim.Parser.Title
+ Codec.Archive.Zim.Parser: instance GHC.Show.Show Codec.Archive.Zim.Parser.TitleIndex
+ Codec.Archive.Zim.Parser: instance GHC.Show.Show Codec.Archive.Zim.Parser.TitlePrefix
+ Codec.Archive.Zim.Parser: instance GHC.Show.Show Codec.Archive.Zim.Parser.Url
+ Codec.Archive.Zim.Parser: instance GHC.Show.Show Codec.Archive.Zim.Parser.UrlIndex
+ Codec.Archive.Zim.Parser: mkNsTitle :: Char -> ByteString -> Title
+ Codec.Archive.Zim.Parser: mkNsTitlePrefix :: Char -> ByteString -> TitlePrefix
+ Codec.Archive.Zim.Parser: mkNsUrl :: Char -> ByteString -> Url
+ Codec.Archive.Zim.Parser: newtype Blob
+ Codec.Archive.Zim.Parser: newtype BlobNumber
+ Codec.Archive.Zim.Parser: newtype Cluster
+ Codec.Archive.Zim.Parser: newtype ClusterNumber
+ Codec.Archive.Zim.Parser: newtype TitleIndex
+ Codec.Archive.Zim.Parser: newtype Url
+ Codec.Archive.Zim.Parser: newtype UrlIndex
+ Codec.Archive.Zim.Parser: searchDE :: (ZimSearchDE k, RunZim h) => h -> k -> IO [(Int, ZimDirEnt)]
+ Codec.Archive.Zim.Parser: type MimeList = Array Int ByteString
Files
- src/Codec/Archive/Zim/Parser.hs +287/−202
- test/Codec/Archive/Zim/ParserSpec.hs +71/−67
- zim-parser.cabal +1/−1
src/Codec/Archive/Zim/Parser.hs view
@@ -10,16 +10,34 @@ -- contain offline web content (eg, Wikipedia) which can be browsed locally -- without an Internet connection. ----- The high-level functions can be used if it is not a problem to re-open and close--- the ZIM file on each invocation. For simple browsing on a local device, this--- should suffice. This also works if the underlying ZIM file is changing.+-- The API is meant to be intuitive for normal use-cases. ----- The other functions can be used if the caller opts to have more control over--- resource management.+-- To get content for "A/index.htm" from ZIM file "file.zim": ----- Behind the scenes, conduit is used to read from files so memory usage should--- be constant.+-- > > mimeContent <- "file.zim" `getContent` Url "A/index.htm"+-- > > :t mimeContent+-- > mimeContent :: Maybe (B8.ByteString, BL.ByteString)+-- > > print mimeContent+-- > Just ("text/html", "<html><head>...</html>") --+-- The above will open the file, parse the ZIM header, lookup the+-- MIME type and content of the URL, close the file and return the MIME type and+-- content as a pair. Note that content is a lazy bytestring.+--+-- The above operation should suffice for a simple webserver serving a ZIM file.+-- For finer control, it is possible to cache and reuse the file handle and the+-- ZIM header.+--+-- > > hdl <- openBinaryFile "file.zim" ReadMode+-- > > hdr <- getHeader hdl+-- > > :t hdr+-- > hdr :: ZimHeader+-- > > (hdl, hdr) `getContent` Url "A/index.htm"+-- > Just ("text/html", "<html><head>...</html>")+--+-- ZIM files of Wikimedia Foundation (Wikipedia, Wikibooks, etc) can be+-- found at http://ftpmirror.your.org/pub/kiwix/zim.+-- -- Below is a full example of a Scotty web server that serves a ZIM file -- (specified on command line) on localhost port 3000: --@@ -31,7 +49,7 @@ -- > import System.Environment (getArgs) -- > import Network.HTTP.Types.Status (status404) -- > import Web.Scotty--- > import Codec.Archive.Zim.Parser (getZimMainPageUrl, getZimUrlContent)+-- > import Codec.Archive.Zim.Parser (getMainPageUrl, getContent, Url(..)) -- > -- > main :: IO () -- > main = do@@ -43,17 +61,17 @@ -- > -- > redirectToZimMainPage :: FilePath -> ActionM () -- > redirectToZimMainPage fp = do--- > res <- liftIO $ getZimMainPageUrl fp+-- > res <- liftIO $ getMainPageUrl fp -- > case res of -- > Nothing -> do -- > status status404 -- > text "This ZIM file has no main page specified!"--- > Just url -> redirect . fromStrict $ decodeUtf8 url+-- > Just (Url url) -> redirect . fromStrict $ decodeUtf8 url -- > -- > serveZimUrl :: FilePath -> ActionM () -- > serveZimUrl fp = do -- > url <- (encodeUtf8 . toStrict) <$> param "1"--- > res <- liftIO $ getZimUrlContent fp url+-- > res <- liftIO $ fp `getContent` Url url -- > case res of -- > Nothing -> do -- > liftIO . putStrLn $ "Invalid URL: " ++ show url@@ -66,33 +84,45 @@ -- -- Feedback and contributions are welcome on <http://github.com/robbinch/zim-parser>. -+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+ module Codec.Archive.Zim.Parser (- -- * High-level Functions- -- | The following high-level functions are sufficient to program a simple webserver that serves ZIM files (see example above).- getZimMainPageUrl- , getZimUrlContent- -- * Searching- , searchZimDirEntByUrl- , searchZimDirEntByTitle- , searchZimDirEntByTitlePrefix+ -- * Functions+ getHeader+ , getMimeList+ , getDE+ , getMainPageUrl+ , getCluster+ , getBlob+ , getContent+ , searchDE+ , MimeList+ , mkNsTitle+ , mkNsTitlePrefix+ , mkNsUrl+ , RunZim+ , ZimGetDE+ , ZimSearchDE+ , ZimGetContent -- * Exceptions , ZimException(..) -- * ZIM Header , ZimHeader(..)- , getZimHeader- , getZimMimeList -- * ZIM Directory Entry , ZimDirEntType(..) , ZimDirEnt(..)- , getZimDirEntByUrlIndex- , getZimDirEntByTitleIndex- -- * ZIM Content- , getZimCluster- , getZimBlob- , getZimContentByUrlIndex+ , 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.@@ -254,18 +284,41 @@ -- , zimDeParameter :: BL.ByteString -- unused } deriving (Eq, Show) --- | Parses ZIM Header from a file handle.--- A ZIM Header is used by most of the functions in this module.--- For better performance or resource management, multiple file handles--- can be opened with the same ZIM header in order to call--- functions in parallel.--- If the underlying ZIM file has changed, a new ZIM header should be parsed.-getZimHeader :: Handle -- ^ Handle to ZIM file (eg. previously returned from 'withBinaryFile')- -> IO ZimHeader -- ^ Returns ZIM Header-getZimHeader hdl = src $$ sinkGet parseZimHeader- where (pos, len) = (Just 0, Just 80)- src = sourceHandleRange hdl pos len+-- | List of Mime Types+type MimeList = Array Int B8.ByteString +-- | Wrapper for URL index+newtype UrlIndex = UrlIndex Int deriving (Eq, Ord, Show)+-- | Wrapper for Title index+newtype TitleIndex = TitleIndex Int deriving (Eq, Ord, Show)+-- | Wrapper for Cluster number+newtype ClusterNumber = ClusterNumber Int deriving (Eq, Ord, Show)+-- | Wrapper for Blob number+newtype BlobNumber = BlobNumber Int deriving (Eq, Ord, Show)++-- | Wrapper for Url+newtype Url = Url B.ByteString deriving (Eq, Ord, Show)+-- | Construct a Url with a Namespace.+mkNsUrl :: Char -> B.ByteString -> Url+mkNsUrl c s = Url $ c `B8.cons` '/' `B8.cons` s++-- | Wrapper for Title+newtype Title = Title B.ByteString deriving (Eq, Ord, Show)+-- | Construct a Title with a Namespace.+mkNsTitle :: Char -> B.ByteString -> Title+mkNsTitle c s = Title $ c `B8.cons` '/' `B8.cons` s++-- | Wrapper for Title Prefix+newtype TitlePrefix = TitlePrefix B.ByteString deriving (Eq, Ord, Show)+-- | Construct a TitlePrefix with a Namespace.+mkNsTitlePrefix :: Char -> B.ByteString -> TitlePrefix+mkNsTitlePrefix c s = TitlePrefix $ c `B8.cons` '/' `B8.cons` s++-- | Wrapper for Cluster+newtype Cluster = Cluster {unCluster :: BL.ByteString}+-- | Wrapper for Blob+newtype Blob = Blob {unBlob :: BL.ByteString}+ parseZimHeader :: Get ZimHeader parseZimHeader = do magicNumber <- fromIntegral <$> getWord32le@@ -287,16 +340,26 @@ (if layoutPage == 0xffffffff then Nothing else Just layoutPage) checksumPos --- | Parses MIME List from a ZIM header and a file handle.-getZimMimeList :: ZimHeader -- ^ ZIM header- -> Handle -- ^ Handle to ZIM file- -> IO (Array Int B8.ByteString) -- ^ Returns array of MIME types-getZimMimeList hdr hdl = do- mimeList <- src $$ parseByteStringsNul- return $ listArray (0, length mimeList) mimeList- where (pos, len) = (Just $ zimMimeListPos hdr, Nothing)- src = sourceHandleRange hdl pos len+-- | 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 +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++instance RunZim (Handle, ZimHeader) where+ runZim x f = uncurry f x++instance RunZim FilePath where+ runZim fp f = withBinaryFile fp ReadMode $ \hdl -> runZim hdl f++getHeader :: RunZim h => h -> IO ZimHeader+getHeader h = runZim h $ \_ hdr -> return hdr+ -- Parses a list of null-terminated byte sequence. -- Last entry is zero length (end of block is always 2 null bytes). parseByteStringsNul :: Sink B8.ByteString IO [B8.ByteString]@@ -308,17 +371,12 @@ in if B8.null bs then return (front []) else loop (front . (bs:)) ) --- | Returns Directory Entry corresponding to URL index.-getZimDirEntByUrlIndex :: ZimHeader -- ^ ZIM header- -> Handle -- ^ Handle to ZIM file- -> Int -- ^ URL index- -> IO ZimDirEnt -- ^ Returns a Directory Entry-getZimDirEntByUrlIndex hdr hdl i = 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+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 parseZimDirEnt :: Get ZimDirEnt parseZimDirEnt = do@@ -352,25 +410,27 @@ -- specs: title is same as url if title is empty (if B.null title then url else title) --- | Returns Directory Entry corresponding to Title index.-getZimDirEntByTitleIndex :: ZimHeader -- ^ ZIM header- -> Handle -- ^ Handle to ZIM file- -> Int -- ^ Title index- -> IO ZimDirEnt -- ^ Returns a Directory Entry-getZimDirEntByTitleIndex hdr hdl i = do- when (i < 0 || i >= zimArticleCount hdr) . throw $ ZimInvalidIndex i- urlIndex <- srcTitle $$ sinkGet getWord32le- getZimDirEntByUrlIndex hdr hdl (fromIntegral urlIndex)- where titlePtrPos = Just $ zimTitlePtrPos hdr + 4 * fromIntegral i- srcTitle = sourceHandleRange hdl titlePtrPos Nothing+class ZimGetDE k where+ getDE :: RunZim h => h -> k -> IO ZimDirEnt --- | Returns (decompressed) Cluster corresponding to Cluster number.--- This can throw ErrorCall if there is an error during decompression.-getZimCluster :: ZimHeader -- ^ ZIM header- -> Handle -- ^ Handle to ZIM file- -> Int -- ^ Cluster number- -> IO BL.ByteString -- ^ Returns a lazy bytestring containing cluster-getZimCluster hdr hdl i = do+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++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)++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@@ -378,16 +438,17 @@ (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+ 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- Just (1, cluster) -> return cluster- Just (4, cluster) -> runResourceT $ sourceLbs cluster $$ decompress Nothing =$ sinkLbs+ 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 ++@@ -395,32 +456,89 @@ Nothing -> throw . ZimParseError $ "Insufficient bytes for cluster " ++ show i --- | Returns Blob given Cluster and Blob number.-getZimBlob :: ZimHeader -- ^ ZIM header- -> Handle -- ^ Handle to ZIM file- -> Int -- ^ Cluster Number- -> Int -- ^ Blob Number- -> IO BL.ByteString -- ^ Returns a lazy bytestring containing blob-getZimBlob hdr hdl c b = do- cluster <- getZimCluster hdr hdl c+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 . BL.take (fromIntegral len) $ BL.drop (fromIntegral pos0) cluster+ return . Blob . BL.take (fromIntegral len) $ BL.drop (fromIntegral pos0) cluster --- | Returns content given URL index. Redirects are handled automatically-getZimContentByUrlIndex :: ZimHeader -- ^ ZIM header- -> Handle -- ^ Handle to ZIM file- -> Int -- ^ URL index- -> IO BL.ByteString -- ^ Returns a lazy bytestring containing content-getZimContentByUrlIndex hdr hdl i = do- de <- getZimDirEntByUrlIndex hdr hdl i- case zimDeType de of- ZimRedirectEntry -> getZimContentByUrlIndex hdr hdl (fromJust $ zimDeRedirectIndex de)- ZimArticleEntry -> let (Just c, Just b) = (zimDeClusterNumber de, zimDeBlobNumber de)- in getZimBlob hdr hdl c b- _ -> return BL.empty+-- | 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) +class ZimGetContent k where+ -- | 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)++instance ZimGetContent ZimDirEnt where+ 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)++instance ZimGetContent Url where+ 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)+instance ZimGetContent Title where+ 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)+instance ZimGetContent UrlIndex where+ 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)+instance ZimGetContent TitleIndex where+ 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 =@@ -434,107 +552,74 @@ GT -> binarySearch f (mid + 1) high EQ -> return $ Just x --- | Search for a Directory Entry given a URL.--- URL must be prefixed with Namespace (eg. "A\/Blue.html" or "I\/favicon.png").-searchZimDirEntByUrl :: ZimHeader -- ^ ZIM header- -> Handle -- ^ Handle to ZIM file- -> B.ByteString -- ^ URL to search for- -> IO (Maybe (Int, ZimDirEnt)) -- ^ Returns (URL Index, Directory Entry) if found.-searchZimDirEntByUrl hdr hdl url =- binarySearch f 0 (zimArticleCount hdr - 1)- -- prepend namespace when comparing URLs- where f i = do- de <- getZimDirEntByUrlIndex hdr hdl i- let v = zimDeNamespace de `B8.cons` '/' `B8.cons` zimDeUrl de- return (compare url v, (i, de))+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 given a Title and namespace.-searchZimDirEntByTitle :: ZimHeader -- ^ ZIM header- -> Handle -- ^ Handle to ZIM file- -> Char -- ^ Namespace to search for- -> B.ByteString -- ^ Title to search for- -> IO (Maybe (Int, ZimDirEnt)) -- ^ Returns (Title Index, Directory Entry) if found-searchZimDirEntByTitle hdr hdl n title =- binarySearch f 0 (zimArticleCount hdr - 1)- where title' = n `B8.cons` '/' `B8.cons` title- f i = do- de <- getZimDirEntByTitleIndex hdr hdl i- let v = zimDeNamespace de `B8.cons` '/' `B8.cons` zimDeTitle de- return (compare title' v, (i, de))+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 --- | Search for lower and upper bounds of Title indices that contains prefix in their title.--- Eg, if title list comprises \[ \"A\", \"Ba\", \"Bb\", \"Bc\", \"C\" \] prefix--- search for \"B\" will return bounds corresponding to (\"Ba\", \"Bc\").-searchZimDirEntByTitlePrefix :: ZimHeader -- ^ ZIM header- -> Handle -- ^ Handle to ZIM file- -> Char -- ^ Namespace- -> B.ByteString -- ^ Title Prefix- -> IO (Maybe ((Int, ZimDirEnt), (Int, ZimDirEnt))) -- ^ Returns ((Lower Title Index, Lower Directory Entry), (Upper Title Index, Upper Directory Entry)) if found.-searchZimDirEntByTitlePrefix hdr hdl n pre = do- lb <- binarySearch lowerBound 0 limit- case lb of- Nothing -> return Nothing- _ -> do- ub <- binarySearch upperBound 0 limit- return . Just $ (fromJust lb, fromJust ub)- where pre' = n `B8.cons` '/' `B8.cons` pre- preLen = B8.length pre- limit = zimArticleCount hdr - 1- -- extracts title to compare from Directory Entry- mkT x = zimDeNamespace x `B8.cons` '/' `B8.cons` B8.take preLen (zimDeTitle x)- g idx = (\x -> (x, mkT x)) <$> getZimDirEntByTitleIndex hdr hdl idx- -- i has to be the entry just before prefix matches- lowerBound i = do- de <- getZimDirEntByTitleIndex hdr hdl i- case compare 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, (i, de))- else return (LT, (i, de))- lgt -> do- -- if succeeding entry has prefix, that is the lower bound.- (de', v') <- g (i + 1)- if pre' `B8.isPrefixOf` v'- then return (EQ, (i + 1, de'))- else return (lgt, (i, de))- upperBound i = do- de <- getZimDirEntByTitleIndex hdr hdl i- case compare pre' (mkT de) of- EQ -> if i == limit- then return (EQ, (i, de))- else return (GT, (i, de))- lgt -> do- (de', v') <- g (i - 1)- if pre' `B8.isPrefixOf` v'- then return (EQ, (i - 1, de'))- else return (lgt, (i, de))+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 --- | Returns URL of main page in ZIM.--- This URL can be used for redirecting to the actual page.-getZimMainPageUrl :: FilePath -- ^ Path to ZIM file- -> IO (Maybe B.ByteString) -- ^ Returns URL if found-getZimMainPageUrl fp = do- withBinaryFile fp ReadMode $ \hdl -> do- hdr <- getZimHeader hdl- case zimMainPage hdr of- Nothing -> return Nothing- Just i -> do- de <- getZimDirEntByUrlIndex hdr hdl i- return . Just $ zimDeNamespace de `B8.cons` '/' `B8.cons` zimDeUrl de+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)) --- | Returns (MIME type, content) of URL, ready to be served via HTTP.--- Note that MIME type is a strict bytestring while Content is lazy.-getZimUrlContent :: FilePath -- ^ Path to ZIM file- -> B.ByteString -- ^ URL- -> IO (Maybe (B.ByteString, BL.ByteString)) -- ^ Returns (MIME type, content) if found-getZimUrlContent fp url = do- withBinaryFile fp ReadMode $ \hdl -> do- hdr <- getZimHeader hdl- res <- searchZimDirEntByUrl hdr hdl url- case res of- Nothing -> return Nothing- Just (i, de) -> do- mimeList <- getZimMimeList hdr hdl- content <- getZimContentByUrlIndex hdr hdl i- return $ Just (mimeList ! zimDeMimeType de, content)+ 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
@@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-} module Codec.Archive.Zim.ParserSpec (main, spec) where +import Control.Applicative ((<$>)) import Control.Monad (forM_) import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL@@ -19,138 +21,140 @@ main :: IO () main = hspec spec -setup :: IO (ZimHeader, Handle)+setup :: IO (Handle, ZimHeader) setup = do small <- openBinaryFile testSmallFilePath ReadMode- smallZim <- getZimHeader small- return (smallZim, small)+ smallZim <- getHeader small+ return (small, smallZim) spec :: Spec spec = do describe "zim" $ do beforeAll setup $ do - it "can open Ray Charles ZIM" $ \(smallZim, _) -> do+ it "can open Ray Charles ZIM" $ \(_, smallZim) -> do zimMagicNumber smallZim `shouldBe` 72173914 - it "can get version" $ \(smallZim, _) -> do+ it "can get version" $ \(_, smallZim) -> do zimVersion smallZim `shouldBe` 5 - it "can get article count" $ \(smallZim, _) -> do+ it "can get article count" $ \(_, smallZim) -> do zimArticleCount smallZim `shouldBe` 458 - it "can get cluster count" $ \(smallZim, _) -> do+ it "can get cluster count" $ \(_, smallZim) -> do zimClusterCount smallZim `shouldBe` 215 - it "can parse MIME list" $ \(smallZim, small) -> do- mimeList <- getZimMimeList smallZim small+ it "can parse MIME list" $ \h -> do+ mimeList <- getMimeList h mimeList ! 0 `shouldBe` "application/javascript" bounds mimeList `shouldBe` (0, 9) - it "can get main page" $ \(smallZim, _) -> do+ it "can get main page" $ \(_, smallZim) -> do zimMainPage smallZim `shouldBe` Just 238 it "can get main page URL" $ \_ -> do- url <- getZimMainPageUrl testSmallFilePath- url `shouldBe` Just "A/index.htm"+ url <- getMainPageUrl testSmallFilePath+ url `shouldBe` Just (Url "A/index.htm") - it "can lookup directory entry by URL index" $ \(smallZim, small) -> do- de <- getZimDirEntByUrlIndex smallZim small 0+ it "can lookup directory entry by URL index" $ \h -> do+ de <- h `getDE` UrlIndex 0 zimDeType de `shouldBe` ZimRedirectEntry zimDeUrl de `shouldBe` "favicon" - it "can lookup directory entry by Title index" $ \(smallZim, small) -> do- de <- getZimDirEntByTitleIndex smallZim small 3+ it "can lookup directory entry by Title index" $ \h -> do+ de <- h `getDE` TitleIndex 3 zimDeTitle de `shouldBe` "(The Night Time Is) The Right Time" zimDeNamespace de `shouldBe` 'A' - it "can lookup cluster 0" $ \(smallZim, small) -> do- cluster <- getZimCluster smallZim small 0+ it "can lookup cluster 0" $ \h -> do+ cluster <- unCluster <$> h `getCluster` ClusterNumber 0 BL.length cluster `shouldBe` 2160083 - it "can get cluster 2 blob 0" $ \(smallZim, small) -> do- blob <- getZimBlob smallZim small 2 0+ it "can get cluster 2 blob 0" $ \h -> do+ Blob blob <- h `getBlob` (ClusterNumber 2, BlobNumber 0) BL.take 4 blob `shouldBe` "\137PNG" - it "can get content for article 11" $ \(smallZim, small) -> do- bs <- getZimContentByUrlIndex smallZim small 11- BL.take 12 bs `shouldBe` "<html><head>"+ it "can get blob for article 11" $ \h -> do+ bs <- h `getContent` UrlIndex 11+ BL.take 12 (snd $ fromJust bs) `shouldBe` "<html><head>" - it "can search for title" $ \(smallZim, small) -> do+ it "can search for title" $ \h -> do let title = B8.pack "(The Night Time Is) The Right Time"- res <- searchZimDirEntByTitle smallZim small 'A' title- (title, res) `shouldSatisfy` (isJust . snd)- (fst . fromJust $ res) `shouldBe` 3+ res <- h `searchDE` mkNsTitle 'A' title+ length res `shouldBe` 1+ (fst . head) res `shouldBe` 3 - it "can search for non-existent title" $ \(smallZim, small) -> do+ it "can search for non-existent title" $ \h -> do let title = B8.pack "nonexistent-title"- res <- searchZimDirEntByTitle smallZim small 'A' title- (title, res) `shouldBe` (title, Nothing)+ res <- h `searchDE` mkNsTitle 'z' title+ length res `shouldBe` 0 - it "can search for title prefix" $ \(smallZim, small) -> do+ it "can search for title prefix" $ \h -> do let title = B8.pack "Blue"- res <- searchZimDirEntByTitlePrefix smallZim small 'A' title- (title, res) `shouldSatisfy` (isJust . snd)- let Just ((lb, _), (ub, _)) = res+ res <- h `searchDE` mkNsTitlePrefix 'A' title+ length res `shouldBe` 2+ let [(lb, _), (ub, _)] = res (lb, ub) `shouldBe` (22, 25) - it "can search for non-existent title prefix" $ \(smallZim, small) -> do+ it "can search for non-existent title prefix" $ \h -> do let title = B8.pack "ZZZ"- res <- searchZimDirEntByTitlePrefix smallZim small 'A' title- (title, res) `shouldBe` (title, Nothing)+ res <-h `searchDE` mkNsTitlePrefix 'A' title+ length res `shouldBe` 0 - it "can search for first title prefix" $ \(smallZim, small) -> do+ it "can search for first title prefix" $ \h -> do let title = B8.pack "fav"- res <- searchZimDirEntByTitlePrefix smallZim small '-' title- (title, res) `shouldSatisfy` (isJust . snd)- let Just ((lb, _), (ub, _)) = res+ res <- h `searchDE` mkNsTitlePrefix '-' title+ length res `shouldBe` 2+ let [(lb, _), (ub, _)] = res (lb, ub) `shouldBe` (0, 0) - it "can search for last title prefix" $ \(smallZim, small) -> do+ it "can search for last title prefix" $ \h -> do let title = B8.pack "Title"- res <- searchZimDirEntByTitlePrefix smallZim small 'M' title- (title, res) `shouldSatisfy` (isJust . snd)- let Just ((lb, _), (ub, _)) = res+ res <- h `searchDE` mkNsTitlePrefix 'M' title+ length res `shouldBe` 2+ let [(lb, _), (ub, _)] = res (lb, ub) `shouldBe` (457, 457) - it "can search for URLs" $ \(smallZim, small) -> do+ it "can search for URLs" $ \h -> do let url = "A/A_Fool_for_You.html"- res <- searchZimDirEntByUrl smallZim small url- (url, res) `shouldSatisfy` (isJust . snd)- (fst . fromJust $ res) `shouldBe` 4+ res <- h `searchDE` Url url+ length res `shouldBe` 1+ let [(r, _)] = res+ r `shouldBe` 4 - it "can search for non-existent URL" $ \(smallZim, small) -> do+ it "can search for non-existent URL" $ \h -> do let url = "a/zzz.html"- res <- searchZimDirEntByUrl smallZim small url- res `shouldBe` Nothing+ res <- h `searchDE` Url url+ length res `shouldBe` 0 it "can get (mimetype, content)" $ \_ -> do- res <- getZimUrlContent testSmallFilePath "A/index.htm"+ res <- testSmallFilePath `getContent` Url "A/index.htm" res `shouldSatisfy` isJust let Just (m, c) = res (m, BL.length c) `shouldBe` ("text/html", 8637) - let searchAllUrls hdr hdl des =+ let searchAllUrls hdl hdr des = forM_ des $ \de -> do let ns = zimDeNamespace de url = zimDeUrl de- url' = ns `B8.cons` '/' `B8.cons` url- res <- searchZimDirEntByUrl hdr hdl url'- (url, res) `shouldSatisfy` (isJust . snd)- (zimDeUrl . snd . fromJust $ res) `shouldBe` url- getAllArticles hdr hdl n = do+ url' = mkNsUrl ns url+ res <- (hdl, hdr) `searchDE` url'+ length res `shouldBe` 1+ (zimDeUrl . snd . head $ res) `shouldBe` url+ getAllArticles hdl hdr n = do let ns = [0 .. n - 1] forM_ ns $ \i -> do- de <- getZimDirEntByUrlIndex hdr hdl i+ de <- (hdl, hdr) `getDE` UrlIndex i let url = zimDeUrl de- bs <- getZimContentByUrlIndex hdr hdl i- (url, bs) `shouldSatisfy` (\(_, b) -> BL.length b > 0)+ res <- (hdl, hdr) `getContent` UrlIndex i+ res `shouldSatisfy` isJust+ (url, res) `shouldSatisfy` (\(_, Just (_, bs)) -> BL.length bs > 0) - it "can search all URLs" $ \(smallZim, small) -> do- deList <- mapM (getZimDirEntByUrlIndex smallZim small) [0 .. zimArticleCount smallZim - 1]- searchAllUrls smallZim small deList+ it "can search all URLs" $ \(hdl, hdr) -> do+ deList <- mapM (((hdl, hdr) `getDE`) . UrlIndex) [0 .. zimArticleCount hdr - 1]+ searchAllUrls hdl hdr deList - it "can get content from all URLs" $ \(smallZim, small) -> do- getAllArticles smallZim small 457+ it "can get content from all URLs" $ \(hdl, hdr) -> do+ getAllArticles hdl hdr 457
zim-parser.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: zim-parser-version: 0.1.0.0+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