hssourceinfo (empty) → 0.0.2

raw patch · 6 files changed

+257/−0 lines, 6 filesdep +basedep +containersdep +directorysetup-changed

Dependencies added: base, containers, directory, filepath, regexpr

Files

LICENSE +27/−0
Setup.hs +3/−0
hssourceinfo.cabal +53/−0
src/HsModTree.hs +107/−0
src/hscodelines.hs +52/−0
src/hsmodtree.hs +15/−0

+ LICENSE view

@@ -0,0 +1,27 @@+Copyright (c) 2011, Yoshikuni Jujo+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++  * Redistributions of source code must retain the above copyright notice,+    this list of conditions and the following disclaimer.++  * Redistributions in binary form must reproduce the above copyright+    notice, this list of conditions and the following disclaimer in the+    documentation and/or other materials provided with the distribution.++  * Neither the name of the Yoshikuni Jujo nor the names of its+    contributors may be used to endorse or promote products derived from+    this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVEN SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

+ hssourceinfo.cabal view

@@ -0,0 +1,53 @@+build-type:	Simple+cabal-version:	>= 1.6++name:		hssourceinfo+version:	0.0.2+stability:	experimental+author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp>+maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>++license:	BSD3+license-file:	LICENSE++category:	Development+synopsis:	get haskell source code info+description:+  now only module dependencies and code line numbers+  .+  > % hsmodtree xturtle/src+  > Graphics.X11.Turtle+  >   + Graphics.X11.TurtleMove+  >   |   + Graphics.X11.TurtleState+  >   |   + Graphics.X11.TurtleField+  >   + Graphics.X11.TurtleInput+  >   |   + Grahpics.X11.TurtleState+  >   + Graphics.X11.TurtleShape++  > % hscodeline xturtle/src+  > Graphics/X11/Turtle.hs          158+  > Graphics/X11/TurtleMove.hs      82+  > Graphics/X11/TurtleState.hs     54+  > Graphics/X11/TurtleField.hs     428+  > Graphics/X11/TurtleInput.hs     76+  > Graphics/X11/TurtleShape.hs     10+  > total                           808+++source-repository	head+  type:		git+  location:	git://github.com/YoshikuniJujo/hssourceinfo.git++executable		hsmodtree+  Hs-Source-Dirs:	src+  Main-Is:		hsmodtree.hs+  Build-Depends:	base >= 4 && < 5, containers, directory, regexpr+  Ghc-Options:		-Wall+  Other-Modules:	HsModTree++executable		hscodelines+  Hs-Source-Dirs:	src+  Main-Is:		hscodelines.hs+  Build-Depends:	base >= 4 && < 5, containers, directory, regexpr, filepath+  Ghc-Options:		-Wall+  Other-Modules:	HsModTree

+ src/HsModTree.hs view

