Parsing a String to see if it contains another String, and then returning a monad if it does

Question

I was writing a function (named listenString) in haskell to see if a string contains one of the strings in a list of strings, and to then return a value (of the type m ()) that corresponded with the string it found. The type of that function is (Eq a, Monad m) => [a] -> [([a], m ())] -> m ().

The reason why I used a list to store the strings and their corresponding values ([([a], m ())]) instead of a Map was because I wanted to make sure that the function evaluated strings in the order that they were in the list, e.g. listenString "hello there" [("lo",print True),("hello",print False)] would printed True. If I used a map, the order might have been lost, and the function might have printed False.

Here's the code. I'm specifically wondering if there are any bugs, and if I'm using ListT correctly (of if I should be using something other than ListT), but any other feedback would be helpful and appreciated.

import Data.Either
import Control.Monad.Trans.List
searchListMapMaybe f (Search a b c) = Search a (mapMaybe f b) c
data Search a b = Search a [a] b
type Searching a b = ListT (Either b) (Search a b)
listenString [] _ = return ()
listenString a l = 
 let list = filter (\(x,_) -> if (x == []) then False else True) l
 noEmptyList [] = error "listenForString: You need to have at least one item in the list"
 noEmptyList x = x
 in listenStringSub a $ ListT $ Data.Either.Right $ fmap (\(x,y) -> Search x [] y) $ noEmptyList list
 where
 listenStringSub :: (Eq a) => [a] -> Searching [a] (m b) -> m b
 listenStringSub _ (ListT (Data.Either.Left a)) = a
 listenStringSub (c:cs) x = listenStringSub cs $ (listenStringMap c x) >>= searchFinal
 where
 listenStringMap char x = fmap ((searchReduce char) . (searchPop char)) x
 searchPop :: (Eq a) => a -> Search [a] b -> Search [a] b
 searchPop char (Search a@(x:_) l b) 
 | char == x = Search a (a:l) b
 | otherwise = Search a l b
 searchReduce :: (Eq a) => a -> Search [a] b -> Search [a] b
 searchReduce char search = searchListMapMaybe (function char) search
 where
 function _ [] = Just []
 function c l@(x:xs)
 | c == x = Just xs
 | otherwise = Nothing
 searchFinal :: (Eq a) => Search [a] b -> Searching [a] b
 searchFinal s@(Search a b c) 
 | [] `elem` b = ListT (Data.Either.Left c)
 | otherwise = return s

Edit: listenString should decide what values to return in the following order:

1. Which list comes first: listenString "hello there" [("lo",print True),("he",print False)] would output False.
2. If two or more strings end in the exact same place, e.g. listenString "hello there" [("lo",print True),("hello",print False)], I want the tuple closest to the beginning of the list to be displayed (the above expression would output True.

Answer 1

Why do you need the element type to be a monad? The only point you require it is when you do return () in order to signal failure. I'd propose implementing a more general function

lookupSublist :: Eq a => [a] -> [([a], b)] -> Maybe b

Which could be implemented as:

lookupSublist xs = fmap snd . listToMaybe . filter (flip isInfixOf xs . fst)

So we first filter out all alternatives where the first element doesn't have xs as infix. Then we return the second element of the first remaining element, if any.

Some random notes on your code:

1. Using noEmptyList as a guard mid-expression isn't a good idea. Using error is pretty "evil" in the first place, you don't want to bury it like that. Putting the list in the where would allow you to say listenString a l | null list = error...

2. (\(x,_) -> if (x == []) then False else True) is simply not . null . fst. I'm not quite sure why you filter for that, to be honest. Wouldn't having [] in the list be a pretty elegant way to implement a default fallback value?

3. I am actually quit struggling to understand the rest of your code. I am pretty sure that your usage of ListT actually hurts more than it helps - generally when you start pattern-matching on the contents of a monad you are doing something wrong. Could you explain what you tried to do?

---

Edit: If the position of the match end should take priority, I would propose going over the prefixes of the string and suffix-test the options:

lookupFirstSublist str opts = listToMaybe $ mapMaybe f $ inits opts
 where f s = fmap snd $ listToMaybe $ filter (flip isSuffixOf s . fst) opts

• Jimmy Hoffa: I like this save one thing, I would instead of Maybe b have Maybe [a] -> b and use ap on it this way you could compose chains
• Jimmy Hoffa: lookupSublist xs = fmap (\x -> Just \y -> (snd x) y) . filter (isInFixOf xs . fst) for lookupSublist :: Eq [a] => [a] -> [([a], [a] -> b)] -> [Maybe [a] -> b]
• user4253: lookupSublist doesn't work at all: I'm assuming that you meant listenList a xs = fmap snd $ listToMaybe (filter (\x -> isInfixOf (fst x) a) xs). Even then, your implementation of lookupSublist has some problems: listenList "hello there" [("lo",True),("he",False)] returns True (It should return False, because "he" comes first in the "hello there").
• user4253: Thanks for your help though: I'll post an explanation of the code and I'll respond to your other points when I have time to edit it.
• Peter Wortmann: Nevermind, there was actually a flip missing. Sorry about that :)