cabalgraph (empty) → 0.1
raw patch · 4 files changed
+303/−0 lines, 4 filesdep +Cabaldep +basedep +bytestringsetup-changed
Dependencies added: Cabal, base, bytestring, containers, directory, filepath, pretty, process
Files
- LICENSE +30/−0
- Main.hs +220/−0
- Setup.lhs +3/−0
- cabalgraph.cabal +50/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2008 Don Stewart++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 AUTHORS ``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.
+ Main.hs view
@@ -0,0 +1,220 @@+-- |+-- Module : cabalgraph: graph sets of modules from cabal packages+-- Copyright : (c) Don Stewart, 2009+-- License : BSD3+--+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability:+--++import Distribution.Package+import Distribution.PackageDescription+import Distribution.PackageDescription.Parse+import Distribution.PackageDescription.Configuration+import Distribution.Simple.Utils hiding (die, intercalate)+import Distribution.Verbosity+import Distribution.ModuleName hiding (main)+import Distribution.Version+import Distribution.Package+import Distribution.License+import Distribution.Text+import Distribution.Compiler+import Distribution.System+import Distribution.Simple.PackageIndex++import qualified Text.PrettyPrint as Disp++import Control.Monad+import Control.Concurrent+import Control.Exception+import qualified Control.OldException as C++import System.Directory+import System.Environment+import System.Exit+import System.FilePath+import System.IO+import System.Process hiding (cwd)++import Data.List+import Data.Maybe+import qualified Data.Map as M+import Data.Monoid+import Data.Char+import Debug.Trace++main :: IO ()+main =+ bracket+ -- We do all our work in a temp directory+ (do cwd <- getCurrentDirectory+ etmp <- myReadProcess "mktemp" ["-d"] []+ case etmp of+ Left _ -> die "Unable to create temp directory"+ Right d -> do+ let dir = makeValid (init d) -- drop newline+ setCurrentDirectory dir+ return (dir, cwd))++ -- Always remember to clean up+ (\(d,cwd) -> do+ setCurrentDirectory cwd+ removeDirectoryRecursive d)++ -- Now, get to work:+ $ \(tmp,cwd) -> do++ res <- do x <- getArgs+ case x of+ ["--help"] -> help+ ["-h"] -> help+ (f:fs) -> return (f:fs)++ modules' <- forM res $ \f -> do++ cabalfile <- findCabalFile f cwd tmp+ cabalsrc <- readPackageDescription normal cabalfile+ let ms = case condLibrary cabalsrc of+ Just x -> exposedModules (condTreeData x)+ _ -> error "This is not a library package"+ return ms++ let modules = concat modules'++ -- printing++ putStrLn "strict graph graphname {"++ mapM_ putStrLn (map ppr modules)++ putStrLn "}"++ppr :: ModuleName -> String+ppr ms =+ Disp.render $ Disp.hcat+ $ intersperse (Disp.text " -- ")+ [ Disp.doubleQuotes (Disp.text (intercalate "." x))+ | x <- tail (inits (components ms)) ]+++{-+ D -- D.B -- D.B.C++ strict graph graphname {+ Data -- ByteString+ Data -- ByteString -- Char8+ Data -- ByteString -- Unsafe+ Data -- ByteString -- Internal+ Data -- ByteString -- Lazy+ Data -- ByteString -- Lazy -- Char8+ Data -- ByteString -- Lazy -- Internal+ Data -- ByteString -- Fusion+ }++ -}+++-- Return the path to a .cabal file.+-- If not arguments are specified, use ".",+-- if the argument looks like a url, download that+-- otherwise, assume its a directory+--+findCabalFile :: FilePath -> FilePath -> FilePath -> IO FilePath+findCabalFile file cwd tmp = do+ let epath | null file+ = Right cwd+ | "http://" `isPrefixOf` file+ = Left file+ | ".cabal" `isSuffixOf` file+ = Right (makeValid (joinPath [cwd,file]))+ | otherwise -- a relative directory path+ = Right (cwd </> file)++ -- download url to .cabal+ case epath of+ Left url -> do+ eres <- myReadProcess "wget" [url] []+ case eres of+ Left (_,s,_) -> do+ hPutStrLn stderr s+ die $ "Couldn't download .cabal file: " ++ show url+ Right _ ->+ findPackageDesc tmp -- tmp dir -- error: only allows one url on the command line++ -- it might be a .cabal file+ Right f | ".cabal" `isSuffixOf` f -> do+ b <- doesFileExist f+ if not b+ then die $ ".cabal file doesn't exist: " ++ show f+ else return f++ -- or assume it is a dir to a file:+ Right dir -> do+ b <- doesDirectoryExist dir+ if not b+ then die $ "directory doesn't exist: " ++ show dir+ else findPackageDesc dir++die :: String -> IO a+die s = do+ hPutStrLn stderr $ "cabalgraph:\n" ++ s+ exitWith (ExitFailure 1)++help :: IO a+help = do+ hPutStrLn stderr $ unlines+ [ "cabalgraph: [-h|--help] [directory|url]"+ , ""+ , " Generate graphs for .cabal files in <directory> or at <url>"+ , ""+ , "Usage:"+ , " -h Display help message"+ , ""+ , "Arguments: <directory>"+ , " Look for .cabal file in <directory>"+ , " If directory is empty, use pwd"+ , " <file.cabal>"+ , " Use .cabal file as source"+ , " <url>"+ , " Download .cabal file from <url>"+ ]+ exitWith ExitSuccess++------------------------------------------------------------------------++--+-- Strict process reading +--+myReadProcess :: FilePath -- ^ command to run+ -> [String] -- ^ any arguments+ -> String -- ^ standard input+ -> IO (Either (ExitCode,String,String) String) -- ^ either the stdout, or an exitcode and any output++myReadProcess cmd args input = C.handle (return . handler) $ do+ (inh,outh,errh,pid) <- runInteractiveProcess cmd args Nothing Nothing++ output <- hGetContents outh+ outMVar <- newEmptyMVar+ forkIO $ (C.evaluate (length output) >> putMVar outMVar ())++ errput <- hGetContents errh+ errMVar <- newEmptyMVar+ forkIO $ (C.evaluate (length errput) >> putMVar errMVar ())++ when (not (null input)) $ hPutStr inh input+ takeMVar outMVar+ takeMVar errMVar+ ex <- C.catch (waitForProcess pid) (\_e -> return ExitSuccess)+ hClose outh+ hClose inh -- done with stdin+ hClose errh -- ignore stderr++ return $ case ex of+ ExitSuccess -> Right output+ ExitFailure _ -> Left (ex, errput, output)++ where+ handler (C.ExitException e) = Left (e,"","")+ handler e = Left (ExitFailure 1, show e, "")+
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ cabalgraph.cabal view
@@ -0,0 +1,50 @@+name: cabalgraph+version: 0.1+homepage: http://code.haskell.org/~dons/code/cabalgraph+synopsis: Generate pretty graphs of module trees from cabal files+description: + Generate pretty graphs of module trees from cabal files+ .+ Graph exposed modules from .cabal files in some directories: + .+ > $ cabalgraph a b c d | dot -Tpng | xv -+ .+ Results in a graph like: <http://code.haskell.org/~dons/images/dot.png>+ .+ Graph exposed modules from a url:+ . + > $ cabalgraph http://code.haskell.org/xmonad/xmonad.cabal | circo -Tpng | xv -+ . + Results in a graph like: <http://code.haskell.org/~dons/images/xmonad-dot.png>++category: Distribution+license: BSD3+license-file: LICENSE+author: Don Stewart+maintainer: dons@galois.com+cabal-version: >= 1.2+build-type: Simple++flag small_base+ description: Choose the new smaller, split-up base package.++executable cabalgraph+ main-is: Main.hs+ ghc-options: -Wall++ if flag(small_base)+ build-depends: + base >= 4 && < 5,+ pretty,+ process,+ directory,+ containers,+ bytestring+ else+ build-depends: + base < 3++ build-depends:+ Cabal > 1.6,+ filepath+