[Haskell-beginners] Performance problem

[Jefferson Andrade]

Hi!

I have a basic knowledge about Haskell and I am trying to put this
knowledge to work with a few exercises. The one I am trying now is
basically the following.

1. I must read from the standard input a series of text lines. Each line
represents a command that must be performed. The possible commands are:
add <id> <first-name> <last-name> <birth-date> <phone-number>
del <id>
info <id>
query (key:value)+

2. Each command may or may not generate an output on the standard output
according to a series of conditions (if an entry with the same ID already
exists, if the id of a del does not exists, if the id of an info does not
exists). Also, the info and query command also generate output on the
normal working.

3. The program is working, I suppose, but when I submit it for testing and
ranking on spoj.pl I get a timeout. The maximum allowed time for this
problem is 6s.

My code is the following:

===== Begin of source code =====

-- Problem id: HASHADQI

import qualified Data.List as List
import qualified Data.IntMap as Map
import Data.Maybe

type Person = (String,String,String,String)
type IntPersonMap = Map.IntMap Person

main = do
  input <- getContents
  seqAction Map.empty $ lines input

seqAction :: IntPersonMap -> [String] -> IO IntPersonMap
seqAction m [] = return m
seqAction m (l:ls) = do
  m' <- doAction m l
  seqAction m' ls

doAction :: IntPersonMap -> String -> IO IntPersonMap
doAction m cmd = do
  case cmd of
    'a':cs -> doInsert m (words cmd)
    'd':cs -> doDelete m (words cmd)
    'i':cs -> doInfo m (words cmd)
    'q':cs -> doQuery m (words cmd)
    [] -> return m

doInsert :: IntPersonMap -> [String] -> IO IntPersonMap
doInsert m [_, idText, fn, ln, bd, pn] = do
  let id = read idText :: Int
  if Map.member id m
    then do putStrLn $ "ID " ++ show id ++ " ja cadastrado."
            return m
    else return (Map.insert id (fn, ln, bd, pn) m)

doDelete :: IntPersonMap -> [String] -> IO IntPersonMap
doDelete m [_, idText] = do
  let id = read idText :: Int
  if Map.member id m
    then return (Map.delete id m)
    else do putStrLn $ "ID " ++ show id ++ " nao existente."
            return m

doInfo :: IntPersonMap -> [String] -> IO IntPersonMap
doInfo m [_, idText] = do
  let id = read idText :: Int
  case Map.lookup id m of
    Just (fn, ln, bd, pn) -> do putStrLn $ unwords [fn, ln, bd, pn]
                                return m
    Nothing -> do putStrLn $ "ID " ++ show id ++ " nao existente."
                  return m

doQuery :: IntPersonMap -> [String] -> IO IntPersonMap
doQuery m (_:qs) = do
  let test = (\x -> foldl (&&) True $ map ($x) $ makePredicate qs)
      result = Map.filter test m
  putStrLn $ unwords . map show $ Map.keys result
  return m

makePredicate :: [String] -> [(Person -> Bool)]
makePredicate [] = []
makePredicate (q:qs) =
  case List.break (==':') q of
    ("fn", ':':x) -> (\(fn,_,_,_) -> fn == x) : (makePredicate qs)
    ("ln", ':':x) -> (\(_,ln,_,_) -> ln == x) : (makePredicate qs)
    ("bd", ':':x) -> (\(_,_,bd,_) -> bd == x) : (makePredicate qs)
    ("pn", ':':x) -> (\(_,_,_,pn) -> pn == x) : (makePredicate qs)

===== End of source code =====

Can any one explain where is the source(s) of inefficiency and suggest how
to make this program more efficient?

Thanks in advance,
Jeff.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20120530/80fe29f1/attachment.htm>