hothasktags 0.3.1 → 0.3.2
raw patch · 2 files changed
+100/−26 lines, 2 filesdep +cmdargsdep ~cpphsdep ~haskell-src-exts
Dependencies added: cmdargs
Dependency ranges changed: cpphs, haskell-src-exts
Files
- Main.hs +96/−23
- hothasktags.cabal +4/−3
Main.hs view
@@ -1,13 +1,14 @@+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE PatternGuards #-} module Main where import qualified Language.Haskell.Exts.Annotated as L-import System.Environment (getArgs)-import System.IO (hPutStrLn, stderr)+import System.Console.CmdArgs+import System.IO (hPutStrLn, stderr, stdout, IOMode(..), openFile, hClose) import qualified Data.Map as Map import qualified Language.Preprocessor.Cpphs as CPP-import Control.Monad (forM, when)+import Control.Monad (forM) import Data.List (sort) import Data.Maybe (fromMaybe) import System.FilePath.Posix (takeFileName)@@ -39,7 +40,7 @@ extractPat (L.PVar _ name) = extractName name extractPat (L.PApp _ _ pats) = concatMap extractPat pats- extractPat (L.PTuple _ pats) = concatMap extractPat pats+ extractPat (L.PTuple _ _ pats) = concatMap extractPat pats extractPat (L.PList _ pats) = concatMap extractPat pats extractPat (L.PParen _ pat) = extractPat pat extractPat (L.PAsPat _ name pat) = extractName name ++ extractPat pat@@ -172,21 +173,43 @@ makeTags :: FilePath -> Map.Map String Defn -> [String] makeTags refFile = map (makeTag refFile) . Map.assocs -haskellSource :: FilePath -> IO String-haskellSource file = do+haskellSource :: [L.Extension] -> HotHasktags -> FilePath -> IO String+haskellSource exts conf file = do contents <- readFile file- let needsCpp = maybe False (L.CPP `elem`) (L.readExtensions contents)- if needsCpp- then CPP.runCpphs cppOpts file contents- else return contents+ let needsCpp = not . null $+ [ ()+ | Just (_language, extsFile) <- [L.readExtensions contents],+ L.EnableExtension L.CPP <- extsFile ]+ ++ [ () | L.EnableExtension L.CPP <- exts ]+ if not needsCpp+ then return contents+ else do+ cppOpts <- either recoverCppOptFail return+ (CPP.parseOptions (hh_cpphs conf))+ CPP.runCpphs (addOpts cppOpts) file contents where- cppOpts = CPP.defaultCpphsOptions { CPP.boolopts = CPP.defaultBoolOptions { CPP.hashline = False } }- + addOpts defOpts = defOpts+ { CPP.boolopts = (CPP.boolopts defOpts) { CPP.hashline = False },+ CPP.defines = map splitDefines (hh_define conf) ++ CPP.defines defOpts,+ CPP.includes = hh_include conf ++ CPP.includes defOpts } -makeDatabase :: [FilePath] -> IO Database-makeDatabase files = do- fmap (Map.fromList . concat) . forM files $ \file -> do- result <- L.parseFileContentsWithMode (mode file) `fmap` haskellSource file+ recoverCppOptFail err = do+ hPutStrLn stderr $ "cpphs parse error arguments:" ++ err+ return CPP.defaultCpphsOptions+++ splitDefines :: String -> (String,String)+ splitDefines s = let (a,b) = break (=='=') s+ in (a, case drop 1 b of+ [] -> "1"+ b' -> b')+ + +makeDatabase :: [L.Extension] -> HotHasktags -> IO Database+makeDatabase exts conf = do+ fmap (Map.fromList . concat) . forM (hh_files conf) $ \file -> do+ result <- L.parseFileContentsWithMode (mode file)+ `fmap` haskellSource exts conf file case result of L.ParseOk mod@(L.Module _ (Just (L.ModuleHead _ (L.ModuleName _ name) _ _)) _ _ _) -> do return [(name, mod)]@@ -198,21 +221,71 @@ where mode filename = L.ParseMode { L.parseFilename = filename,- L.extensions = [L.MultiParamTypeClasses, L.ExistentialQuantification, L.FlexibleContexts],+ L.extensions = exts, L.ignoreLanguagePragmas = False, L.ignoreLinePragmas = False,- L.fixities = Nothing+ L.fixities = Nothing,+ L.baseLanguage = L.Haskell2010 } moduleFile :: L.Module L.SrcSpanInfo -> FilePath moduleFile (L.Module (L.SrcSpanInfo (L.SrcSpan file _ _ _ _) _) _ _ _ _) = file moduleFile _ = error "Wtf is an XmlPage/XmlHybrid?" +data HotHasktags = HotHasktags {+ hh_files, hh_language, hh_define, hh_include, hh_output, hh_cpphs :: [String] }+ deriving (Data,Typeable,Show)++defaultHotHasktags :: HotHasktags+defaultHotHasktags = HotHasktags { + hh_files = []+ &= args+ &= typ "FILE",+ hh_language = []+ &= help "Additional language extensions to use when parsing a file. \+ \LANGUAGE pragmas are currently obeyed. Always includes at least \+ \MultiParamTypeClasses ExistentialQuantification \+ \and FlexibleContexts"+ &= name "X",+ hh_define = []+ &= name "D"+ &= help "Define for cpphs. -Dx is a shortcut for the flags -c -Dx",+ hh_include = []+ &= name "I"+ &= typ "DIR"+ &= help "Add a directory to where cpphs looks for .h includes. Note that \+ \paths are currently interpreted as relative to the directory \+ \containing the source file \+ \-Ifoo is a shortcut for -c -Ifoo",+ hh_output = []+ &= name "output" &= name "O"+ &= explicit+ &= typ "FILE"+ &= help "Name of output file. Default is to write to stdout",+ hh_cpphs = []+ &= name "cpp" &= name "c"+ &= explicit+ &= help "Pass the next argument as an option for cpphs. For example:\n\+ \`hothasktags -c --strip -XCPP foo.hs'\+ \ see `cpphs --help`"}+ main :: IO () main = do- files <- getArgs- when (null files) $ do- hPutStrLn stderr $ "Usage: hothasktags <file1> <file2> ..."- database <- makeDatabase files + conf <- cmdArgs defaultHotHasktags+ let exts = map L.classifyExtension $ hh_language conf +++ words "MultiParamTypeClasses ExistentialQuantification FlexibleContexts"+ case unwords [ ext | L.UnknownExtension ext <- exts ] of+ [] -> return ()+ unknown -> hPutStrLn stderr $ "Unknown extensions on command line: "+ ++ unknown+ database <- makeDatabase exts conf let tags = sort $ concatMap (\mod -> makeTags (moduleFile mod) (moduleScope database mod)) (Map.elems database)- mapM_ putStrLn tags+ handle <- case (hh_output conf) of+ [] -> return stdout+ file:_ -> openFile file WriteMode++ mapM_ (hPutStrLn handle) tags++ case (hh_output conf) of+ [] -> return ()+ _ -> hClose handle
hothasktags.cabal view
@@ -1,5 +1,5 @@ name: hothasktags-version: 0.3.1+version: 0.3.2 cabal-version: >= 1.6 build-type: Simple author: Luke Palmer <lrpalmer@gmail.com>@@ -37,7 +37,8 @@ base == 4.*, containers, filepath,- haskell-src-exts >= 1.11 && < 1.14,- cpphs >= 1.11 && < 1.17+ haskell-src-exts >= 1.14,+ cpphs >= 1.11 && < 1.19,+ cmdargs main-is: Main.hs ghc-options: -W