mbox-0.1/0000755000000000000000000000000011334656731010516 5ustar0000000000000000mbox-0.1/mbox.cabal0000644000000000000000000000123411334656731012447 0ustar0000000000000000name: mbox version: 0.1 synopsis: Read and write standard mailbox files. description: Read and write standard mailbox (mboxrd) files. category: system, text, data license: BSD3 license-file: LICENSE author: Gershom Bazerman maintainer: gershomb@gmail.com Tested-With: GHC == 6.10.3 Build-Type: Simple Cabal-Version: >= 1.6 library build-depends: base >= 4, base < 5, safe, time, old-locale exposed-modules: Data.MBox ghc-options: -Wall source-repository head type: darcs location: http://patch-tag.com/r/gershomb/mboxmbox-0.1/Setup.hs0000644000000000000000000000005611334656731012153 0ustar0000000000000000import Distribution.Simple main = defaultMain mbox-0.1/LICENSE0000644000000000000000000000270111334656731011523 0ustar0000000000000000Copyright (c) Gershom Bazerman 2010 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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. mbox-0.1/Data/0000755000000000000000000000000011334656731011367 5ustar0000000000000000mbox-0.1/Data/MBox.hs0000644000000000000000000000577011334656731012601 0ustar0000000000000000 ----------------------------------------------------------------------------- {- | Module : Data.MBox Copyright : (c) Gershom Bazerman, 2009 License : BSD 3 Clause Maintainer : gershomb@gmail.com Stability : experimental Reads and writes mboxrd files as per . -} ------------------------------------------------------------------------- module Data.MBox (MBox, Message(..), Header, parseMBox, parseForward, parseDateHeader, showMessage, showMBox) where import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read) import Control.Arrow import Data.List(isPrefixOf) import Data.Char import System.Locale import Data.Time import Safe type MBox = [Message] data Message = Message {fromLine :: String, headers :: [Header], body :: String} deriving (Read, Show) type Header = (String, String) -- | Reads a date header as a UTCTime parseDateHeader :: String -> Maybe UTCTime parseDateHeader = parseTime defaultTimeLocale "%A, %B %e, %Y %l:%M %p" -- | Attempts to retrieve the contents of a forwarded message from an enclosing message. parseForward :: Message -> Message parseForward origMsg@(Message f _ b) = case drop 1 $ dropWhile (/= "-----Original Message-----") (lines b) of [] -> origMsg xs -> headDef origMsg . parseMBox . unlines $ f:xs -- | Reads a string as an mbox file. parseMBox :: String -> MBox parseMBox = go . lines where go [] = [] go (x:xs) = uncurry (:) . (readMsg x *** go) . break ("From " `isPrefixOf`) $ xs readMsg :: String -> [String] -> Message readMsg x xs = uncurry (Message x) . second (unlines . map unquoteFrom). readHeaders $ xs readHeaders :: [String] -> ([Header], [String]) readHeaders [] = ([],[]) readHeaders (x:xs) | null x || all isSpace x || not (any (==':') x) = ([],xs) | otherwise = first ((second (killSpace . (++ headerCont) . drop 1) . break (==':') $ x):) $ readHeaders xs' where (headerCont, xs') = first ((" " ++) . unlines . map killSpace) . break notCont $ xs notCont [] = True notCont (c:cs) = not (isSpace c) || (all isSpace cs) unquoteFrom :: String -> String unquoteFrom xs'@('>':xs) = if "From " `isPrefixOf` dropWhile (=='>') xs then xs else xs' unquoteFrom xs = xs -- | Renders an MBox into a String showMBox :: MBox -> String showMBox = concatMap showMessage -- | Renders an individual message into a String. showMessage :: Message -> String showMessage (Message f hs b) = unlines $ f : map (\(x,y) -> (x ++ ": " ++ y)) hs ++ map unFrom (lines b) where unFrom x | isFrom x = '>':x | otherwise = x isFrom x = "From " `isPrefixOf` dropWhile (=='>') x killSpace :: String -> String killSpace = dropWhile isSpace . dropEndWhile isSpace dropEndWhile :: (a -> Bool) -> [a] -> [a] dropEndWhile p = foldr (\x xs -> if p x && null xs then [] else x:xs) []