Linted and removed redundant functions from tools-for-attoparsec

src/Walrus/Backend.hs

@@ -34,20 +34,19 @@ data Backend = TCPBackend String Int |
 type BackendHandler = Metadata -> LBS.ByteString -> IO (Either String (Metadata, LBS.ByteString))
 
 parseBackend :: A.Parser Backend
-parseBackend = do
-  A.choice [
-    do
-      tp "tcp"
-      h <- tillSpace
-      p <- A.decimal
-      return $ TCPBackend h p,
-    do
-      tp "exec"
-      f <- qStr
-      skipHorizontalSpace
-      pp <- parseParameters
-      return $ ExecBackend f pp
-    ]
+parseBackend = A.choice [
+  do
+    tp "tcp"
+    h <- tillSpace
+    p <- A.decimal
+    return $ TCPBackend h p,
+  do
+    tp "exec"
+    f <- qStr
+    skipHorizontalSpace
+    pp <- parseParameters
+    return $ ExecBackend f pp
+  ]
   where
     tp t = do
       skipHorizontalSpace
@@ -78,9 +77,7 @@ callBackend b (m, qdt) = do
     intBk :: Backend -> LBS.ByteString -> IO LBS.ByteString
     intBk (TCPBackend h p) = runTcp h p
     intBk (ExecBackend f aa) = runExec f aa
-    repParse = do
-      m' <- parseMetadata
-      return m'
+    repParse = parseMetadata
 
 runBackendOnce :: UniformIO u => u -> BackendHandler -> IO (Either String ())
 runBackendOnce u f =  withTarget u $ do
@@ -115,7 +112,7 @@ runExec f args dt = do
     (P.proc f args){P.std_in=P.CreatePipe}{
      P.std_out=P.CreatePipe}{P.std_err=P.Inherit}
     )
-  mapM (\h -> hSetNewlineMode h noNewlineTranslation) [i, o]
+  mapM_ (`hSetNewlineMode` noNewlineTranslation) [i, o]
   LBS.hPut i dt
   hFlush i
   LBS.hGetContents o

src/Walrus/Backend/Metadata.hs

@@ -11,6 +11,7 @@ import SMTP.Account
 import qualified SMTP.Mime as Mime
 import SMTP.Response
 import Data.Textual.Class
+import Text.StringConvert
 
 import Data.Time.ISO8601
 import Data.IP
@@ -62,7 +63,7 @@ instance Default MaybeMetadata where
 
 -- | Creates an empty metadata with just the client identity
 metadataForClient :: IP -> Int -> MaybeMetadata
-metadataForClient c p = def & mclientId .~ (Just (ClientIdentity c p))
+metadataForClient c p = def & mclientId .~ Just (ClientIdentity c p)
 -- | Blanks the data as necessary for the RSET SMTP command
 resetMetadata :: MaybeMetadata -> MaybeMetadata
 resetMetadata d = def & mclientId .~ d^.mclientId & mclientName .~ d^.mclientName
@@ -104,8 +105,8 @@ renderMetadata m = BS.concat serialize
       usrStr = case usr of
         Nothing -> []
         Just u -> ["Auth-User: ", u, "\r\n"]
