Parser.hs

   1 module Main (main) where
   2 import Language.Haskell.Syntax
   3 import Language.Haskell.Pretty
   4 import Language.Haskell.Parser
   5 import GHC
   6
   7 main =
   8   do
   9     let filename = "adder.hs"
  10     -- Read the file
  11     file <- readFile filename
  12     -- Parse the file
  13     let mode = ParseMode {parseFilename = filename}
  14         ParseOk mod = parseModuleWithMode mode file
  15     -- Print funky stuff
  16     --putStr $ foldl (\s d -> s ++ (show d) ++ "\n\n") "" (decls mod)
  17     putList (findfunc "exp_adder" (decls mod))
  18
  19 decls (HsModule _ _ _ _ decls) =
  20   decls
  21
  22 name (HsModule _ n _ _ _) =
  23   n
  24
  25 findfunc ::
  26             String        -- Function name to find
  27          -> [HsDecl]      -- Decls to search
  28          -> [HsMatch]
  29
  30 findfunc name decls = foldl (findmatches name) [] decls
  31
  32 -- Look at a HsDecl and add all HsMatches in it with the sought name to res
  33 findmatches name res (HsFunBind matches) = res ++ filter (filtermatch name) matches
  34 findmatches name res _ = res
  35
  36 -- Look at a single match and see if it has the sought name
  37 filtermatch name (HsMatch _ (HsIdent n) _ _ _) =
  38   n == name
  39
  40 -- Print a list of showable things, separated by newlines instead of ,
  41 -- Also pretty prints them
  42 putList :: (Show a, Pretty a) => [a] -> IO ()
  43 putList (x:xs) =
  44   do
  45     indent 0 (show x)
  46     putStr "\n"
  47     putStr $ prettyPrint x
  48     putStr "\n\n"
  49     putList xs
  50
  51 putList [] =
  52   do return ()
  53
  54 -- Add indentations to the given string
  55 indent :: Int -> String -> IO ()
  56 indent n (x:xs) = do
  57   if x `elem` "[("
  58     then do
  59       putChar x
  60       putStr "\n"
  61       putStr (replicate (n + 1) ' ')
  62       indent (n + 1) xs
  63     else if x `elem` "])"
  64       then do
  65         putStr "\n"
  66         putStr (replicate (n - 1) ' ')
  67         putChar x
  68         indent (n - 1) xs
  69       else do
  70         putChar x
  71         indent n xs
  72
  73 indent n [] = do return ()
  74
  75 -- vim: set ts=8 sw=2 sts=2 expandtab: