mbox-utility (empty) → 0.0

raw patch · 4 files changed

+189/−0 lines, 4 filesdep +basedep +bytestringdep +hsemailsetup-changed

Dependencies added: base, bytestring, hsemail, non-empty, old-time, parsec, spreadsheet, utility-ht

Files

LICENSE +30/−0
Setup.lhs +3/−0
mbox-utility.cabal +36/−0
src/Main.hs +120/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2013, Henning Thielemann++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 Henning Thielemann 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

+ mbox-utility.cabal view

@@ -0,0 +1,36 @@+Name:                mbox-utility+Version:             0.0+Synopsis:            List contents of an mbox file containing e-mails+Description:+  List contents of an mbox file containing e-mails.+  This is intended for post-processing by the @cutter@ command.+  See <http://hackage.haskell.org/package/cutter>.+License:             BSD3+License-File:        LICENSE+Author:              Henning Thielemann+Maintainer:          haskell@henning-thielemann.de+Category:            Console+Build-Type:          Simple+Cabal-Version:       >=1.8++Source-Repository this+  Tag:         0.0+  Type:        darcs+  Location:    http://hub.darcs.net/thielema/mbox/++Source-Repository head+  Type:        darcs+  Location:    http://hub.darcs.net/thielema/mbox/++Executable lsmbox+  Main-Is: src/Main.hs+  GHC-Options: -Wall+  Build-Depends:+    hsemail >=1.7 && <2,+    parsec >=2.1 && <4,+    old-time >=1.0 && <1.2,+    spreadsheet >=0.1.3 && <0.2,+    non-empty >=0.0 && <0.4,+    bytestring >=0.9.1 && <0.11,+    utility-ht >=0.0.7 && <0.1,+    base >=4.2 && <5

+ src/Main.hs view

@@ -0,0 +1,120 @@+module Main where++import qualified Text.ParserCombinators.Parsec.Rfc2822 as Parser+import qualified Text.ParserCombinators.Parsec as Parsec+import Text.ParserCombinators.Parsec ((<|>), )+import System.Time (calendarTimeToString, )++import qualified Data.Spreadsheet as Spreadsheet+import qualified Data.ByteString.Lazy.Char8 as BC+import qualified Data.NonEmpty.Mixed as NonEmptyM+import qualified Data.NonEmpty as NonEmpty+import qualified Data.List as List+import qualified Data.Char as Char+import Control.Functor.HT (void, )+import Data.Tuple.HT (mapFst, mapSnd, )+import Data.Maybe.HT (toMaybe, )+import Data.Maybe (mapMaybe, listToMaybe, )+import Data.List.HT (mapAdjacent, )+import Data.List (genericLength, )+++selectFirst :: [String] -> String+selectFirst (x:_) = x+selectFirst _ = ""++messageHeader :: [Parser.Field] -> [String]+messageHeader fields =+   (selectFirst $ do+      Parser.Date date <- fields+      return $ calendarTimeToString date) :+   (selectFirst $ do+      Parser.From addrs <- fields+      Parser.NameAddr name addr <- addrs+      return $ maybe addr id name) :+   (selectFirst $ do+      Parser.Subject text <- fields+      return text) :+   []++maybeContentType :: Parser.Field -> Maybe String+maybeContentType fld =+   case fld of+      Parser.OptionalField name value ->+         toMaybe (map Char.toLower name == "content-type") value+      _ -> Nothing++maybeMultipart :: String -> Maybe String+maybeMultipart contentType =+   (\p -> either (const Nothing) Just $ Parsec.parse p "" contentType) $ do+      Parsec.skipMany Parsec.space+      void $ Parsec.string "multipart/mixed;"+      Parsec.skipMany1 Parsec.space+      void $ Parsec.string "boundary="+      (Parsec.between (Parsec.char '"') (Parsec.char '"') $+          Parsec.many (Parsec.noneOf ['"']))+       <|>+       Parsec.many (Parsec.noneOf ['\n', '\r'])++partSummary :: NonEmpty.T [] BC.ByteString -> (Integer, [String])+partSummary rows =+   (genericLength $ NonEmpty.flatten rows,+    case Parsec.parse Parser.message "<part>" $+         concatMap ((++"\r\n") . BC.unpack) $+         NonEmpty.tail rows of+       Left err -> [show err]+       Right (Parser.Message fields _body) ->+          "" : "" :+          case mapMaybe maybeContentType fields of+             [] -> ["missing content-type"]+             ct:_ -> [ct])++nonEmptyLength :: NonEmpty.T [] a -> Integer+nonEmptyLength = NonEmpty.sum . fmap (const 1)++splitMessage :: NonEmpty.T [] BC.ByteString -> [(Integer, [String])]+splitMessage rows =+   case Parsec.parse Parser.message (BC.unpack $ NonEmpty.head rows) $+        concatMap ((++"\r\n") . BC.unpack) $ NonEmpty.tail rows of+      Left err -> [(nonEmptyLength rows, ["", "", show err])]+      Right (Parser.Message fields _body) ->+         maybe [(nonEmptyLength rows, messageHeader fields)] id $ do+            ct <- listToMaybe $ mapMaybe maybeContentType fields+            boundary <- maybeMultipart ct+            return $+               (\(hdr, ((initr, parts), trl)) ->+                  (genericLength hdr + genericLength initr, messageHeader fields) :+                  map partSummary parts +++                  [(genericLength trl, ["", "", "trailer"])]) $+               mapSnd+                  (mapFst (NonEmptyM.segmentBefore (BC.pack ("--"++boundary) ==)) .+                   break (BC.pack ("--"++boundary++"--") ==)) $+               break BC.null $ NonEmpty.flatten rows++positions :: [[row]] -> [(Integer, Integer)]+positions =+   mapAdjacent (,) . scanl (+) 0 . map List.genericLength++{-+FIXME:+This does not work reliably,+since attachments may contain un-escaped From-lines.+Unfortunately codec-mbox does not solve this problem, too.+-}+splitMessages ::+   BC.ByteString -> ([BC.ByteString], [NonEmpty.T [] BC.ByteString])+splitMessages =+   NonEmptyM.segmentBefore (BC.isPrefixOf $ BC.pack "From ") .+   BC.lines++main :: IO ()+main =+   putStr . Spreadsheet.toString '"' ',' .+   (\(hd, body) ->+      case unzip $ concatMap splitMessage body of+         (lengths, descs) ->+            zipWith+               (\(from,to) desc -> show from : show to : desc)+               (mapAdjacent (,) $ scanl (+) (genericLength hd) lengths)+               descs) .+   splitMessages =<< BC.getContents