diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2012, Ivan Perez - Keera Studios + +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 Ivan Perez 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/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/clean-home.cabal b/clean-home.cabal new file mode 100644 --- /dev/null +++ b/clean-home.cabal @@ -0,0 +1,79 @@ +-- clean-home.cabal auto-generated by cabal init. For additional +-- options, see +-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. +-- The name of the package. +Name: clean-home + +-- The package version. See the Haskell package versioning policy +-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for +-- standards guiding when and how versions should be incremented. +Version: 0.0.1 + +-- A short (one-line) description of the package. +Synopsis: Keep your home dir clean by finding old conf files +Description: clean-home searches for config files in your $HOME + that no installed package/program will need. + +-- URL for the project homepage or repository. +Homepage: https://github.com/ivanperez-keera/clean-home + +-- The license under which the package is released. +License: BSD3 + +-- The file containing the license text. +License-file: LICENSE + +-- The package author(s). +Author: Ivan Perez + +-- An email address to which users can send suggestions, bug reports, +-- and patches. +Maintainer: ivan.perez@keera.es + +-- A copyright notice. +-- Copyright: + +Category: System + +Build-type: Simple + +Data-files: data/PkgList + , data/PrgList + +-- Extra files to be distributed with the package, such as examples or +-- a README. +-- Extra-source-files: + +-- Constraint on the version of Cabal needed to build this package. +Cabal-version: >=1.6 + + +Executable clean-home + Main-is: Main.hs + hs-source-dirs: src/ + ghc-options: -Wall + + -- Packages needed in order to build this package. + Build-depends: base >= 4 && <= 5 + , cmdargs >= 0.9 + , HSH >= 2.0 + , directory + , containers >= 0.4 + , IfElse + + -- Modules not exported by this package. + Other-modules: SearchCommand.Apt + , SearchCommand.Which + , SearchCommand.UserSet + , SearchCommands + , Args + , Env + , Control.Exception.Extra + , System.Err + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: + +source-repository head + type: git + location: http://github.com/ivanperez-keera/clean-home diff --git a/data/PkgList b/data/PkgList new file mode 100644 --- /dev/null +++ b/data/PkgList @@ -0,0 +1,46 @@ +[ (".cabal", [ "cabal", "cabal-install" ]) +, (".emacs", [ "emacs", "emacs21", "emacs22", "emacs23" ]) +, (".emacs.d", [ "emacs", "emacs21", "emacs22", "emacs23"]) +, (".mozilla", [ "firefox", "iceweasel" ]) +, (".lftp", [ "lftp" ]) +, (".mission-control", [ "mission-control" ]) +, (".viminfo", [ "vim", "vim-gnome" ]) +, (".vim", [ "vim", "vim-gnome" ]) +, (".vimrc", [ "vim", "vim-gnome" ]) +, (".wine", [ "wine", "wine1.2", "wine1.3" ]) +, (".eclipse", [ "eclipse" ]) +, (".kde", [ "kde" ]) +, (".libreoffice", [ "libreoffice" ]) +, (".openoffice.org", [ "openoffice" ]) +, (".VirtualBox", [ "virtualbox-ose" ]) +, (".ssh", [ "openssh-client" ]) +, (".xmind", [ "xmind" ]) +, (".gSTM", [ "gstm" ]) +, (".bashrc", [ "bash" ]) +, (".bash_logout", [ "bash" ]) +, (".bash_profile", [ "bash" ]) +, (".bash_history", [ "bash" ]) +, (".gimp-2.6", [ "gimp" ]) +, (".hgrc", [ "mercurial" ]) +, (".gconfd", [ "gconf2" ]) +, (".subversion", [ "subversion" ]) +, (".lyx", [ "lyx" ]) +, (".thunderbird", [ "thunderbird" ]) +, (".xine", [ "xine-ui" ]) +, (".lesshst", [ "less" ]) +, (".gitconfig", [ "git" ]) +, (".Skype", [ "skype" ]) +, (".gem", [ "rubygems" ]) +, (".mplayer", [ "mplayer" ]) +, (".aptitude", [ "aptitude" ]) +, (".sqlite_history", [ "sqlite3" ]) +, (".shotwell", [ "shotwell" ]) +, (".ghc", [ "ghc" ]) +, (".gvfs", [ "gvfs" ]) +, (".mysql_history", [ "mysql-client" ]) +, (".audacity-data", [ "audacity" ]) +, (".xournal", [ "xournal" ]) +, (".qtstalker", [ "qtstalker" ]) +, (".icedteaplugin", [ "icedtea-plugin" ]) +, (".gnupg", [ "gnupg" ]) +] diff --git a/data/PrgList b/data/PrgList new file mode 100644 --- /dev/null +++ b/data/PrgList @@ -0,0 +1,47 @@ +[ (".cabal", [ "cabal", "cabal-install" ]) +, (".emacs", [ "emacs", "emacs21", "emacs22", "emacs23" ]) +, (".emacs.d", [ "emacs", "emacs21", "emacs22", "emacs23"]) +, (".lftp", [ "lftp" ]) +, (".mission-control", [ "mission-control" ]) +, (".mozilla", [ "firefox", "iceweasel" ]) +, (".viminfo", [ "vim", "gvim" ]) +, (".diamondcard-sms", [ "keera-diamondcard-sms-trayicon"]) +, (".vim", [ "vim", "gvim" ]) +, (".vimrc", [ "vim", "gvim" ]) +, (".wine", [ "wine" ]) +, (".eclipse", [ "eclipse" ]) +, (".kde", [ "kde" ]) +, (".libreoffice", [ "libreoffice" ]) +, (".openoffice.org", [ "openoffice" ]) +, (".VirtualBox", [ "virtualbox-ose" ]) +, (".ssh", [ "openssh-client" ]) +, (".xmind", [ "xmind" ]) +, (".gSTM", [ "gstm" ]) +, (".bashrc", [ "bash" ]) +, (".bash_logout", [ "bash" ]) +, (".bash_profile", [ "bash" ]) +, (".bash_history", [ "bash" ]) +, (".gimp-2.6", [ "gimp" ]) +, (".hgrc", [ "mercurial" ]) +, (".gconfd", [ "gconf2" ]) +, (".subversion", [ "subversion" ]) +, (".lyx", [ "lyx" ]) +, (".thunderbird", [ "thunderbird" ]) +, (".xine", [ "xine" ]) +, (".lesshst", [ "less" ]) +, (".gitconfig", [ "git" ]) +, (".Skype", [ "skype" ]) +, (".gem", [ "rubygems" ]) +, (".mplayer", [ "mplayer" ]) +, (".aptitude", [ "aptitude" ]) +, (".sqlite_history", [ "sqlite3" ]) +, (".shotwell", [ "shotwell" ]) +, (".ghc", [ "ghc" ]) +, (".gvfs", [ "gvfs" ]) +, (".mysql_history", [ "mysql-client" ]) +, (".audacity-data", [ "audacity" ]) +, (".xournal", [ "xournal" ]) +, (".qtstalker", [ "qtstalker" ]) +, (".icedteaplugin", [ "icedtea-plugin" ]) +, (".gnupg", [ "gnupg" ]) +] diff --git a/src/Args.hs b/src/Args.hs new file mode 100644 --- /dev/null +++ b/src/Args.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Args where + +import Data.Data +import System.Console.CmdArgs + +-- This is the CLI app definition : what we get from the user +data Args = Args { + showNotOrphan :: Bool + , byPackage :: Bool + , byProgram :: Bool + , pkgSearchProg :: String + , pkgSearchArgs :: [String] + , pkgSearchExitCode :: Bool + + -- To be added + -- home :: String -- Use this dir instead of the current + -- -- user's home dir + -- , verbose :: Bool -- Show everything you do + -- , ignore :: [String] -- Ignore these filepaths + -- , remove :: Bool -- Give users the option to remove orphan fps + } + deriving (Show, Data, Typeable) + +-- This is the cmdArgs-based CLI interface definition +chArgs :: Args +chArgs = Args + { showNotOrphan = False + &= explicit + &= name "show-not-orphan" + &= help "Whether dirs with an owning program show be shown" + + , byPackage = enum [ True &= explicit &= name "by-package" + &= help "Search by package name (enabled by default)" + , False &= explicit &= name "not-by-package" + &= help "Do not search by package name" + ] + -- &= explicit + -- &= name "by-package" + -- &= help "Search the responsible program by package name" + + , byProgram = enum [ True &= explicit &= name "by-program" + &= help "Search by program name (enabled by default)" + , False &= explicit &= name "not-by-program" + &= help "Do not search by program name" + ] + + , pkgSearchProg = def + &= explicit + &= name "with-pkg-search" + &= help "Program used to search for packages" + &= typ "PROGRAM" + + , pkgSearchArgs = def + &= explicit + &= name "with-pkg-search-opt" + &= help "Arguments passed to pkg-search program" + &= typ "ARG" + + , pkgSearchExitCode = False + &= explicit + &= name "with-pkg-search-exit-code" + &= help "Use program exit code to determine package presence" + + } + &= summary "clean-home 0.0.1" + &= details [ "(c) 2012 Ivan Perez - Keera Studios" + , "Find more about clean-home at http://keera.es" + , "and http://github.com/ivanperez-keera/clean-home" + ] diff --git a/src/Control/Exception/Extra.hs b/src/Control/Exception/Extra.hs new file mode 100644 --- /dev/null +++ b/src/Control/Exception/Extra.hs @@ -0,0 +1,13 @@ +module Control.Exception.Extra where + +import qualified Control.Exception as E + +-- | Returns a given computation ignoring an exception +anyway :: a -> E.SomeException -> a +anyway f _ = f + +-- | Tries to execute all the IO computations +-- until one succeeds +trySeq :: [IO ()] -> IO () +trySeq [] = return () +trySeq (x:xs) = E.handle (anyway (trySeq xs)) x diff --git a/src/Env.hs b/src/Env.hs new file mode 100644 --- /dev/null +++ b/src/Env.hs @@ -0,0 +1,59 @@ +module Env where + +import Control.Monad +import Control.Exception as E +import Control.Exception.Extra + +import Args +import System.Err +import Paths_clean_home + +data Env = Env + { appArgs :: Args + , pkgList :: PkgList + , prgList :: PrgList + } + +type PrgList = [ (String, [ String ]) ] +type PkgList = [ (String, [ String ]) ] + +type ConfigSearchCmd = Env -> FilePath -> String -> IO (Either String Bool) + +-- | Reads and returns the program list contained in +-- the file PrgList. +readPrgList :: Args -> IO (Maybe PrgList) +readPrgList appArgs + | byProgram appArgs = readListFP "data/PrgList" "program list" + | otherwise = return $ Just [] + +-- | Reads and returns the package list contained in +-- the file PrgList. +readPkgList :: Args -> IO (Maybe PkgList) +readPkgList appArgs + | byPackage appArgs = readListFP "data/PkgList" "package list" + | otherwise = return $ Just [] + +readListFP :: Read a => FilePath -> String -> IO (Maybe [a]) +readListFP fn n = do + fp <- getDataFileName fn + list <- E.handle (anyway (return [])) $ + liftM reads $ readFile fp + case list of + [] -> do putErrLn $ "Cannot read or parse " ++ n + return Nothing + ((x,_):_) -> return (Just x) + +-- FIXME: MaybeT? +buildEnv :: Args -> IO (Maybe Env) +buildEnv appArgs + | not (pkg || prg) + = do putErrLn "You must enable --by-package or --by-program" + return Nothing + | otherwise + = do pkgList <- readPkgList appArgs + prgList <- readPrgList appArgs + case (pkgList, prgList) of + (Just pkgs, Just prgs) -> return $ Just $ Env appArgs pkgs prgs + _ -> return Nothing + where pkg = byPackage appArgs + prg = byProgram appArgs diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,65 @@ +-- | This program checks every file/dir in $HOME against +-- a list of know programs/packages to determine whether +-- we have any program installed that may need it. + +import Control.Monad.IfElse +import Data.List +import qualified Data.Map as M +import System.Directory +import System.Console.CmdArgs + +-- Local imports +import Args +import Env +import SearchCommands +import System.Err + +main :: IO () +main = do + -- Process args and build an env + env <- buildEnv =<< cmdArgs chArgs + awhen env $ \env' -> + -- Get config files and check them + mapM_ (checkFile env') =<< getHomeConfFiles env' + +-- | Gets the list of filepaths that may be config paths +getHomeConfFiles :: Env -> IO [FilePath] +getHomeConfFiles _env = do + homeDir <- getHomeDirectory + names <- getDirectoryContents homeDir + return $ filter isConfigPath $ sort names + where isConfigPath :: String -> Bool + isConfigPath x = x `notElem` [".", ".."] && "." `isPrefixOf` x + +-- Checks a file using all the know programs and packages +-- that may be responsible for it +checkFile :: Env -> FilePath -> IO () +checkFile env fp = checkFile' env fp allChks + where allChks = prgChks' ++ pkgChks' + pkgChks' = if byPackage (appArgs env) then pkgChks else [] + prgChks' = if byProgram (appArgs env) then prgChks else [] + pkgChks = map (checkPackage env fp) pkgs + prgChks = map (checkProgram env fp) prgs + pkgs = packageSearch env fp + prgs = programSearch env fp + +-- | Prints a message indicating that the file is orphan (when it is) +-- and shows error messages when appropriate +checkFile' :: Env -> FilePath -> [IO (Either String Bool)] -> IO () +checkFile' _env fp [] = putErrLn $ "Warning: Orphan dir: " ++ fp +checkFile' env fp (x:xs) = do + res <- x + case res of + (Left s) -> putErrLn s + (Right False) -> checkFile' env fp xs + (Right True) -> return () + +-- | Search config cp and return associated packages +packageSearch :: Env -> String -> [ String ] +packageSearch env k = M.findWithDefault [] k (M.fromList pkgs) + where pkgs = pkgList env + +-- | Search config cp and return associated programs +programSearch :: Env -> String -> [ String ] +programSearch env k = M.findWithDefault [] k (M.fromList prgs) + where prgs = prgList env diff --git a/src/SearchCommand/Apt.hs b/src/SearchCommand/Apt.hs new file mode 100644 --- /dev/null +++ b/src/SearchCommand/Apt.hs @@ -0,0 +1,18 @@ +module SearchCommand.Apt where + +import Data.List + +-- Local imports +import Env +import SearchCommand.UserSet + +aptSearch :: ConfigSearchCmd +aptSearch env fp pkg = userSetSearchCustom + (Left "apt-get exited with error code") + (\results -> not (null results) && any ((pkg ++ " -") `isPrefixOf`) results) + cmd env fp pkg + where cmd = ("apt-cache", [ "search" + , "--installed" + , "--names-only" + , "^" ++ pkg ++ "$"] + ) diff --git a/src/SearchCommand/UserSet.hs b/src/SearchCommand/UserSet.hs new file mode 100644 --- /dev/null +++ b/src/SearchCommand/UserSet.hs @@ -0,0 +1,54 @@ +module SearchCommand.UserSet + ( userSetSearch + , userSetSearchExitCode + , userSetSearchOutput + , userSetSearchCustom + , userSetSearchCombined + ) + where + +-- External imports +import Control.Monad +import Control.Exception as E +import Control.Exception.Extra +import HSH + +-- Local imports +import Args +import Env +import System.Err + +userSetSearch :: ConfigSearchCmd +userSetSearch env fp pkg + | pkgSearchExitCode (appArgs env) = userSetSearchExitCode cmd env fp pkg + | otherwise = userSetSearchOutput cmd env fp pkg + where cmd = (pkgSearchProg (appArgs env), + pkgSearchArgs (appArgs env) ++ [ pkg ] + ) + +type CMD = (String, [String]) + +userSetSearchExitCode :: CMD -> ConfigSearchCmd +userSetSearchExitCode = userSetSearchCustom (Right False) (const True) + +userSetSearchOutput :: CMD -> ConfigSearchCmd +userSetSearchOutput cmd env fp pkg = + userSetSearchCustom (Left (pkg ++ " exited with error code")) + (not.null) + cmd env fp pkg + +userSetSearchCombined :: CMD -> ConfigSearchCmd +userSetSearchCombined = userSetSearchCustom (Right False) (not.null) + +userSetSearchCustom :: Either String Bool + -> ([String] -> Bool) + -> CMD + -> ConfigSearchCmd +userSetSearchCustom exceptRet test cmd env fp pkg = + E.handle (anyway (return exceptRet)) $ do + results <- run cmd :: IO [String] + let notOrphan = test results + when (notOrphan && showNotOrphan (appArgs env)) $ + putErrLn $ pkg ++ " might be responsible for " ++ fp + return $ Right notOrphan + diff --git a/src/SearchCommand/Which.hs b/src/SearchCommand/Which.hs new file mode 100644 --- /dev/null +++ b/src/SearchCommand/Which.hs @@ -0,0 +1,9 @@ +module SearchCommand.Which where + +-- Local imports +import Env +import SearchCommand.UserSet + +whichSearch :: ConfigSearchCmd +whichSearch env fp prg = userSetSearchCombined cmd env fp prg + where cmd = ("which", [ prg ]) diff --git a/src/SearchCommands.hs b/src/SearchCommands.hs new file mode 100644 --- /dev/null +++ b/src/SearchCommands.hs @@ -0,0 +1,17 @@ +module SearchCommands where + +-- Local imports +import Args +import Env +import SearchCommand.Apt +import SearchCommand.Which +import SearchCommand.UserSet + +-- FIXME: The problem is here +checkPackage :: ConfigSearchCmd +checkPackage env fp pkg + | null (pkgSearchProg (appArgs env)) = aptSearch env fp pkg + | otherwise = userSetSearch env fp pkg + +checkProgram :: ConfigSearchCmd +checkProgram = whichSearch diff --git a/src/System/Err.hs b/src/System/Err.hs new file mode 100644 --- /dev/null +++ b/src/System/Err.hs @@ -0,0 +1,9 @@ +module System.Err where + +import System.IO + +putErr :: String -> IO() +putErr = hPutStr stderr + +putErrLn :: String -> IO() +putErrLn = hPutStrLn stderr