packages feed

mbox-tools (empty) → 0.2.0.0

raw patch · 15 files changed

+794/−0 lines, 15 filesdep +basedep +bytestringdep +codec-mboxsetup-changed

Dependencies added: base, bytestring, codec-mbox, containers, fclabels, hsemail, hutt, monads-fd, parsec, process, pureMD5, random, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2008, 2009, 2010, 2011 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.
+ MboxTools.hs view
@@ -0,0 +1,1 @@+module MboxTools where
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ mbox-average-size.hs view
@@ -0,0 +1,20 @@+import Codec.Mbox (Mbox(..), MboxMessage(..), parseMbox)+import Control.Applicative ((<$>))+import Data.List (foldl')+import qualified Data.ByteString.Lazy as B++data P a = P !a !Int++-- spec: average xs = sum xs / fromIntegral (length xs)+-- still slow (too lazy tuple): average = uncurry (/) . foldl' f (0,0) where f (a,b) x = (a+x,b+1)+average :: Fractional a => [a] -> a+average xs = s / fromIntegral l+  where (P s l)     = foldl' f (P 0 0) xs+        f (P a b) x = P (a + x) (b + 1)++mboxAverageSize :: Mbox B.ByteString -> Double+mboxAverageSize = average . map (fromIntegral . B.length . get mboxMsgBody) . mboxMessages++main :: IO ()+main = do putStrLn "Reading from stdin..."+          print =<< (mboxAverageSize . parseMbox) <$> B.getContents
+ mbox-counting.hs view
@@ -0,0 +1,7 @@+import Codec.Mbox (mboxMessages,parseMbox)+import qualified Data.ByteString.Lazy as B+import System.IO (hPutStrLn, stderr)++main :: IO ()+main = do hPutStrLn stderr "Reading from stdin..."+          (print . length . mboxMessages . parseMbox) =<< B.getContents
+ mbox-from-files.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE TemplateHaskell, TypeOperators #-}+--------------------------------------------------------------------+-- |+-- Executable : mbox-from-files+-- Copyright : (c) Nicolas Pouillard 2010, 2011+-- License   : BSD3+--+-- Maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++import Prelude hiding (mod)+import Control.Monad (join)+import Codec.Mbox (Mbox(..),MboxMessage(..),showMbox)+import System.Environment (getArgs)+import System.Console.GetOpt+import Data.Label+import qualified Data.ByteString.Lazy.Char8 as B++data Settings = Settings { _help :: Bool }++$(mkLabels [''Settings])++type Flag = Settings -> Settings++msgFromFile :: FilePath -> IO (MboxMessage B.ByteString)+msgFromFile fp =+ do contents <- B.readFile fp+    return $ MboxMessage { _mboxMsgSender = B.pack "XXX"+                         , _mboxMsgTime   = B.pack "Thu Jan 01 01:00:00 +0100 1970"+                         , _mboxMsgBody   = contents+                         , _mboxMsgFile   = fp+                         , _mboxMsgOffset = undefined }++mboxFromFiles :: Settings -> [FilePath] -> IO ()+mboxFromFiles _ =+  join . fmap (B.putStr . showMbox . Mbox)+       . mapM msgFromFile++defaultSettings :: Settings+defaultSettings = Settings { _help = False }++usage :: String -> a+usage msg = error $ unlines ls+  where header = "Usage: mbox-from-files [OPTION] <mail-files>*"+        ls     = msg : usageInfo header options :+                 ["If no files are given as argument, a list of"+                  ,"file names is read from the standard input."]++options :: [OptDescr Flag]+options =+  [ Option "?" ["help"]     (NoArg (set help True))     "Show this help message"+  ]++main :: IO ()+main = do+  args <- getArgs+  let (flags, nonopts, errs) = getOpt Permute options args+  let opts = foldr ($) defaultSettings flags+  if get help opts+   then usage ""+   else+    case (nonopts, errs) of+      ([], [])    -> mboxFromFiles opts . lines =<< getContents+      (files, []) -> mboxFromFiles opts files+      (_,      _) -> usage (concat errs)+
+ mbox-grep.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE TemplateHaskell, TypeOperators #-}+--------------------------------------------------------------------+-- |+-- Executable : mbox-grep+-- Copyright : (c) Nicolas Pouillard 2008, 2009, 2010, 2011+-- License   : BSD3+--+-- Maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++import Codec.Mbox (Mbox(..), MboxMessage(..), Direction(..), parseMboxFiles, opposite)+import Email (Email(..),ShowFormat(..),fmtOpt,defaultShowFormat,+              readEmail,putEmails,showFormatsDoc,stringOfField)+import System.Environment (getArgs)+import Text.ParserCombinators.Parsec (parse)+import Hutt.Query (evalQueryMsg,parseQuery)+import Hutt.Types(Msg(..),Dsc(..),MsgId(..),DscId(..),Query(..))+import Data.Tree (Tree(..))+import Data.Label+import Control.Arrow+import System.Console.GetOpt++data Settings = Settings { _fmt  :: ShowFormat+                         , _dir  :: Direction+                         , _help :: Bool+                         }+$(mkLabels [''Settings])+type Flag = Settings -> Settings++grepMbox :: Settings -> String -> [String] -> IO ()+grepMbox opts queryString = (mapM_ f =<<) . parseMboxFiles (get dir opts)+  where query = either (error "malformed query") id $ parse parseQuery "<first-argument>" queryString+        f     = putEmails (get fmt opts)+                . filter (emailMatchQuery query . fst)+                . map ((readEmail . get mboxMsgBody) &&& id) . mboxMessages++emailMatchQuery :: Query -> Email -> Bool+emailMatchQuery query email = evalQueryMsg (msg, dsc) query+  where msg = Msg { msgHeader = map stringOfField $ emailFields email+                  --, msgBody = rawEmail email+                  , msgContent = rawEmail email -- emailContent email+                  , msgId = MsgId 0+                  , msgLabels = []+                  , msgAddress = undefined+                  , msgParent = Nothing+                  , msgReferences = [] }+        dsc = Dsc { dscId = DscId 0+                  , dscMsgs = Node () []+                  , dscLabels = [] }++main :: IO ()+main = do+  args <- getArgs+  let (flags, nonopts, errs) = getOpt Permute options args+  let opts = foldr ($) defaultSettings flags+  if get help opts+   then usage ""+   else+    case (nonopts, errs) of+      (queryString : files, []) -> grepMbox opts queryString files+      (_,                   []) -> usage "Too few arguments"+      _                         -> usage (concat errs)++defaultSettings :: Settings+defaultSettings = Settings { _fmt  = defaultShowFormat+                           , _dir  = Forward+                           , _help = False+                           }++usage :: String -> a+usage msg = error $ unlines [msg, usageInfo header options, showFormatsDoc]+  where header = "Usage: mbox-grep [OPTIONS] <query> <mbox-file>*"++options :: [OptDescr Flag]+options =+  [ fmtOpt usage (set fmt)+  , Option "r" ["reverse"] (NoArg (modify dir opposite)) "Reverse the mbox order (latest firsts)"+  , Option "?" ["help"]    (NoArg (set help True)) "Show this help message"+  ]+
+ mbox-iter.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE TemplateHaskell, TypeOperators, ScopedTypeVariables #-}+--------------------------------------------------------------------+-- |+-- Executable : mbox-iter+-- Copyright : (c) Nicolas Pouillard 2009, 2011+-- License   : BSD3+--+-- Maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++-- import Control.Arrow+import Control.Exception+import Codec.Mbox (Mbox(..),Direction(..),parseMboxFiles,opposite,showMboxMessage)+import System.Environment (getArgs)+import System.Console.GetOpt+import System.Exit+import System.IO+import qualified System.Process as P+import qualified Data.ByteString.Lazy as L+import Data.Label++data Settings = Settings { _dir  :: Direction+                         , _help :: Bool+                         }+$(mkLabels [''Settings])++type Flag = Settings -> Settings++systemWithStdin :: String -> L.ByteString -> IO ExitCode+systemWithStdin shellCmd input = do+  (Just stdinHdl, _, _, pHdl) <-+     P.createProcess (P.shell shellCmd){ P.std_in = P.CreatePipe }+  handle (\(_ :: IOException) -> return ()) $ do+    L.hPut stdinHdl input+    hClose stdinHdl+  P.waitForProcess pHdl++iterMbox :: Settings -> String -> [String] -> IO ()+iterMbox opts cmd mboxfiles =+  mapM_ (mapM_ (systemWithStdin cmd . showMboxMessage) . mboxMessages)+    =<< parseMboxFiles (get dir opts) mboxfiles++defaultSettings :: Settings+defaultSettings = Settings { _dir  = Forward+                           , _help = False+                           }++usage :: String -> a+usage msg = error $ unlines [msg, usageInfo header options]+  where header = "Usage: mbox-iter [OPTION] <cmd> <mbox-file>*"++options :: [OptDescr Flag]+options =+  [ Option "r" ["reverse"] (NoArg (modify dir opposite)) "Reverse the mbox order (latest firsts)"+  , Option "?" ["help"]    (NoArg (set help True)) "Show this help message"+  ]++main :: IO ()+main = do+  args <- getArgs+  let (flags, nonopts, errs) = getOpt Permute options args+  let opts = foldr ($) defaultSettings flags+  if get help opts+   then usage ""+   else+    case (nonopts, errs) of+      (cmd : mboxfiles, []) -> iterMbox opts cmd mboxfiles+      (_,                _) -> usage (concat errs)+
+ mbox-list.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE TemplateHaskell, TypeOperators #-}+--------------------------------------------------------------------+-- |+-- Executable : mbox-list+-- Copyright : (c) Nicolas Pouillard 2008, 2009, 2011+-- License   : BSD3+--+-- Maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++import Prelude+import Control.Arrow+import Codec.Mbox (Mbox(..),Direction(..),parseMboxFiles,mboxMsgBody,opposite)+import Email (readEmail)+import EmailFmt (putEmails,ShowFormat(..),fmtOpt,defaultShowFormat,showFormatsDoc)+import System.Environment (getArgs)+import System.Console.GetOpt+import Data.Label++data Settings = Settings { _fmt      :: ShowFormat+                         , _dir      :: Direction+                         , _takeOpt  :: Maybe Int+                         , _dropOpt  :: Maybe Int+                         , _help     :: Bool+                         }+$(mkLabels [''Settings])++type Flag = Settings -> Settings++listMbox :: Settings -> [String] -> IO ()+listMbox opts mboxfiles =+  mapM_ (putEmails (get fmt opts) .+         map ((readEmail . get mboxMsgBody) &&& id) .+         maybe id take (get takeOpt opts) .+         maybe id drop (get dropOpt opts) .+         mboxMessages)+    =<< parseMboxFiles (get dir opts) mboxfiles++defaultSettings :: Settings+defaultSettings = Settings { _fmt      = defaultShowFormat+                           , _dir      = Forward+                           , _takeOpt  = Nothing+                           , _dropOpt  = Nothing+                           , _help     = False+                           }++usage :: String -> a+usage msg = error $ unlines [msg, usageInfo header options, showFormatsDoc]+  where header = "Usage: mbox-list [OPTION] <mbox-file>*"++maybeIntArg :: (Settings :-> Maybe Int) -> ArgDescr (Settings -> Settings)+maybeIntArg l = ReqArg (set l . Just . read) "NUM"++-- Since+--   ∀ k1 k2 Positives, take k1 . drop k2 == drop k2 . take (k2 + k1)+-- one fix an ordering: drop then take.+options :: [OptDescr Flag]+options =+  [ fmtOpt usage (set fmt)+  , Option "r" ["reverse"]  (NoArg (modify dir opposite)) "Reverse the mbox order (latest firsts)"+  , Option "d" ["drop"]     (maybeIntArg dropOpt)         "Drop the NUM firsts"+  , Option "t" ["take"]     (maybeIntArg takeOpt)         "Take the NUM firsts (happens after --drop)"+  , Option "?" ["help"]     (NoArg (set help True))       "Show this help message"+  ]++main :: IO ()+main = do+  args <- getArgs+  let (flags, nonopts, errs) = getOpt Permute options args+  let opts = foldr ($) defaultSettings flags+  if get help opts+   then usage ""+   else+    case (nonopts, errs) of+      (mboxfiles, []) -> listMbox opts mboxfiles+      (_,          _) -> usage (concat errs)+
+ mbox-partition.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE TemplateHaskell, TypeOperators #-}+--------------------------------------------------------------------+-- |+-- Executable : mbox-partition+-- Copyright : (c) Nicolas Pouillard 2008, 2009, 2011+-- License   : BSD3+--+-- Maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++import Control.Applicative+import Codec.Mbox (Mbox(..),Direction(..),parseMboxFile,mboxMsgBody,showMboxMessage)+import Email (Email(..),emailFields,readEmail)+import Text.ParserCombinators.Parsec.Rfc2822 (Field(MessageID))+import Data.Label+import Data.Maybe (listToMaybe, fromMaybe)+import Data.Set (fromList, member)+import qualified Data.ByteString.Lazy.Char8 as C+import System.Environment (getArgs)+import System.Console.GetOpt+import System.IO (Handle, IOMode(AppendMode), stderr, openFile, hPutStr, hFlush, hClose)++progressStr :: String -> IO ()+progressStr s = hPutStr stderr ('\r':s) >> hFlush stderr++progress_ :: [IO a] -> IO ()+progress_ = (>> progressStr "Finished\n") . sequence_ . zipWith (>>) (map (progressStr . show) [(1::Int)..])++-- should be in ByteString+hPutStrLnC :: Handle -> C.ByteString -> IO ()+hPutStrLnC h s = C.hPut h s >> C.hPut h (C.pack "\n")++data Settings = Settings { _help :: Bool+                         , _msgids :: String+                         , _inside :: String+                         , _outside :: String+                         }+$(mkLabels [''Settings])+type Flag = Settings -> Settings++partitionMbox :: Settings -> [String] -> IO ()+partitionMbox opts mboxfiles = do+  msgids' <- (fromList . C.lines) <$> C.readFile (get msgids opts)+  let predicate = fromMaybe False . fmap (`member` msgids') . emailMsgId . readEmail . get mboxMsgBody+  hinside <- openFile (get inside opts) AppendMode+  houtside <- openFile (get outside opts) AppendMode+  let onFile fp =+        progress_ . map (\m -> hPutStrLnC (if predicate m then hinside else houtside) (showMboxMessage m))+                  . mboxMessages+           =<< parseMboxFile Forward fp+  mapM_ onFile mboxfiles+  mapM_ hClose [hinside, houtside]++emailMsgId :: Email -> Maybe C.ByteString+emailMsgId m = listToMaybe [ removeAngles $ C.pack i | MessageID i <- get emailFields m ]++removeAngles :: C.ByteString -> C.ByteString+removeAngles = C.takeWhile (/='>') . C.dropWhile (=='<')++defaultSettings :: Settings+defaultSettings = Settings { _help = False+                           , _msgids = ""+                           , _inside = ""+                           , _outside = "" }++usage :: String -> a+usage msg = error (msg ++ "\n" ++ usageInfo header options)+  where header = "Usage: mbox-partition [OPTION...] <mbox-file>*"++options :: [OptDescr Flag]+options =+  [ Option "m" ["msgids"]  (ReqArg (set msgids) "FILE") "A file with message-IDs"+  , Option "i" ["inside"]  (ReqArg (set inside) "FILE") "Will receive messages referenced by the 'msgids' file"+  , Option "o" ["outside"] (ReqArg (set outside) "FILE") "Will receive messages *NOT* referenced by the 'msgids' file"+  , Option "?" ["help"]    (NoArg  (set help True)) "Show this help message"+  ]++main :: IO ()+main = do+  args <- getArgs+  let (flags, nonopts, errs) = getOpt Permute options args+  let opts = foldr ($) defaultSettings flags+  case (nonopts, errs) of+    _ | get help opts -> usage ""+    (_, _:_)          -> usage (concat errs)+    ([], _)           -> usage "Too few arguments (mbox-file missing)"+    (mboxfiles, _)    -> partitionMbox opts mboxfiles+
+ mbox-pick.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE TemplateHaskell, TypeOperators #-}+--------------------------------------------------------------------+-- |+-- Executable : mbox-pick+-- Copyright : (c) Nicolas Pouillard 2008, 2009, 2011+-- License   : BSD3+--+-- Maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++import Control.Arrow+import Control.Applicative+import Data.Label+import Data.Maybe (fromMaybe, listToMaybe)+import qualified Data.ByteString.Lazy.Char8 as C+import Codec.Mbox (mboxMsgBody,parseOneMboxMessage)+import Email (readEmail)+import EmailFmt (putEmails,ShowFormat(..),fmtOpt,defaultShowFormat,showFormatsDoc)+import System.Environment (getArgs)+import System.Console.GetOpt+import System.IO (IOMode(..), stdin, openFile, hClose)++mayRead :: Read a => String -> Maybe a+mayRead s = case reads s of+  [(x, "")] -> Just x+  _         -> Nothing++parseSeq :: C.ByteString -> Maybe [Integer]+parseSeq = mapM (mayRead . C.unpack) . C.split ','++data Settings = Settings { _fmt  :: ShowFormat+                         , _help :: Bool+                         }+$(mkLabels [''Settings])++type Flag = Settings -> Settings++pickMbox :: Settings -> String -> Maybe FilePath -> IO ()+pickMbox opts sequ' mmbox = do+  mbox <- maybe (return stdin) (`openFile` ReadMode) mmbox+  sequ <- maybe (fail "badly formatted comma separated offset sequence") return $ parseSeq $ C.pack sequ'+  mails <- mapM ((((readEmail . get mboxMsgBody) &&& id) <$>) . parseOneMboxMessage (fromMaybe "" mmbox) mbox) sequ+  putEmails (get fmt opts) mails+  hClose mbox++defaultSettings :: Settings+defaultSettings = Settings { _fmt  = defaultShowFormat+                           , _help = False+                           }++usage :: String -> a+usage msg = error $ unlines [msg, usageInfo header options, showFormatsDoc]+  where header = "Usage: mbox-pick [OPTION] <offset0>,<offset1>,...,<offsetN> <mbox-file>"++options :: [OptDescr Flag]+options =+  [ fmtOpt usage (set fmt)+  , Option "?" ["help"]    (NoArg (set help True)) "Show this help message"+  ]++main :: IO ()+main = do+  args <- getArgs+  let (flags, nonopts, errs) = getOpt Permute options args+  let opts = foldr ($) defaultSettings flags+  if get help opts+   then usage ""+   else+    case (nonopts, errs) of+      ([],          []) -> usage "Too few arguments"+      (_:_:_:_,     []) -> usage "Too many arguments"+      (sequ : mbox, []) -> pickMbox opts sequ $ listToMaybe mbox+      (_,            _) -> usage (concat errs)+
+ mbox-quoting.hs view
@@ -0,0 +1,13 @@+import Codec.Mbox (fromQuoting)+import qualified Data.ByteString.Lazy.Char8 as C (getContents,putStr)+import Control.Applicative ((<$>))+import System.Environment (getArgs)+import System.IO (hPutStrLn,stderr)++main :: IO ()+main = do+  args <- getArgs+  case args of+    ["quot"]   -> C.putStr =<< fromQuoting (+1) <$> C.getContents+    ["unquot"] -> C.putStr =<< fromQuoting (+(-1)) <$> C.getContents+    _          -> hPutStrLn stderr "Usage: mbox-quoting {quot|unquot}"
+ mbox-tools.cabal view
@@ -0,0 +1,76 @@+Name:           mbox-tools+Cabal-Version:  >=1.8+Version:        0.2.0.0+License:        BSD3+License-File:   LICENSE+Copyright:      (c) Nicolas Pouillard+Author:         Nicolas Pouillard+Maintainer:     Nicolas Pouillard <nicolas.pouillard@gmail.com>+Category:       Email, Utility+Synopsis:       A collection of tools to process mbox files+Description:    A collection of tools to process mbox files+Homepage:       https://github.com/np/mbox-tools+Stability:      Experimental+Build-Type:     Simple++flag use_hutt+  Default: False+  -- hutt-0.1 is not released++flag useless+  Default: False++Library+    Build-depends: base(>=3 && <5), containers>=0.1, bytestring>=0.9, parsec,+                   transformers, monads-fd, fclabels>=1.0, pureMD5,+                   codec-mbox>=0.1, hsemail>=1.3.1+                   -- TMP-NO-MIME, mime-bytestring+    exposed-modules: MboxTools+-- TODO hsemail-1.3.1 is not released+-- mime-bytestring is not yet released++executable mbox-counting+    main-is: mbox-counting.hs+    ghc-options: -Wall+executable mbox-average-size+    main-is: mbox-average-size.hs+    ghc-options: -Wall+  if !flag(useless)+    buildable: False+executable mbox-quoting+    main-is: mbox-quoting.hs+    ghc-options: -Wall+  if !flag(useless)+    buildable: False+executable redact-mbox+    main-is: redact-mbox.hs+    Build-depends: random+    ghc-options: -Wall+  if !flag(useless)+    buildable: False+executable mbox-list+    main-is: mbox-list.hs+    ghc-options: -Wall+executable mbox-pick+    main-is: mbox-pick.hs+    ghc-options: -Wall+executable mbox-partition+    main-is: mbox-partition.hs+    ghc-options: -Wall+executable mbox-grep+    main-is: mbox-grep.hs+    ghc-options: -Wall+  if flag(use_hutt)+    build-depends: hutt>=0.1+  else+    buildable: False+executable split-mbox+    main-is: split-mbox.hs+    ghc-options: -Wall+executable mbox-iter+    main-is: mbox-iter.hs+    ghc-options: -Wall+    build-depends: process+executable mbox-from-files+    main-is: mbox-from-files.hs+    ghc-options: -Wall
+ redact-mbox.hs view
@@ -0,0 +1,85 @@+--------------------------------------------------------------------+-- |+-- Executable : redact-mbox+-- Copyright : (c) Nicolas Pouillard 2008, 2009, 2011+-- License   : BSD3+--+-- Maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++import Codec.Mbox (Mbox(..),MboxMessage(..),parseMbox,showMbox)+import qualified Data.ByteString.Lazy as B (ByteString,readFile,writeFile)+import qualified Data.ByteString.Lazy.Char8 as C (mapAccumL,unpack,pack)+import Data.List (mapAccumL)+import Data.Char (isDigit,isLower,isUpper)+import Control.Applicative+import Control.Monad.State+import System.Environment (getArgs)+import System.Random (getStdGen,randomRs)+import System.IO++type RedactState a = State [Int] a++-- BEGIN MISSING+consume :: State [a] a+consume = do (c:cs) <- get+             put cs+             return c++infix !!!+(!!!) :: [a] -> Int -> a+[] !!! _ = error "!!!: empty list"+lst !!! idx = go lst idx+  where go []     n       = go lst n+        go (x:_)  0       = x+        go (_:xs) (n + 1) = go xs n+        go _      _       = error "!!!: negative index"++-- prop_nthmod (NonNegative n) (NonEmpty xs) = xs !!! n == xs !! (n `mod` length xs)++swap :: (a,b) -> (b,a)+swap (x,y) = (y,x)++wrapState :: (acc -> x -> (acc, y)) -> x -> State acc y+wrapState f x = State (\state -> swap (f state x))++unwrapState :: (x -> State acc y) -> acc -> x -> (acc, y)+unwrapState f state x = swap (runState (f x) state)+-- END MISSING++redactChar :: Char -> RedactState Char+redactChar c | c `elem` " \t\n!@#$%^&*()[]{}/=?+-_:;|\\" = return c+             | isDigit c                                 = (digits !!!) <$> consume+             | isLower c                                 = (lowers !!!) <$> consume+             | isUpper c                                 = (uppers !!!) <$> consume+             | otherwise                                 = (alphas !!!) <$> consume++digits, alphas, lowers, uppers :: [Char]+digits = ['0'..'9']+lowers = ['a'..'z']+uppers = ['A'..'Z']+alphas = lowers ++ uppers++redactString :: B.ByteString -> RedactState B.ByteString+redactString = wrapState $ C.mapAccumL $ unwrapState redactChar++{- NOTE that the offset is not redacted -}+redactMboxMessage :: MboxMessage B.ByteString -> RedactState (MboxMessage B.ByteString)+redactMboxMessage (MboxMessage sender time body file offset) =+  MboxMessage `fmap` redactString sender `ap` redactString time `ap` redactString body+                `ap` (C.unpack `fmap` redactString (C.pack file)) `ap` return offset++main :: IO ()+main = do+  args <- getArgs+  ints <- randomRs (0, length digits + length alphas) <$> getStdGen+  case args of+    [argin,argout] ->+        B.writeFile argout+          =<< return . showMbox . Mbox . snd . mapAccumL (unwrapState redactMboxMessage) ints . mboxMessages . parseMbox+          =<< B.readFile argin+    _ -> hPutStrLn stderr "Usage: redact-mbox <in.mbox> <out.mbox>"+
+ split-mbox.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE BangPatterns, ExistentialQuantification, TemplateHaskell,+             TypeOperators #-}+--------------------------------------------------------------------+-- |+-- Executable : split-mbox+-- Copyright : (c) Nicolas Pouillard 2008, 2009, 2011+-- License   : BSD3+--+-- Maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++import Control.Arrow+import Codec.Mbox (Mbox(..),MboxMessage,Direction(..),msgYear,msgMonthYear,parseMboxFile,showMbox)+import qualified Data.ByteString.Lazy.Char8 as C+import Data.Label+import Data.Char (toLower)+import Data.List (groupBy)+import Data.Maybe (fromMaybe)+import System.Environment (getArgs)+import System.Console.GetOpt+import System.IO (hFlush, stdout)++equating :: Eq b => (a -> b) -> a -> a -> Bool+equating f x y = f x == f y++chunks :: Int -> [a] -> [[a]]+chunks _ [] = []+chunks n xs = uncurry (:) $ second (chunks n) $ splitAt n xs++-- Year is first+data SplitBy = Year | Month+  deriving (Show, Enum)++data Settings = Settings { _help :: Bool, _splitBy :: SplitBy }+$(mkLabels [''Settings])+type Flag = Settings -> Settings++splitMbox :: Eq a => (MboxMessage C.ByteString -> a) -> (MboxMessage C.ByteString -> String) -> String -> IO ()+splitMbox keyMsg fmtMsg mboxfile = do+  -- this 'chunks' trick is to avoid a lazyness problem+  mapM_ go . concatMap (groupBy (equating keyMsg)) . chunks 1000 . mboxMessages =<< parseMboxFile Forward mboxfile+  putStrLn "done."+  where go ms = do let !fp = "mbox-" ++ (fmtMsg $ head ms)+                   putStr ("\rWriting to " ++ fp ++ "...")+                   hFlush stdout+                   C.appendFile fp . showMbox . Mbox $ ms++splitMboxWith :: Settings -> String -> IO ()+splitMboxWith settings =+  case get splitBy settings of+    Year  -> splitMbox msgYear (show . msgYear)+    Month -> splitMbox msgMonthYear (uncurry (++) . (map toLower . show *** ('-':) . show) . msgMonthYear)++defaultSettings :: Settings+defaultSettings = Settings { _help = False, _splitBy = Year }++usage :: String -> a+usage msg = error (msg ++ "\n" ++ usageInfo header options)+  where header = "Usage: split-mbox [OPTION...] mbox-files..."++options :: [OptDescr Flag]+options =+  [ Option "?" ["help"] (NoArg (set help True)) "Show this help message"+  , byOpt ]++byOpt :: OptDescr Flag+byOpt = Option "b" ["by"] (ReqArg (set splitBy . parseBy) "ARG") desc+  where parseBy = fromMaybe (usage "Bad argument") . (`lookup` args)+        args = map ((map toLower . show) &&& id) [ Year .. ]+        desc = "Split by " ++ show (map fst args)++main :: IO ()+main = do+  args <- getArgs+  let (flags, nonopts, errs) = getOpt Permute options args+  let opts = foldr ($) defaultSettings flags+  if get help opts+   then usage ""+   else+    case (nonopts, errs) of+      ([],        []) -> usage "Too few arguments"+      (mboxfiles, []) -> mapM_ (splitMboxWith opts) mboxfiles+      (_,          _) -> usage (concat errs)+