2
\$\begingroup\$

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.
\$\endgroup\$
2
\$\begingroup\$

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
\$\endgroup\$
  • \$\begingroup\$ 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 \$\endgroup\$ – Jimmy Hoffa May 13 '13 at 1:47
  • \$\begingroup\$ lookupSublist xs = fmap (\x -> Just \y -> (snd x) y) . filter (isInFixOf xs . fst) for lookupSublist :: Eq [a] => [a] -> [([a], [a] -> b)] -> [Maybe [a] -> b] \$\endgroup\$ – Jimmy Hoffa May 13 '13 at 14:47
  • \$\begingroup\$ 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"). \$\endgroup\$ – user4253 May 14 '13 at 23:31
  • \$\begingroup\$ 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. \$\endgroup\$ – user4253 May 14 '13 at 23:46
  • 1
    \$\begingroup\$ Nevermind, there was actually a flip missing. Sorry about that :) \$\endgroup\$ – Peter Wortmann May 15 '13 at 13:48

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy