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 ()