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.