summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoeyAdams <>2012-04-02 08:23:45 (GMT)
committerhdiff <hdiff@luite.com>2012-04-02 08:23:45 (GMT)
commit874f841291dee45b27ab36a58cfe08a6f643d91a (patch)
treea17f01f21365cb31453b42035227a011507a1cf5
version 0.1HEAD0.1master
-rw-r--r--CountLines.hs112
-rw-r--r--LICENSE30
-rw-r--r--Main.hs102
-rw-r--r--Setup.hs2
-rw-r--r--recursive-line-count.cabal44
5 files changed, 290 insertions, 0 deletions
diff --git a/CountLines.hs b/CountLines.hs
new file mode 100644
index 0000000..a0bda21
--- /dev/null
+++ b/CountLines.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE RecordWildCards #-}
+module CountLines (
+ countLines,
+ Entry(..),
+ EntryType(..),
+) where
+
+import Prelude hiding (catch)
+
+import Control.Arrow ((>>>))
+import Control.Exception
+import Control.Monad.Reader
+import Data.Int (Int64)
+import Data.Maybe (catMaybes)
+import Data.Tree
+import GHC.Exts (groupWith)
+import System.FilePath
+import System.IO
+
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy.Internal as LI
+
+data Entry
+ = Entry
+ { entryType :: EntryType
+ , entryName :: String
+ , entryPath :: FilePath
+ , entryLineCount :: !Int64
+ }
+
+instance Show Entry where
+ showsPrec d Entry{..}
+ = showParen (d > 10)
+ $ showString "Entry "
+ . showsPrec 11 entryType
+ . showString " "
+ . showsPrec 11 entryName
+ . showString " "
+ . showsPrec 11 entryLineCount
+
+data EntryType = File | Directory
+ deriving (Eq, Show)
+
+logError :: String -> IO ()
+logError = hPutStrLn stderr
+
+logIOError :: IOError -> IO ()
+logIOError = logError . show
+
+-- | File path separated into entry names using 'splitDirectories'.
+type Path = [FileName]
+
+type FileName = FilePath
+
+-- | Reader monad with context that prepends parent elements to a path,
+-- thus indicating the current directory of our traversal.
+type CountLinesM = ReaderT (Path -> Path) IO
+
+countLines :: [FilePath] -> IO (Forest Entry, Int64)
+countLines = map splitDirectories
+ >>> filter (not . null)
+ >>> countLinesForest
+ >>> (`runReaderT` id)
+
+getFullPath :: Path -> CountLinesM FilePath
+getFullPath path = fmap (\f -> joinPath $ f path) ask
+
+countLinesLBS :: L.ByteString -> Int64
+countLinesLBS LI.Empty = 0
+countLinesLBS (LI.Chunk x0 lbs0) =
+ loop 0 x0 lbs0
+ where
+ loop !n x lbs = case lbs of
+ LI.Empty ->
+ n + fromIntegral (S.count lf x + fromEnum (S.last x /= lf))
+ LI.Chunk x' xs ->
+ loop (n + fromIntegral (S.count lf x)) x' xs
+
+ lf = 10
+
+-- | Count lines in a single file.
+countLinesFile :: FileName -> CountLinesM (Maybe Entry)
+countLinesFile name = do
+ full_path <- getFullPath [name]
+ liftIO $ (fmap (Just . Entry File name full_path) $
+ L.readFile full_path >>= evaluate . countLinesLBS)
+ `catch` \e -> do
+ logIOError e
+ return Nothing
+
+-- | None of the paths given may be empty.
+countLinesForest :: [Path] -> CountLinesM (Forest Entry, Int64)
+countLinesForest paths = do
+ forest <- fmap catMaybes $
+ forM (groupWith head paths) $ \g ->
+ -- g :: [Path] is a list of paths that all
+ -- have the same root FileName.
+ countLinesTree (head $ head g) (map tail g)
+ let !total = sum $ map (entryLineCount . rootLabel) forest
+ return (forest, total)
+
+countLinesTree :: FileName -> [Path] -> CountLinesM (Maybe (Tree Entry))
+countLinesTree _ [] = error "countLinesTree: Empty path list"
+countLinesTree filename [[]] = fmap (fmap (\entry -> Node entry []))
+ $ countLinesFile filename
+countLinesTree dirname children = do
+ (child_nodes, total) <- local (. (dirname :))
+ $ countLinesForest children
+ dirpath <- getFullPath [dirname]
+ return $ Just $ Node (Entry Directory dirname dirpath total) child_nodes
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..181c7d3
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2012, Joseph Adams
+
+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 Joseph Adams nor the names of other
+ 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 EVENT SHALL THE COPYRIGHT
+OWNER 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.
diff --git a/Main.hs b/Main.hs
new file mode 100644
index 0000000..1f7d62a
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,102 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
+import Control.Monad (forM_)
+import CountLines
+import Data.List (sortBy)
+import Data.Function (on)
+import Data.Tree
+import Graphics.UI.Gtk
+ hiding (on)
+import System.IO (hClose)
+import System.Process
+
+import qualified Graphics.UI.Gtk as Gtk
+
+editFile :: FilePath -> IO ()
+editFile path = do
+ (Just stdin, Just stdout, Just stderr, _) <-
+ createProcess (proc "xdg-open" [path])
+ { std_in = CreatePipe
+ , std_out = CreatePipe
+ , std_err = CreatePipe
+ }
+ mapM_ hClose [stdin, stdout, stderr]
+
+sortTree :: (a -> a -> Ordering) -> Tree a -> Tree a
+sortTree cmp (Node root forest) = Node root (sortForest cmp forest)
+
+sortForest :: (a -> a -> Ordering) -> Forest a -> Forest a
+sortForest cmp xs = map (sortTree cmp) $ sortBy (cmp `on` rootLabel) xs
+
+main :: IO ()
+main = do
+ (forest, total) <- fmap lines getContents >>= countLines
+
+ -- Display the tree on the console
+ -- putStr $ drawForest $ map (fmap show) forest
+ -- putStrLn $ "Total line count: " ++ show total
+
+ -- The following is based on TreeDemo.hs in the
+ -- Gtk2Hs source distribution.
+
+ initGUI
+
+ win <- windowNew
+ windowSetDefaultSize win 500 500
+ onDestroy win mainQuit
+
+ vbox <- vBoxNew False 0
+ label <- labelNew $ Just $ "Total line count: " ++ show total
+ miscSetAlignment label 0.0 0.5
+ miscSetPadding label 5 0
+ boxPackStart vbox label PackNatural 5
+ containerAdd win vbox
+
+ model <- treeStoreNew $ sortForest (flip compare `on` entryLineCount) forest
+ view <- treeViewNewWithModel model
+
+ treeViewSetHeadersVisible view True
+
+ colFileName <- treeViewColumnNew
+ colNumberOfLines <- treeViewColumnNew
+
+ forM_ [colFileName, colNumberOfLines] $ \col -> do
+ treeViewColumnSetResizable col True
+ treeViewColumnSetExpand col True
+
+ treeViewColumnSetTitle colFileName "Name"
+ treeViewColumnSetTitle colNumberOfLines "Line count"
+
+ rendererFileName <- cellRendererTextNew
+ rendererNumberOfLines <- cellRendererTextNew
+
+ cellLayoutPackStart colFileName rendererFileName True
+ cellLayoutPackStart colNumberOfLines rendererNumberOfLines True
+
+ cellLayoutSetAttributes colFileName rendererFileName model $ \Entry{..} ->
+ [ cellText := entryName ]
+ cellLayoutSetAttributes colNumberOfLines rendererNumberOfLines model $ \Entry{..} ->
+ [ cellText := show entryLineCount ]
+
+ treeViewAppendColumn view colFileName
+ treeViewAppendColumn view colNumberOfLines
+
+ Gtk.on view rowActivated $ \path _ -> do
+ Entry{..} <- treeStoreGetValue model path
+ if entryType == File
+ then editFile entryPath
+ else do
+ e <- treeViewRowExpanded view path
+ _ <- if e
+ then treeViewCollapseRow view path
+ else treeViewExpandRow view path False
+ return ()
+
+ scroll <- scrolledWindowNew Nothing Nothing
+ scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic
+
+ containerAdd scroll view
+ containerAdd vbox scroll
+
+ widgetShowAll win
+ mainGUI
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/recursive-line-count.cabal b/recursive-line-count.cabal
new file mode 100644
index 0000000..54702b5
--- /dev/null
+++ b/recursive-line-count.cabal
@@ -0,0 +1,44 @@
+name: recursive-line-count
+version: 0.1
+synopsis: Count lines in files and display them hierarchically
+description:
+ This program can be used to count lines of code in a program and display
+ them hierarchically. For example, to tally up lines of Haskell code in a
+ git repository:
+ .
+ >git ls-files '*.hs' | recursive-line-count
+ .
+ More precisely, @recursive-line-count@ takes a list of file names on
+ standard input, counts lines in each file, and displays the results in a
+ GtkTreeView.
+ .
+ Note that although this package is BSD3-licensed, it has LGPL dependencies.
+homepage: https://github.com/joeyadams/haskell-recursive-line-count
+license: BSD3
+license-file: LICENSE
+author: Joey Adams
+maintainer: joeyadams3.14159@gmail.com
+copyright: Copyright (c) Joseph Adams 2012
+category: Tools
+build-type: Simple
+cabal-version: >=1.8
+
+source-repository head
+ type: git
+ location: git://github.com/joeyadams/haskell-recursive-line-count.git
+
+executable recursive-line-count
+ main-is: Main.hs
+
+ other-modules:
+ CountLines
+
+ build-depends: base == 4.*
+ , containers
+ , gtk
+ , process
+ , mtl >= 2
+ , filepath
+ , bytestring
+
+ ghc-options: -Wall -fwarn-tabs