parse.hs

module Main where
import Data.Map (Map)
import qualified Data.Map as M
import System.IO
import System.Environment
import Language.Haskell.Exts.Annotated
import Control.DeepSeq
import Control.Monad
import Debug.Trace

main :: IO ()
main = do
  args <- getArgs
  let (f, moduleBasePath) = case args of
                              (file:basePath:_) -> (file, basePath)
                              _ -> error "No argument"
      unwrapParse :: ParseResult (Module a) -> Module a
      unwrapParse parseResult = case parseResult of
                            ParseOk x -> x
                            ParseFailed loc msg -> error $ "parse failed at loc: " ++ show loc ++ " " ++ msg

      toImportDecls parseResult = case parseResult of
                                    Module _ _ _ importDecl _ -> importDecl
                                    _ -> error "XmlPage and XmlHybrid unsupported"
      dotSub = map $ \x -> case x of
                             '.' -> '/'
                             other -> other
      toImportPaths importDecls = map (\decl -> moduleBasePath ++ dotSub (moduleNameToStr $ importModule decl) ++ ".hs") importDecls
      getImportDecls :: Module a -> [FilePath]
      getImportDecls mod = toImportPaths $ toImportDecls mod
      moduleNameToStr (ModuleName _ str) = str
      parse :: FilePath -> IO (Module SrcSpanInfo)
      parse path = do
         putStrLn $ "parsing " ++ path
         r <- parseFile path
         return $ unwrapParse r
      go :: Map FilePath (Module SrcSpanInfo) -> [FilePath] -> IO (Map FilePath (Module SrcSpanInfo))
      go acc (x:xs) = do
         case M.member x acc of
           True -> go acc xs
           False -> do
             mod <- parse x
             decls <- return $ getImportDecls mod
             let acc' = M.insert x mod acc -- insert the current module into the acc map
             go acc' $ filter (\x -> M.member x acc' == False) decls ++ xs -- push the include list into the remaining list, without repetition
      go acc [] = return acc
  allModules <- fmap (fmap $ fmap (const ())) $ go M.empty [f]
  mapM_ (\x -> putStrLn (show x ++ "\n")) allModules
  return ()