diff --git a/CarbonCopy/Configuration.hs b/CarbonCopy/Configuration.hs --- a/CarbonCopy/Configuration.hs +++ b/CarbonCopy/Configuration.hs @@ -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 diff --git a/CarbonCopy/EmailStorage.hs b/CarbonCopy/EmailStorage.hs --- a/CarbonCopy/EmailStorage.hs +++ b/CarbonCopy/EmailStorage.hs @@ -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 () diff --git a/CarbonCopy/HeadersStorage.hs b/CarbonCopy/HeadersStorage.hs --- a/CarbonCopy/HeadersStorage.hs +++ b/CarbonCopy/HeadersStorage.hs @@ -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 diff --git a/CarbonCopy/MailHeaders.hs b/CarbonCopy/MailHeaders.hs --- a/CarbonCopy/MailHeaders.hs +++ b/CarbonCopy/MailHeaders.hs @@ -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" diff --git a/CarbonCopy/ThreadBuilder.hs b/CarbonCopy/ThreadBuilder.hs --- a/CarbonCopy/ThreadBuilder.hs +++ b/CarbonCopy/ThreadBuilder.hs @@ -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 diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -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 diff --git a/carboncopy.cabal b/carboncopy.cabal --- a/carboncopy.cabal +++ b/carboncopy.cabal @@ -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,