From b42303aa6f7e88a02ac8208baa092ffe132a4e7e Mon Sep 17 00:00:00 2001
From: slotThe <soliditsallgood@mailbox.org>
Date: Tue, 10 Aug 2021 09:49:21 +0200
Subject: [PATCH] X.P.OrgMode: Fix behaviour of getLast
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

So far, while parsing strings like "<ptn><more-letters>", the `getLast`
function immediately stopped on strings of the form "<ptn><whitespace>".
This may be a bit confusing given the functions name.  Strings of
the—perhaps artificial—form

    "a +d f 1 +d f 2"

would be cut short and parsed as

    Deadline "a" (Time { date = Next Friday, tod = Just 01:00 })

instead of the more intuitive

    Deadline "a +d f 1" (Time { date = Next Friday, tod = Just 02:00 }).

This is readily fixed by applying the `go` parser as often as possible,
only returning the longest list, and then pruning eventual leftovers at
the end of the string.  Since we were already invoking `dropWhileEnd` to
trim whitespace before, the added `reverse`s should not impact
performance at all.

Fixes: https://github.com/xmonad/xmonad-contrib/issues/584
---
 XMonad/Prompt/OrgMode.hs | 27 +++++++++++++++++++--------
 1 file changed, 19 insertions(+), 8 deletions(-)

diff --git a/XMonad/Prompt/OrgMode.hs b/XMonad/Prompt/OrgMode.hs
index 8a38b0a5..4ec6bbad 100644
--- a/XMonad/Prompt/OrgMode.hs
+++ b/XMonad/Prompt/OrgMode.hs
@@ -360,17 +360,18 @@ pInput inp = fmap fst . listToMaybe . (`readP_to_S` inp) . lchoice $
   ]
  where
   getLast :: String -> ReadP String
-  getLast ptn = go ""
+  getLast ptn =  reverse
+              .  dropWhile (== ' ')    -- trim whitespace at the end
+              .  drop (length ptn)     -- drop only the last pattern
+              .  reverse
+              .  concat
+             <$> endBy1 (go "") (pure ptn)
    where
     go :: String -> ReadP String
     go consumed = do
-      next  <- munch (/= head ptn)
-      next' <- munch1 (/= ' ')
-      if next' == ptn
-        then -- If we're done, it's time to prune extra whitespace
-             pure $ consumed <> dropWhileEnd (== ' ') next
-        else -- If not, keep it as it's part of something else
-             go   $ consumed <> next <> next'
+      str  <- munch  (/= head ptn)
+      word <- munch1 (/= ' ')
+      bool go pure (word == ptn) $ consumed <> str <> word
 
 -- | Try to parse a 'Time'.
 pTimeOfDay :: ReadP (Maybe TimeOfDay)
@@ -435,3 +436,13 @@ pInt = read <$> munch1 isDigit
 -- parsing when the left-most parser succeeds.
 lchoice :: [ReadP a] -> ReadP a
 lchoice = foldl' (<++) empty
+
+-- | Like 'Text.ParserCombinators.ReadP.endBy1', but only return the
+-- parse where @parser@ had the highest number of applications.
+endBy1 :: ReadP a -> ReadP sep -> ReadP [a]
+endBy1 parser sep = many1 (parser <* sep)
+ where
+  -- | Like 'Text.ParserCombinators.ReadP.many1', but use '(<++)'
+  -- instead of '(+++)'.
+  many1 :: ReadP a -> ReadP [a]
+  many1 p = (:) <$> p <*> (many1 p <++ pure [])