Fixed never-ending parser

src/Walrus/Backend.hs

@@ -12,7 +12,7 @@ import qualified Data.Attoparsec.ByteString.Lazy as LA
 import Data.Attoparsec.ByteString.Char8.Extras
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Char as C
-import Data.Text.IsText
+import Data.Textual.Class
 
 import Walrus.Backend.Metadata
 
@@ -50,19 +50,22 @@ parseBackend = do
       A.stringCI t
       skipHorizontalSpace
     tillSpace :: A.Parser String
-    tillSpace = fromText <$> A.takeTill C.isSpace
-    qStr :: A.Parser String
-    qStr = fromText <$> quotedString '\\' " " ""
-    parseParameters = A.many' $ do
+    tillSpace = fromTextual <$> A.takeTill C.isSpace
+    parseParameters :: A.Parser [String]
+    parseParameters = do
       p <- qStr
       skipHorizontalSpace
-      return p
+      if null p then return [] else do
+        pp <- parseParameters
+        return $ p : pp
+    qStr :: A.Parser String
+    qStr = fromTextual <$> quotedString '\\' " " ""
 
 runBackend :: Backend -> (Metadata, LBS.ByteString) -> IO (Either String (Metadata, LBS.ByteString))
 runBackend b (m, qdt) = do
   let rm = renderMetadata m
   edt' <- intBk b $ LBS.concat [
-    fromText rm,
+    fromTextual rm,
     "\r\n",
     qdt]
   case LA.parse repParse edt' of

src/Walrus/Backend/Metadata.hs

@@ -10,7 +10,7 @@ import SMTP.Address
 import SMTP.Account
 import qualified SMTP.Mime as Mime
 import SMTP.Response
-import Data.Text.IsText
+import Data.Textual.Class
 
 import Data.Time.ISO8601
 import Data.IP
@@ -94,13 +94,13 @@ renderMetadata m = BS.concat serialize
         "Action: ", show act, "\r\n",
         "Client-Ip: ", show $ cid^.clientIp, "\r\n",
         "Client-Port: ", show $ cid^.clientPort, "\r\n",
-        "Client-Name: ", fromText cnm, "\r\n",
-        "Return-Path: ", fromText . normalAccountName $ rfm, "\r\n",
+        "Client-Name: ", fromTextual cnm, "\r\n",
+        "Return-Path: ", fromTextual . normalAccountName $ rfm, "\r\n",
         "Recv-Date: ", formatISO8601 $ rcv, "\r\n",
         "Body-Encoding: ", show $ enc, "\r\n",
         "SMTP-UTF8: ", if utf then "Yes" else "No", "\r\n"
         ] :: [String]
-      in map fromText h ++ toStr ++ failStr ++ usrStr ++ unrec
+      in map fromTextual h ++ toStr ++ failStr ++ usrStr ++ unrec
 
 parseMetadata :: A.Parser Metadata
 parseMetadata = do
@@ -207,7 +207,7 @@ parseMetadata = do
     parseRead :: Read a => Parser a
     parseRead = do
       v <- bsval
-      case readMaybe . fromText $ v of
+      case readMaybe . fromTextual $ v of
         Nothing -> failParser
         Just i -> return i
     parseVal :: Parser a -> Parser a
@@ -222,7 +222,7 @@ parseMetadata = do
     parseBoolVal = parseVal parseMetadataBool
     parseISO8601Val = do
       v <- bsval
-      case parseISO8601 . fromText $ v of
+      case parseISO8601 . fromTextual $ v of
         Nothing -> failParser
         Just t -> return t
     parseMetadataBool :: Parser Bool

walrus-backend.cabal

@@ -36,7 +36,7 @@ library
     lens,
     iso8601-time,
     tools-for-attoparsec,
-    istext,
+    textual,
     hssealtools
   hs-source-dirs:      src
   ghc-options: -Wall -fno-warn-unused-do-bind -fwarn-incomplete-patterns -threaded