More specific search error messages.

Author: galenhuntington

Core.hs

@@ -444,19 +444,22 @@ genericJumpToMatch :: Lookup a
                    -> (Int -> HState -> Int)
                    -> IO ()
 genericJumpToMatch re sw k sel = do
-    found <- modifyHS \st -> let
+    mmsg <- modifyHS \st -> let
         info = case re of
             Just s -> Just (st { searchFw = sw }, s, sw)
             _      -> listToMaybe [ (st, s, st.searchFw == sw) | s <- st.searchHist ]
-        in flip (maybe (st, False)) info \(st', p, forwards) -> do
+        in flip (maybe (st, Just "No previous search.")) info
+                \ (st', p, forwards) -> do
             let (fs, cur, m) = k st
                 l = if forwards then [cur+1 .. m-1] ++ [0 .. cur]
                                 else [cur-1, cur-2 .. 0] ++ [m-1, m-2 .. cur]
-                match = matches p
-            case [ i | i <- l, match $ extract (fs ! i) ] of
-                i:_ -> (st' { cursor = sel i st }, True)
-                _   -> (st', False)
-    unless found $ putMessage [plainSeg "No match found."]
+            case matches p of
+                Just match ->
+                    case [ i | i <- l, match $ extract (fs ! i) ] of
+                        i:_ -> (st' { cursor = sel i st }, Nothing)
+                        _   -> (st', Just "No match found.")
+                _ -> (st', Just "Invalid ERE search pattern.")
+    whenJust mmsg \msg -> putMessage [plainSeg msg]
 
 ------------------------------------------------------------------------
 

Text.hs

@@ -32,10 +32,8 @@ spaces :: Int -> ByteString
 spaces = flip P.replicate ' '
 
 -- | Swappable API for searching
--- TODO report invalid regex
-matches :: ByteString -> ByteString -> Bool
-matches s = maybe (const False) match $
-    makeRegexOptsM (compIgnoreCase + compExtended) 0 s
+matches :: ByteString -> Maybe (ByteString -> Bool)
+matches s = match <$> makeRegexOptsM (compIgnoreCase + compExtended) 0 s
 
 readIntM :: ByteString -> Maybe Int
 readIntM = fmap fst . P.readInt

test/TextSpec.hs

@@ -3,6 +3,7 @@ module TextSpec (tests) where
 import Test.Tasty
 import Test.Tasty.HUnit
 
+import Base ((<&>))
 import Text
 
 -- These tests depend on wcwidth's behavior under a UTF-8 locale and on a
@@ -16,16 +17,17 @@ import Text
 tests :: TestTree
 tests = testGroup "Text"
     [ testGroup "match"
-        [ m True "exact"         "foo"       "fooBar"
-        , m True "caseless"      "FOO"       "fooBar"
-        , m False "invalid"      "["         "any[thing"
-        , m True "alt"           "(foo|az)Q" "bazQux"
-        , m True "dot"           "o.a"       "foobar"
-        , m True "Unicode"       "jör"       "Björk"
-        , m True "dot Unicode"   "j.r"       "Björk"
-        , m True "Nordic case"   "bør"       "BØrnE"
-        , m True "Greek case"    "Λω"        "ΦλΩα"
-        , m True "dot CJK"       "中.人"     "中國人"
+        [ m (Just True)  "exact"         "foo"       "fooBar"
+        , m (Just True)  "caseless"      "FOO"       "fooBar"
+        , m Nothing      "invalid"       "["         "any[thing"
+        , m (Just True)  "alt"           "(foo|az)Q" "bazQux"
+        , m (Just True)  "dot"           "o.a"       "foobar"
+        , m (Just True)  "Unicode"       "jör"       "Björk"
+        , m (Just True)  "dot Unicode"   "j.r"       "Björk"
+        , m (Just True)  "Nordic case"   "bør"       "BØrnE"
+        , m (Just True)  "Greek case"    "Λω"        "ΦλΩα"
+        , m (Just True)  "dot CJK"       "中.人"     "中國人"
+        , m (Just False) "byte dots"     "c..te"     "côte"
         ]
     , testGroup "dropLastUTF8"
         [ testCase "ASCII"    $ dropLastUTF8 "abc"          @?= "ab"
@@ -88,6 +90,6 @@ tests = testGroup "Text"
     ]
 
 
-m :: Bool -> String -> String -> String -> TestTree
-m b tag pat str = testCase tag $ matches (u pat) (u str) @?= b
+m :: Maybe Bool -> String -> String -> String -> TestTree
+m b tag pat str = testCase tag $ (matches (u pat) <&> ($ u str)) @?= b