packages feed

carboncopy 0.1 → 0.1.2

raw patch · 7 files changed

+38/−38 lines, 7 filesdep ~base

Dependency ranges changed: base

Files

CarbonCopy/Configuration.hs view
@@ -9,9 +9,7 @@ import Text.ParserCombinators.ReadP as R import Data.Char import Data.Maybe-import Data.List--import Prelude as P+import Data.List as L  data Option = Path String | Email String | Unparsed String @@ -22,24 +20,24 @@ defaultConfiguration email = Configuration [Path ".ccheader", Email email]  loadConfiguration :: ByteString -> Configuration-loadConfiguration content = Configuration ( P.foldl (parseLine) [] $ BStr.lines content )+loadConfiguration content = Configuration ( L.foldl' parseLine [] $ BStr.lines content )     where          parseLine :: [Option] -> ByteString -> [Option]         parseLine acc line = case parsedLine of                                     [(nv@(name,value),_)]   -> handleNv nv                                     [(nv@(name,value),_),_] -> handleNv nv-                                    unparsed                -> (Unparsed unpackedLine):acc+                                    unparsed                -> Unparsed unpackedLine:acc                              where  handleNv (name,value) =                                         case name of-                                            "cc_header_file"    -> (Path value):acc-                                            "originator_email"  -> (Email value):acc+                                            "cc_header_file"    -> Path value:acc+                                            "originator_email"  -> Email value:acc                                             _                   -> acc                                     unpackedLine = BStr.unpack line                                     parsedLine = readP_to_S extractNameValue unpackedLine  extractNameValue :: ReadP (String, String) extractNameValue = do-    name <- munch ( not . (\c -> isSpace c || c `P.elem` "#="))+    name <- munch ( not . (\c -> isSpace c || c `L.elem` "#="))     skipSpaces     char '='     skipSpaces@@ -55,7 +53,7 @@ getEmail (Configuration xs) = listToMaybe [email | Email email <- xs]  instance Show Configuration where-    show (Configuration xs) = P.foldl ( flip ((++) . (++ "\n") . show) ) "" xs+    show (Configuration xs) = L.foldl' ( flip ((++) . (++ "\n") . show) ) "" xs  instance Show Option where     show (Email value) = "email => " ++ value
CarbonCopy/EmailStorage.hs view
@@ -9,10 +9,10 @@  type EmailHandler = ByteString -> IO () -(?:) :: IO (Bool) -> ( IO (), IO () ) -> IO ()+(?:) :: IO Bool -> ( IO (), IO () ) -> IO () (?:) cond (actL,actR) = cond >>= \condExp -> if condExp then actL else actR -(?&) :: IO (Bool) -> IO () -> IO ()+(?&) :: IO Bool -> IO () -> IO () (?&) cond act = cond ?: ( act, return () )  visitEmailsRecursively :: FilePath -> EmailHandler -> IO ()
CarbonCopy/HeadersStorage.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -XTypeSynonymInstances -XMultiParamTypeClasses  #-}+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} module CarbonCopy.HeadersStorage (Storage, fileStorage, hdrAdd, hdrExists ) where  import Data.ByteString.Lazy.Char8 as BStr@@ -9,11 +9,11 @@ crlf = BStr.pack "\n"  data Storage headerT  = HeadersStorage {-    exists :: headerT -> IO (Bool),+    exists :: headerT -> IO Bool,     add :: headerT -> IO () } -hdrExists :: Storage headerT -> headerT -> IO (Bool)+hdrExists :: Storage headerT -> headerT -> IO Bool hdrExists = exists  hdrAdd :: Storage headerT -> headerT -> IO ()@@ -27,7 +27,7 @@                 BStr.appendFile path crlf } -existsInFile :: FilePath -> StrHeader -> IO (Bool)+existsInFile :: FilePath -> StrHeader -> IO Bool existsInFile path hdr = do                  handle <- openFile path ReadMode                  found <- fmap (P.elem hdrValue . BStr.lines) $ BStr.hGetContents handle
CarbonCopy/MailHeaders.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -XTypeSynonymInstances #-}+{-# LANGUAGE TypeSynonymInstances #-} module CarbonCopy.MailHeaders (     Header(..),     StrHeader,@@ -32,4 +32,4 @@                              where                                 lines = BStr.lines src                                 parse l = P.map fst $ readP_to_S matcher line-                                    where line = BStr.unpack ( BStr.map (toLower) l ) ++ "\n"+                                    where line = BStr.unpack ( BStr.map toLower l ) ++ "\n"
CarbonCopy/ThreadBuilder.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -XTypeSynonymInstances -XMultiParamTypeClasses  #-}+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} module CarbonCopy.ThreadBuilder (     headerVal,     saveMatchingChain,@@ -21,7 +21,7 @@ type MsgidChain = Chain String String  -saveMatchingChain :: Storage (Header keyT valueT) -> Chain keyT valueT -> IO (Bool)+saveMatchingChain :: Storage (Header keyT valueT) -> Chain keyT valueT -> IO Bool saveMatchingChain storage                    ( Chain { current=myCurrent, previous=myPrevious } ) = do     prevHdrExists <- storage `hdrExists` myPrevious@@ -30,10 +30,10 @@     return ( prevHdrExists || currHdrExists ) saveMatchingChain storage _ = return False -findHeaderByName :: String -> [StrHeader] -> Maybe (StrHeader)+findHeaderByName :: String -> [StrHeader] -> Maybe StrHeader findHeaderByName hdrName = L.find ( (hdrName ==) . name ) -prepareChain :: [StrHeader] -> Maybe (MsgidChain)+prepareChain :: [StrHeader] -> Maybe MsgidChain prepareChain hdrs = processNextHeader $ findHeaderByName in_reply_to_hdr hdrs     where          processNextHeader (Just inReplyToHdr) = do@@ -47,7 +47,7 @@ matchFromHeader content email = ( chain, hdrsMatchFound )     where          headers = visitHeader content-        hdrsMatchFound = or $ P.map hdrMatch headers+        hdrsMatchFound = P.any hdrMatch headers         chain = prepareChain headers         hdrMatch (Header name value) = name == from_hdr && email `L.isInfixOf` value
Main.hs view
@@ -27,7 +27,7 @@  main = do     opts <- prepareConfig-    getArgs >>= (processArgs opts)+    getArgs >>= processArgs opts   processArgs :: Opts -> [String] -> IO ()@@ -48,7 +48,7 @@               -prepareConfig :: IO (Opts)+prepareConfig :: IO Opts prepareConfig = do     home <- getEnv "HOME"     let configFileName = home </> ".ccrc"@@ -64,12 +64,12 @@ usage = do     progName <- getProgName     P.putStrLn $ "Usage " ++ progName ++ " [init maildir1 maildir2 maildir3 ...] [ < content ]"-    P.putStrLn $ "\twhere 'init' will initialize header index with messages from given maildirs"-    P.putStrLn $ "\twith no arguments it will read message from stdin and attempt to recognize headers within it"-    P.putStrLn $ "\n\nExit codes:"-    P.putStrLn $ "\t0\t- reply to known thread was found, header was added to the storage"-    P.putStrLn $ "\t1\t- current email does not contain either e-mail address from configuration and is not a reply to a known thread"-    P.putStrLn $ "\t2\t- no message headers were recognized"+    P.putStrLn "\twhere 'init' will initialize header index with messages from given maildirs"+    P.putStrLn "\twith no arguments it will read message from stdin and attempt to recognize headers within it"+    P.putStrLn "\n\nExit codes:"+    P.putStrLn "\t0\t- reply to known thread was found, header was added to the storage"+    P.putStrLn "\t1\t- current email does not contain either e-mail address from configuration and is not a reply to a known thread"+    P.putStrLn "\t2\t- no message headers were recognized"   processCCState :: CCState -> IO ()@@ -79,7 +79,7 @@         stateCode = fromEnum state  -fileExists :: FilePath -> IO (Bool)+fileExists :: FilePath -> IO Bool fileExists = vDoesFileExist SystemFS  initMailFolder :: Storage StrHeader -> String -> Int -> (FilePath , Int) -> IO ()@@ -87,7 +87,7 @@     P.putStrLn $ "Processing storage " ++ show idx ++ " of " ++ show count ++ " at " ++ mailStorage     storageInit email mailStorage storage -handleEmail :: Storage StrHeader -> String -> ByteString -> IO ( CCState )+handleEmail :: Storage StrHeader -> String -> ByteString -> IO CCState handleEmail storage email content = handleEmail' chain     where ( chain, ownerEmail ) = matchFromHeader content email           handleEmail' (Just chain) = handleEmail'' ownerEmail@@ -96,6 +96,6 @@                                           System.exitWith ExitSuccess                   handleEmail'' _ = do existsInStorage <- saveMatchingChain storage chain                                        if existsInStorage-                                          then return ( Ok )-                                          else return ( NotFound )-          handleEmail' _ =  return ( NoChain )+                                          then return Ok+                                          else return NotFound+          handleEmail' _ =  return NoChain
carboncopy.cabal view
@@ -7,13 +7,15 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.1+Version:             0.1.2  -- A short (one-line) description of the package. Synopsis:            Drop emails from threads being watched into special CC folder.  -- A longer description of the package.-Description:         See README.txt+Description:         Filter for procmail, which allows to track message threads and +                     copy messages, which were sent to the threads you're watching,+                     into separate folder.  -- URL for the project homepage or repository. Homepage:            http://github.com/jdevelop/carboncopy@@ -57,7 +59,7 @@   Main-is:             Main.hs      -- Packages needed in order to build this package.-  Build-depends:      base >= 3 && < 4,+  Build-depends:      base >= 3 && < 5,                       IfElse >= 0.85,                       bytestring >= 0.9.1.4,                       filepath >= 1.1.0.2,