{-# LANGUAGE PatternSignatures, RankNTypes #-}
module Main where
import System.Environment
import System.Exit
import System.IO
import Control.Monad ()
import Control.Monad.Error as Err
import Data.List
import Text.PrettyPrint.HughesPJ
import Data.Tree
import Data.Maybe (fromMaybe)
import Language.C import Language.C.Data.Node
import GenericTree
import SourceBrowser
usageMsg :: String -> String
usageMsg prg = render $
text "Usage:" <+> text prg <+> hsep (map text ["input_file.i"])
errorOnLeftM :: (MonadError e m, Err.Error e, Show a) => String -> m (Either a b) -> m b
errorOnLeftM msg action = either (throwError . strMsg . showWith) return =<< action
where showWith s = msg ++ ": " ++ (show s)
main :: IO ()
main = do
let usageErr = (hPutStrLn stderr (usageMsg "./Annotate") >> exitWith (ExitFailure 1))
args <- getArgs
c_file <- case args of
[a1] -> return a1
_ -> usageErr
ast <- errorOnLeftM "Parse Error" (parseCFilePre c_file)
let groups = groupAstBySourceFile ast
putStrLn . drawTree . fmap show . (uncurry treeView) $ last groups
runGTK (map (uncurry treeView) groups) c_file
groupAstBySourceFile :: CTranslUnit -> [(FilePath,CTranslUnit)]
groupAstBySourceFile (CTranslUnit decls _) =
map (\decls -> (fileOfNode' (head decls), CTranslUnit decls (topNodePos decls))) .
groupBy (\a b -> (fileOfNode' a) == fileOfNode' b) $ decls
where
fileOfNode' = maybe "<no-file>" id . fileOfNode
topNodePos decls =
let lastDecl = nodeInfo (last decls) in
mkNodeInfoPosLen (posOf (head decls)) (getLastTokenPos lastDecl)