mbox (empty) → 0.1

raw patch · 4 files changed

+127/−0 lines, 4 filesdep +basedep +old-localedep +safesetup-changed

Dependencies added: base, old-locale, safe, time

Files

• Data/MBox.hs +77/−0
• LICENSE +27/−0
• Setup.hs +2/−0
• mbox.cabal +21/−0

@@ -0,0 +1,77 @@++-----------------------------------------------------------------------------+{- |+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 <http://www.qmail.org/man/man5/mbox.html>.++-}+-------------------------------------------------------------------------++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) []

@@ -0,0 +1,27 @@+Copyright (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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,21 @@+name:                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/mbox