@@ -0,0 +1,107 @@+module HsModTree where++import Text.RegexPR+import System.Directory+import Data.List+import Data.Tree+import System.Environment+import Control.Monad+import Control.Arrow(first)++{-+main :: IO ()+main = do+	[ dir ] <- getArgs+	files <- fmap filterSource $ getDirectoryContentsRec dir+	dependList <- mapM ( depend dir files ) files+	let depList = map (first $ gsubRegexPR "/" ".") dependList+	mapM_ ( putStr . showTree [ ] . nubTree ) $+		mergeTree $ map makeTree depList+-}+++getDirectoryContentsRec, getDirectoryContentsRecGen :: String -> IO [String]+getDirectoryContentsRec root = do+	pre <- getCurrentDirectory+	setCurrentDirectory root+	ret <- getDirectoryContentsRecGen "."+	setCurrentDirectory pre+	return $ map (tail . tail) ret+getDirectoryContentsRecGen root = do+	ps <- getDir root+	files <- filterM (doesFileExist . (root ++) . ("/" ++)) ps+	dirs <- filterM (doesDirectoryExist . (root ++) . ("/" ++)) ps+	subs <- fmap concat $ mapM (getDirectoryContentsRecGen . mkPath) dirs+	return $ map mkPath files ++ subs+--	roots <- fmap concat $ mapM (getDir . mkPath) dirs+	where+	mkPath = (root ++) . ("/" ++)+	getDir = fmap (filter $ flip notElem [".", ".."]) . getDirectoryContents++showTree :: [ Bool ] -> Tree String -> String+showTree n ( Node x ns ) =+	makePre ( reverse n ) ++ x ++ "\n" +++		( concatMap ( showTree ( True : n ) ) ( init ns ) +++		maybe "" ( showTree ( False : n ) ) ( last ns ) )+	where+	init [ ] = [ ]+	init [ x ] = [ ]+	init ( x : xs ) = x : init xs+	last [ ] = Nothing+	last [ x ] = Just x+	last ( _ : xs ) = last xs+	makePre [ ] = ""+	makePre [ _ ] = "  + "+	makePre ( True  : rest ) = "  | " ++ makePre rest+	makePre ( False : rest ) = "    " ++ makePre rest++nubTree :: Eq a => Tree a -> Tree a+nubTree ( Node x ns ) = Node x $ nub $ map nubTree ns++makeTree :: Eq a => ( a, [ a ] ) -> Tree a+makeTree ( x, xs ) = Node x $ map ( flip Node [ ] ) xs++mergeTree :: Eq a => [ Tree a ] -> [ Tree a ]+mergeTree ts = case map fst $ filter snd $ map ( `addTree_` ts ) ts of+	[ ]	-> ts+	new	-> mergeTree new++addTree_ :: Eq a => Tree a -> [ Tree a ] -> ( Tree a, Bool )+addTree_ t@( Node x _ ) ts = addTree t $ filter ( ( /= x ) . rootLabel ) ts++addTree :: Eq a => Tree a -> [ Tree a ] -> ( Tree a, Bool )+addTree ( Node x ns ) ts = case filter ( ( == x ) . rootLabel ) ts of+	[ ]	-> ( Node x $ map fst rets, any snd rets )+	t : _	-> ( t, True )+	where+	rets = map ( `addTree` ts ) ns++depend :: FilePath -> [ String ] -> String -> IO ( String, [ String ] )+depend dir fps fp = do+	cnt <- readAnyFile [ dir ++ "/" ++ fp ++ ".hs", dir ++ "/" ++ fp ++ ".y" ]+	return ( fp, map ( !! 1 ) $ ggetbrsRegexPR ( mkReg fps ) cnt )++filterSource :: [ FilePath ] -> [ FilePath ]+filterSource =+	map stripSuffix . filter ( isSuffixOf ".hs" ||| isSuffixOf ".y" ) .+	filter ( not . isPrefixOf "." )++mkReg :: [ FilePath ] -> String+mkReg fps_ =+	"^import\\s+(?:qualified\\s+)?(" ++ intercalate "|" fps ++ ")($|\\s|\\()"+	where+	fps = map (gsubRegexPR "/" ".") fps_++stripSuffix :: String -> String+stripSuffix = takeWhile ( /= '.' )++initN :: Int -> [ a ] -> [ a ]+initN n = ( !! n ) . iterate init++(|||) :: ( a -> Bool ) -> ( a -> Bool ) -> a -> Bool+( f1 ||| f2 ) x = f1 x || f2 x++readAnyFile :: [ FilePath ] -> IO String+readAnyFile ( f : fs ) = do+	ex <- doesFileExist f+	if ex then readFile f else readAnyFile fs

+ src/hscodelines.hs view

@@ -0,0 +1,52 @@+module Main where++import System.Environment+import Control.Arrow(first)+import Text.RegexPR+import Data.Tree+import Data.List+import Data.Char+import HsModTree+import System.FilePath++main :: IO ()+main = do+	[ dir ] <- getArgs+	files <- fmap filterSource $ getDirectoryContentsRec dir+	dependList <- mapM ( depend dir files ) files+	let	depList = map (first $ gsubRegexPR "/" ".") dependList+		trees = map nubTree $ mergeTree $ map makeTree depList+	mapM_ (printModTreeLines dir) $ map (nub . flatten) trees++printModTreeLines :: FilePath -> [String] -> IO ()+printModTreeLines dir mns = do+	s <- fmap sum $ mapM (printModLines dir) mns+	putStrLn $ "total" ++ replicate 27 ' ' ++ show s+	putStrLn ""++printModLines :: FilePath -> String -> IO Int+printModLines dir mn = do+	let fp = modNameToFilePath mn+	lns <- fileLines dir fp+	putStrLn $ showModLines fp lns+	return lns++showModLines :: FilePath -> Int -> String+showModLines fp lns = fp ++ replicate (32 - length fp) ' ' ++ show lns++fileLines :: FilePath -> FilePath -> IO Int+fileLines dir = fmap codeLines . readFile . (dir </>)++modNameToFilePath :: String -> FilePath+modNameToFilePath = (++ ".hs") . gsubRegexPR "\\." "/"++codeLines :: String -> Int+codeLines code = length $ filter (not . all isSpace) $ lines $ deleteComms code++deleteComms :: String -> String+deleteComms = subRegexPR "module\\s+(.|\n)*?\\s+where" "" .+		gsubRegexPR "--.*\n" "" .+		gsubRegexPR "{-(?:[^-]|-(?!}))*-}" ""++testDeleteComms :: FilePath -> IO ()+testDeleteComms fp = readFile fp >>= putStr . deleteComms

+ src/hsmodtree.hs view

@@ -0,0 +1,15 @@+module Main where++import System.Environment+import Control.Arrow(first)+import Text.RegexPR+import HsModTree++main :: IO ()+main = do+	[ dir ] <- getArgs+	files <- fmap filterSource $ getDirectoryContentsRec dir+	dependList <- mapM ( depend dir files ) files+	let depList = map (first $ gsubRegexPR "/" ".") dependList+	mapM_ ( putStr . showTree [ ] . nubTree ) $+		mergeTree $ map makeTree depList