codec-mbox (empty) → 0.1.0.0
raw patch · 4 files changed
+419/−0 lines, 4 filesdep +basedep +bytestringdep +fclabelssetup-changed
Dependencies added: base, bytestring, fclabels
Files
- Codec/Mbox.hs +364/−0
- LICENSE +30/−0
- Setup.lhs +3/−0
- codec-mbox.cabal +22/−0
+ Codec/Mbox.hs view
@@ -0,0 +1,364 @@+{-# LANGUAGE BangPatterns, TypeOperators, TemplateHaskell #-}+--------------------------------------------------------------------+-- |+-- Module : Codec.Mbox+-- Copyright : (c) Nicolas Pouillard 2008, 2009+-- License : BSD3+--+-- Maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++module Codec.Mbox+ (+ -- * Mailbox, message, and direction data types+ Mbox(..)+ , MboxMessage(..)+ , Direction(..)++ -- * Mailbox parsing functions+ , parseMboxFile+ , parseMboxFiles+ , parseMbox+ , safeParseMbox+ , parseOneMboxMessage++ -- * Mailbox printing functions+ , showMbox+ , showMboxMessage+ , showMboxFromLine++ -- * First-class labels+ , mboxMsgSender+ , mboxMsgTime+ , mboxMsgBody+ , mboxMsgFile+ , mboxMsgOffset++ -- * Misc+ , Month(..)+ , fromQuoting+ , msgYear+ , msgMonthYear+ , opposite+ ) where++import Control.Arrow (first,second)+import Control.Applicative ((<$>))+import qualified Data.ByteString.Lazy.Char8 as C -- Char8 interface over Lazy ByteString's+import Data.Label+import Data.ByteString.Lazy (ByteString)+import Data.Int (Int64)+import Data.Maybe (listToMaybe)+import System.IO+import System.IO.Unsafe (unsafeInterleaveIO)++data a :*: b = !a :*: !b++first' :: (a -> b) -> (a :*: c) -> (b :*: c)+first' f !(a :*: c) = f a :*: c+{-# INLINE first' #-}+uncurry' :: (a -> b -> c) -> a :*: b -> c+uncurry' f (x :*: y) = f x y+{-# INLINE uncurry' #-}++--import Test.QuickCheck++-- | An 'Mbox' is a list of 'MboxMessage'+newtype Mbox s = Mbox { mboxMessages :: [MboxMessage s] }+ deriving (Eq, Ord, Show)++-- | An 'MboxMessage' represent an mbox message, featuring+-- the sender, the date-time, and the message body.+data MboxMessage s = MboxMessage { _mboxMsgSender :: s+ , _mboxMsgTime :: s+ , _mboxMsgBody :: s+ , _mboxMsgFile :: FilePath+ , _mboxMsgOffset :: Int64 }+ deriving (Eq, Ord, Show)++$(mkLabelsNoTypes [''MboxMessage])++-- | First-class label to message's sender+mboxMsgSender :: MboxMessage s :-> s++-- | First-class label to the date and time of the given message+mboxMsgTime :: MboxMessage s :-> s++-- | First-class label to message's raw body+mboxMsgBody :: MboxMessage s :-> s++-- | First-class label to the file path of mbox's message+mboxMsgFile :: MboxMessage s :-> FilePath++-- | First-class label to the offset of the given message into the mbox+mboxMsgOffset :: MboxMessage s :-> Int64++readYear :: MboxMessage C.ByteString -> C.ByteString -> Int+readYear m s =+ case reads $ C.unpack s of+ [(i, "")] -> i+ _ -> error ("readYear: badly formatted date (year) in " ++ show (C.unpack $ _mboxMsgTime m))++data Month = Jan+ | Feb+ | Mar+ | Apr+ | May+ | Jun+ | Jul+ | Aug+ | Sep+ | Oct+ | Nov+ | Dec+ deriving (Read, Show, Eq)++readMonth :: MboxMessage C.ByteString -> C.ByteString -> Month+readMonth m s =+ case reads $ C.unpack s of+ [(month, "")] -> month+ _ -> error ("readMonth: badly formatted date (month) in " ++ show (C.unpack $ _mboxMsgTime m))++msgYear :: MboxMessage C.ByteString -> Int+msgYear m = readYear m . last . C.split ' ' . _mboxMsgTime $ m++msgMonthYear :: MboxMessage C.ByteString -> (Month,Int)+msgMonthYear m =+ case filter (not . C.null) . C.split ' ' . _mboxMsgTime $ m of+ [_wday, month, _mday, _hour, year] -> (readMonth m month, readYear m year)+ _ -> error ("msgMonthYear: badly formatted date in " ++ show (C.unpack $ _mboxMsgTime m))++nextFrom :: ByteString -> Maybe (Int64, ByteString, ByteString)+nextFrom !orig = goNextFrom 0 orig+ where goNextFrom !count !input = do+ off <- (+1) <$> C.elemIndex '\n' input+ let (nls, i') = first C.length $ C.span (=='\n') $ C.drop off input+ if C.take 5 i' == bFrom+ then let off' = off + count + (nls - 1) in+ Just (off', C.take off' orig, C.drop 5 i')+ else goNextFrom (off + count + nls) i'++-- TODO rules:+-- - fromQuoting id == id+-- - f . g == id ==> fromQuoting f . fromQuoting g == id+-- but fromQuoting can fail on negative levels+-- special case that works:+-- n > 0 ==> fromQuoting ((-)n) . fromQuoting (+n) == id++-- TODO performances:+-- This ByteString fromQuoting is already quite fast,+-- It still implies a x2 factor to the mbox-average-size tool, wether one+-- enables it or not.+-- Perhaps fusing nextFrom and fromQuoting could give more performances+-- (but will decrease performances of mbox-counting).++-- | @fromQuoting f s@ returns @s@ where the quoting level+-- of From_ lines has been updated using the @f@ function.+--+-- The From_ spefication, quoted from <http://qmail.org./man/man5/mbox.html>:+--+-- @+-- \>From quoting ensures that the resulting+-- lines are not From_ lines: the program prepends a \> to any+-- From_ line, \>\From_ line, \>\>From_ line, \>\>\>From_ line, etc.+-- @+fromQuoting :: (Int64 -> Int64) -> C.ByteString -> C.ByteString+fromQuoting onLevel = C.tail . nextQuotedFrom . C.cons '\n'+ where nextQuotedFrom !orig = goNextQuotedFrom 0 orig+ where goNextQuotedFrom !count !input =+ case C.elemIndex '\n' input of+ Nothing ->+ -- TODO,NOTE: here I don't know what to do between the+ -- following code and just returning `orig'+ if C.null input then orig else orig `C.snoc` '\n'+ Just off ->+ let (!level, i') = first C.length $ C.span (=='>') $ C.drop (off + 1) input in+ if C.take 5 i' == bFrom+ then C.take (off + count) orig `C.append`+ mkQuotedFrom (onLevel level) `C.append`+ nextQuotedFrom (C.drop 5 i')+ else goNextQuotedFrom (off + level + count + 1) i'++{-+prop_fromQuotingInv (NonNegative n) s = s == fromQuoting (+(-n)) (fromQuoting (+n) s)+prop_unparse_parse m = either (const False) (==m) $ safeParseMbox (showMbox m)+prop_parse_unparse m = let s = showMbox m in Right s == (showMbox <$> safeParseMbox s)++-- | Prefered xs: have the xs elements as favorites.+newtype Prefered a = Prefered { unPrefered :: a }+ deriving ( Eq, Ord, Show, Read )++class Favorites a where+ favorites :: [a]++instance Favorites Char where+ favorites = ">From \n"++instance Arbitrary C.ByteString where+ arbitrary = arbitrary >>= return . C.pack . map unPrefered++instance (Favorites a, Arbitrary a) => Arbitrary (Prefered a) where+ arbitrary =+ frequency+ [ (2, Prefered `fmap` oneof (map return favorites))+ , (1, Prefered `fmap` arbitrary)+ ]++ shrink (Prefered x) = Prefered `fmap` shrink x++--instance Arbitrary s => Arbitrary (MboxMessage s) where+instance Arbitrary (MboxMessage ByteString) where+ arbitrary = MboxMessage (C.pack "S") (C.pack "D") <$> arbitrary -- TODO better sender,time+ shrink (MboxMessage x y z) = [ MboxMessage x' y' z' | (x', y', z') <- shrink (x, y, z) ]++instance Arbitrary (Mbox ByteString) where+--instance Arbitrary s => Arbitrary (Mbox s) where+ arbitrary = Mbox <$> arbitrary+ shrink (Mbox x) = Mbox <$> shrink x+-}++mkQuotedFrom :: Int64 -> C.ByteString+mkQuotedFrom n | n < 0 = error "mkQuotedFrom: negative quoting"+ | otherwise = '\n' `C.cons` C.replicate n '>' `C.append` bFrom+++bFrom :: ByteString+bFrom = C.pack "From "++skipFirstFrom :: ByteString -> Either String ByteString+skipFirstFrom xs | bFrom == C.take 5 xs = Right $ C.drop 5 xs+ | otherwise = Left "skipFirstFrom: badly formatted mbox: 'From ' expected at the beginning"++-- | Same as 'parseMbox' but cat returns an error message.+-- However only the line can cause an error message currently, so it's fine+-- to dispatch on the either result.+safeParseMbox :: FilePath -> Int64 -> ByteString -> Either String (Mbox ByteString)+safeParseMbox fp offset s | C.null s = Right $ Mbox []+ | otherwise = Mbox . map (uncurry' $ finishMboxMessageParsing fp) . splitMboxMessages offset+ <$> skipFirstFrom s++-- | Turns a 'ByteString' into an 'Mbox' by splitting on From_ lines and+-- unquoting the \'\>\*From\'s of the message.+parseMbox :: ByteString -> Mbox ByteString+parseMbox = either error id . safeParseMbox "" 0++splitMboxMessages :: Int64 -> ByteString -> [Int64 :*: ByteString]+splitMboxMessages !offset !input =+ case nextFrom input of+ Nothing | C.null input -> []+ | otherwise -> [(offset :*: input)]+ Just (!offset', !msg, rest) -> (offset :*: msg) : splitMboxMessages (6 + offset + offset') rest++finishMboxMessageParsing :: FilePath -> Int64 -> ByteString -> MboxMessage ByteString+finishMboxMessageParsing fp !offset !inp = MboxMessage sender time (fromQuoting pred body) fp offset+ where ((sender,time),body) = first (breakAt ' ') $ breakAt '\n' inp+ breakAt c = second (C.drop 1 {- a safe tail -}) . C.break (==c)++-- | Turns an mbox into a 'ByteString'+showMbox :: Mbox ByteString -> ByteString+showMbox = C.intercalate (C.singleton '\n') . map showMboxMessage . mboxMessages++-- | Returns an header line in mbox format given an mbox message.+showMboxFromLine :: MboxMessage ByteString -> ByteString+showMboxFromLine (MboxMessage sender time _ _ _) =+ C.append bFrom+ . C.append sender+ . C.cons ' '+ . C.append time+ . C.cons '\n'+ $ C.empty++-- | Returns a 'ByteString' given an mbox message.+showMboxMessage :: MboxMessage ByteString -> ByteString+showMboxMessage msg = showMboxFromLine msg `C.append` fromQuoting (+1) (_mboxMsgBody msg)++-- lazyness at work!++-- | Given a file handle and an offset, 'parseOneMboxMessage' returns+-- the message a this offset.+parseOneMboxMessage :: FilePath -> Handle -> Integer -> IO (MboxMessage C.ByteString)+parseOneMboxMessage fp fh offset = do+ hSeek fh AbsoluteSeek offset+ s <- C.hGetContents fh+ a <- either fail return $ safeParseMbox fp (fromInteger offset) s+ (maybe (fail "parseOneMboxMessage: end of file") return . listToMaybe . mboxMessages) a++readRevMboxFile :: FilePath -> IO (Mbox ByteString)+readRevMboxFile fp = readRevMboxHandle fp =<< openFile fp ReadMode++-- | @readRevMboxHandle fp h@ returns a reversed mbox for a file handle.+-- The file handle is supposed to be in text mode, readable.+readRevMboxHandle :: FilePath -> Handle -> IO (Mbox ByteString)+readRevMboxHandle fp fh = do siz <- hFileSize fh+ readRevMbox fp siz <$> readHandleBackward mboxChunkSize siz fh+-- buffering issues?++readRevMbox :: FilePath -> Integer -> [ByteString] -> Mbox ByteString+readRevMbox fp filesize chunks = Mbox $ go (fromInteger filesize+1) (filter (not . C.null) chunks)+ where go _ [] = []+ go !siz (chunk1:cs) =+ case nextFrom chunk1 of+ Nothing -> kont siz cs chunk1+ Just (!_backoffset, !msg, rest) ->+ let siz' = siz - C.length rest - 6 in+ (map finishmmp . reverse . map (first' (+siz')) . splitMboxMessages 0 $ rest)+ ++ kont siz' cs msg++ kont !_ [] = (:[]) . finishLast+ kont !siz (chunk2:cs2) = \k -> go siz (chunk2 `C.append` k : cs2)++ finishLast =+ finishMboxMessageParsing fp 0 . either (error . ("readRevMbox: impossible: " ++)) id . skipFirstFrom++ finishmmp = uncurry' $ finishMboxMessageParsing fp++-- Not exported.+--+-- | @readHandleBackward maxChunkSize size h@ lazily reads the @h@ file handle+-- from the end. The file contents is returned as a reversed list of chunks.+-- The result is such that if one apply @C.concat . reverse@ one get+-- the in-order contents.+{-+propIO_read_anydir (Positive maxChunkSize) fh =+ do xs <- hGetContent fh+ siz <- hFileSize fh+ ys <- readHandleBackward maxChunkSize siz fh+ xs == C.concat (reverse ys)+-}+readHandleBackward :: Integer -> Integer -> Handle -> IO [ByteString]+readHandleBackward maxChunkSize siz0 fh = go siz0+ where go 0 = return []+ go siz = unsafeInterleaveIO $+ do let delta = min maxChunkSize siz+ siz' = siz - delta+ hSeek fh AbsoluteSeek siz'+ s <- C.hGet fh $ fromInteger delta+ (s :) <$> go siz'++data Direction = Backward | Forward++opposite :: Direction -> Direction+opposite Forward = Backward+opposite Backward = Forward++-- | Returns a mbox given a direction (forward/backward) and a file path.+parseMboxFile :: Direction -> FilePath -> IO (Mbox ByteString)+parseMboxFile Forward fp = (either fail return =<<) . (safeParseMbox fp 0 <$>) . C.readFile $ fp+parseMboxFile Backward fp = readRevMboxFile fp++-- | Returns a mbox list given a direction (forward/backward) and a list of file path.+-- Note that files are opened lazily.+parseMboxFiles :: Direction -> [FilePath] -> IO [Mbox ByteString]+parseMboxFiles Forward [] = (:[]) . parseMbox <$> C.getContents+parseMboxFiles Backward [] = fail "reading backward on standard input does not make sense"+parseMboxFiles dir xs = mapM (unsafeInterleaveIO . parseMboxFile dir) xs++mboxChunkSize :: Integer+mboxChunkSize = 10*oneMegabyte++-- one megabyte in bytes+oneMegabyte :: Integer+oneMegabyte = 2 ^ (20 :: Int)
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2009, Nicolas Pouillard+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the copyright holders nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ codec-mbox.cabal view
@@ -0,0 +1,22 @@+name: codec-mbox+cabal-Version: >=1.8+version: 0.1.0.0+license: BSD3+license-File: LICENSE+copyright: (c) Nicolas Pouillard+author: Nicolas Pouillard+maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+category: Codec+synopsis: A library to read and write mailboxes in mbox format+description: The library provides functions to read, write, and+ manipulate mbox's. This library focuses on three points:+ robustness, efficency, and scalability. It's using lazy+ bytestrings and can handle very big mailboxes.+stability: Provisional+build-type: Simple++library+ build-depends: base (==3.* || ==4.*), bytestring>=0.9, fclabels>=1.0+ exposed-modules: Codec.Mbox+ ghc-options: -Wall+ extensions: BangPatterns, TypeOperators