1 {-# LANGUAGE PatternGuards #-}
3 -- Some things could be improved, e.g.:
4 -- * Check that each file given contains at least one instance of the
6 -- * Check that we are testing all functions
7 -- * If a problem is found, give better location information, e.g.
8 -- which problem the file is in
10 module Main (main) where
12 import Control.Concurrent
13 import Control.Exception
15 import Control.Monad.State
18 import qualified Data.Set as Set
19 import System.Environment
25 main = do args <- getArgs
31 die err = do hPutStrLn stderr err
52 put $ st { stSeen = Set.insert n seen, stLast = Just n }
53 if (n `Set.member` seen)
54 then problem ("Duplicate " ++ show n)
55 else case stLast st of
58 problem ("Decreasing order for " ++ show l
63 problem :: String -> M ()
64 problem str = do lift $ putStrLn str
66 put $ st { stHadAProblem = True }
68 doit :: String -> [FilePath] -> IO ()
70 = do (hIn, hOut, hErr, ph) <- runInteractiveProcess
71 "grep" ("-h" : function : files)
74 strOut <- hGetContents hOut
75 strErr <- hGetContents hErr
76 forkIO $ do evaluate (length strOut)
78 forkIO $ do evaluate (length strErr)
80 ec <- waitForProcess ph
87 check :: String -> String -> IO ()
89 = do let ls = lines str
90 -- filter out lines that start with whitespace. They're
93 -- ..., <function>, ...
94 ls' = filter (not . all isSpace . take 1) ls
95 ns <- mapM (parseLine function) ls'
96 st <- execStateT (do mapM_ use ns
98 when (Set.null (stSeen st)) $
99 problem "No values found")
101 when (stHadAProblem st) exitFailure
103 parseLine :: String -> String -> IO Int
104 parseLine function str
105 = -- words isn't necessarily quite right, e.g. we could have
106 -- "var=" rather than "var =", but it works for the code
109 _var : "=" : fun : numStr : rest
111 null rest || "--" == head rest,
112 [(num, "")] <- reads numStr
114 _ -> error ("Bad line: " ++ show str)