treemap-html-tools (empty) → 0.1

raw patch · 4 files changed

+168/−0 lines, 4 filesdep +Cabaldep +basedep +containerssetup-changed

Dependencies added: Cabal, base, containers, directory, filepath, ghc, parsec, regex-posix, split, treemap-html

Files

LICENSE +27/−0
Setup.hs +2/−0
src/dirmap.hs +96/−0
treemap-html-tools.cabal +43/−0

+ LICENSE view

@@ -0,0 +1,27 @@+Copyright (c) Radoslav Dorcik 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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,2 @@+import Distribution.Simple+main = defaultMain

+ src/dirmap.hs view

@@ -0,0 +1,96 @@+import Data.List+import Data.Maybe+import Control.Monad +import System.FilePath +import System.Environment+import System.Directory+import Data.Tree+import Text.HTML.TreeMap+import System.Console.GetOpt++maxNameLen = 15++data LsDirOpts = LsDirOpts { lsMaxName :: Int+                           , lsMaxDep  :: Maybe Int+                           , lsFiles   :: Bool+                           , lsEmptyDir :: Bool }++defLsOpts :: LsDirOpts+defLsOpts = LsDirOpts maxNameLen Nothing False True++data Flag = Verbose  +          | Level String+          | MaxName String+          | Files+          | NoEmptyDir+          | Output String deriving Show++options :: [OptDescr Flag]+options =+    [ Option ['v']     ["verbose"] (NoArg Verbose)                       "verbose output on stderr"+    , Option ['l']     ["level"]   (ReqArg (Level)  "Integer")           "maxlevel for recursive directory listing"+    , Option ['n']     ["name"]    (ReqArg (MaxName) "Integer")          "maximum size of filename. than truncation."+    , Option ['o']     ["output"]  (ReqArg (Output) "FILE")              "output FILE"+    , Option ['f']     ["files"]   (NoArg Files)                         "include files in listing"+    , Option ['e']     []          (NoArg NoEmptyDir)                    "do not included subtrees without files"+    ]++checkOpts :: [String] -> IO ([Flag], [String])+checkOpts argv = +    case getOpt Permute options argv of+      (o,[],[] ) -> ioError (userError (usageInfo header options))+      (o,n,[]  ) -> return (o,n)+      (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))+    where header = "Usage: dirmap [OPTION...] directory"++lsOpts :: [Flag] -> LsDirOpts+lsOpts xs = foldr (procFlag) defLsOpts xs +    where+      procFlag (Level l)  o = if null l then o else o { lsMaxDep = Just (read l :: Int) }+      procFlag Files      o = o { lsFiles = True }+      procFlag (MaxName n) o = o { lsMaxName = (read n :: Int) }+      procFlag NoEmptyDir o = o { lsEmptyDir = False }+      procFlag _          o = o++filename :: [Flag] -> FilePath+filename []             = "dirmap.html"+filename ((Output d):_) = d+filename (_:xs)         = filename xs++main = do+  args <- getArgs+  (flags,names) <- checkOpts args+  print flags+  print names+  dirTree <- lsDirTree (lsOpts flags) (head names)+  putStrLn $ drawTree $ dirTree+  writeFile (filename flags) (treeMap dirTree)+  putStrLn $ "Written: "++(filename flags)++lsDirTree :: LsDirOpts -> String -> IO (Tree String)+lsDirTree opts@(LsDirOpts _ (Just 0) _ _) dir = return $ Node ((shortName opts dir) </> "...") []+lsDirTree opts dir = do +  entries <- liftM (filterDots) (getDirectoryContents dir)+  dirEnts <- filterM (\x -> doesDirectoryExist (dir </> x)) entries +  fileEnts <- filterM (\x -> liftM not $ doesDirectoryExist (dir </> x)) entries+  let files = if (lsFiles opts) then fileEnts else []+  subTrees <- mapM (\x -> lsDirTree (decDep opts) (dir </> x)) dirEnts+  let subTreesM = if (lsEmptyDir opts) then subTrees else filter hasFiles subTrees +  let dirNode = Node ((shortName opts dir) ++ "/") (subTreesM ++ (map (\x -> Node (shortName opts x) []) files))+  return dirNode++hasFiles :: Tree String -> Bool+hasFiles xs = let ys = flatten xs+                  isFile [] = False+                  isFile x = (last x) /= '/'+              in any (isFile) (concatMap lines ys)++shortName opts x = let name = last $ splitPath x+                       maxNL = lsMaxName opts+                   in if length name > maxNL then (take maxNL name) ++ "..." else name++filterDots = filter (\e -> e /="." && e /= "..")++decDep :: LsDirOpts -> LsDirOpts+decDep opts@(LsDirOpts _ Nothing _ _)      = opts+decDep opts@(LsDirOpts _ (Just (x+1)) _ _) = opts { lsMaxDep = Just x }

+ treemap-html-tools.cabal view

@@ -0,0 +1,43 @@+name:            treemap-html-tools+version:         0.1+license:         BSD3+license-file:    LICENSE+author:          Radoslav Dorcik <radoslav.dorcik@gmail.com>+maintainer:      Radoslav Dorcik <radoslav.dorcik@gmail.com>+description:     Contains various commands for TreeMap generation,+                 for example dirmap produces the foldable treemap for+                 given directory tree structure. +synopsis:        Treemap related commands for producing foldable TreeMap HTML.+category:        Graphics+stability:       provisional+build-type:      Simple+cabal-version:   >= 1.6++Homepage:        http://rampa.sk/static/treemap-html.html+Source-Repository head+  type:     darcs+  location: http://patch-tag.com/r/dixiecko/treemap-html-tools++flag testing+  description: Enable Debugging things like QuickCheck properties, etc.+  default: False++library+  build-depends:   ghc          >= 6.10,+                   base         == 4.*,+                   split        == 0.1.*,+                   parsec       == 2.1.0.*,+                   regex-posix,          +                   treemap-html,+                   directory,+                   filepath,+                   containers,+                   Cabal        >= 1.5 && < 1.9+  hs-source-dirs:  src+  extensions:      CPP, PatternGuards, DeriveDataTypeable ++executable dirmap+  main-is: dirmap.hs+  hs-source-dirs:  src+  extensions:      CPP, PatternGuards, DeriveDataTypeable +