-      toStr = List.concat $ map (\x -> ["To: ", renderMetadataAddress $ x, "\r\n"]) rto
-      failStr = List.concat $ map (\(a, r) -> ["Failed: ", renderMetadataAddress a, "; ", renderLineResponse r, "\r\n"]) rfail
+      toStr = List.concatMap (\x -> ["To: ", renderMetadataAddress x, "\r\n"]) rto
+      failStr = List.concatMap (\(a, r) -> ["Failed: ", renderMetadataAddress a, "; ", renderLineResponse r, "\r\n"]) rfail
       unrec = m^.unrecognized
       h = [
         "Action: ", show act, "\r\n",
@@ -113,7 +114,7 @@ renderMetadata m = BS.concat serialize
         "Client-Port: ", show $ cid^.clientPort, "\r\n",
         "Client-Name: ", fromTextual cnm, "\r\n",
         "Return-Path: ", fromTextual . normalAccountName $ rfm, "\r\n",
-        "Recv-Date: ", formatISO8601 $ rcv, "\r\n",
+        "Recv-Date: ", formatISO8601 rcv, "\r\n",
         "Body-Encoding: ", show enc, "\r\n",
         "SMTP-UTF8: ", if utf then "Yes" else "No", "\r\n",
         "Data-Size: ", show sz, "\r\n"
@@ -131,58 +132,57 @@ parseMetadata = do
         return $ ClientIdentity h p
       m = set mclientId i m'
   case strictMetadata m of
-    Just s -> return s
+    Just sm -> return sm
     Nothing -> fail "missing required fields"
   where
     parseField :: Parser ((MaybeMetadata, Maybe IP, Maybe Int) -> (MaybeMetadata, Maybe IP, Maybe Int))
-    parseField = do
-      A.choice [
-        do
-          act <- hdr "Action" parseEnumCI
-          return $ \(m, ip, p) -> (set maction (Just act) m, ip, p),
-        do
-          ip <- hdr "Client-Ip" parseRead
-          return $ \(m, _, p) -> (m, Just ip, p),
-        do
-          p <- hdr "Client-Port" parseRead
-          return $ \(m, ip, _) -> (m, ip, Just p),
-        do
-          nm <- hdr "Client-Name" (A.takeTill A.isSpace)
-          return $ \(m, ip, p) -> (set mclientName (Just nm) m, ip, p),
-        do
-          frm <- hdr "Return-Path" parseAccount
-          return $ \(m, ip, p) -> (set mmailFrom (Just frm) m, ip, p),
-        do
-          rtp <- hdr "To" parseAddress
-          return $ \(m, ip, p) -> let
-            crtp = m^.mrcptTo
-            in (set mrcptTo (rtp:crtp) m, ip, p),
-        do
-          rfl <- hdr "Failed" parseAddressingReason
-          return $ \(m, ip, p) -> let
-            fld = m^.mrcptFailed
-            in (set mrcptFailed (rfl:fld) m, ip, p),
-        do
-          recv <- hdr "Recv-Date" parseISO8601Val
-          return $ \(m, ip, p) -> (set mrecvDate (Just recv) m, ip, p),
-        do
-          enc <- hdr "Body-Encoding" Mime.parseBodyEncoding
-          return $ \(m, ip, p) -> (set mbodyEnc enc m, ip, p),
-        do
-          utf <- hdr "SMTP-UTF8" parseMetadataBool
-          return $ \(m, ip, p) -> (set msmtpUtf8 utf m, ip, p),
-        do
-          usr <- hdr "Auth-User" A.takeByteString
-          return $ \(m, ip, p) -> (set mauth (Just usr) m, ip, p),
-        do
-          sz <- hdr "Data-Size" A.decimal
-          return $ \(m, ip, p) -> (set mdataSize (Just sz) m, ip, p),
-        do
-          u <- entireHdr
-          return $ \(m, ip, p) -> let
-            uu = m^.munrecognized
-            in (set munrecognized (u:uu) m, ip, p)
-        ]
+    parseField = A.choice [
+      do
+        act <- hdr "Action" parseEnumCI
+        return $ \(m, ip, p) -> (set maction (Just act) m, ip, p),
+      do
+        ip <- hdr "Client-Ip" parseRead
+        return $ \(m, _, p) -> (m, Just ip, p),
+      do
+        p <- hdr "Client-Port" parseRead
+        return $ \(m, ip, _) -> (m, ip, Just p),
+      do
+        nm <- hdr "Client-Name" (A.takeTill A.isSpace)
+        return $ \(m, ip, p) -> (set mclientName (Just nm) m, ip, p),
+      do
+        frm <- hdr "Return-Path" parseAccount
+        return $ \(m, ip, p) -> (set mmailFrom (Just frm) m, ip, p),
+      do
+        rtp <- hdr "To" parseAddress
+        return $ \(m, ip, p) -> let
+          crtp = m^.mrcptTo
+          in (set mrcptTo (rtp:crtp) m, ip, p),
+      do
+        rfl <- hdr "Failed" parseAddressingReason
+        return $ \(m, ip, p) -> let
+          fld = m^.mrcptFailed
+          in (set mrcptFailed (rfl:fld) m, ip, p),
+      do
+        recv <- hdr "Recv-Date" parseISO8601Val
+        return $ \(m, ip, p) -> (set mrecvDate (Just recv) m, ip, p),
+      do
+        enc <- hdr "Body-Encoding" Mime.parseBodyEncoding
+        return $ \(m, ip, p) -> (set mbodyEnc enc m, ip, p),
+      do
+         utf <- hdr "SMTP-UTF8" parseMetadataBool
+         return $ \(m, ip, p) -> (set msmtpUtf8 utf m, ip, p),
+      do
+        usr <- hdr "Auth-User" A.takeByteString
+        return $ \(m, ip, p) -> (set mauth (Just usr) m, ip, p),
+      do
+        sz <- hdr "Data-Size" A.decimal
+        return $ \(m, ip, p) -> (set mdataSize (Just sz) m, ip, p),
+      do
+        u <- entireHdr
+        return $ \(m, ip, p) -> let
+          uu = m^.munrecognized
+          in (set munrecognized (u:uu) m, ip, p)
+      ]
     entireHdr :: Parser ByteString
     entireHdr = do
       a <- A.satisfy (not . A.isEndOfLine . asW8)
@@ -211,7 +211,7 @@ parseMetadata = do
       skipHorizontalSpace
       t <- bsval
       r <- case A.parseOnly f t of
-        Left _ -> failParser
+        Left _ -> fail $ "failed parsing value of " ++ s pt
         Right v -> return v
       skipHorizontalSpace
       return r
@@ -224,19 +224,18 @@ parseMetadata = do
     parseRead = do
       v <- A.takeTill A.isSpace
       case readMaybe . fromTextual $ v of
-        Nothing -> failParser
+        Nothing -> fail "failed parsing value"
         Just i -> return i
     parseISO8601Val = do
       v <- A.takeTill A.isSpace
       case parseISO8601 . fromTextual $ v of
-        Nothing -> failParser
+        Nothing -> fail "failed parsing ISO8601 date"
         Just t -> return t
     parseMetadataBool :: Parser Bool
-    parseMetadataBool = do
-      A.choice [
-        A.stringCI "YES" *> return True,
-        A.stringCI "NO" *> return False
-        ]
+    parseMetadataBool = A.choice [
+      A.stringCI "YES" *> return True,
+      A.stringCI "NO" *> return False
+      ]
     parseAddressingReason :: Parser (Address, Response)
     parseAddressingReason = do
       a <- parseMetadataAddress

walrus-backend.cabal

@@ -35,6 +35,7 @@ library
     process >= 1.2,
     lens,
     iso8601-time,
+    string-convert,
     tools-for-attoparsec,
     textual,
     hssealtools,