diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,27 @@ +Copyright (c) Calvin Smith + +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. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,34 @@ +import System.Environment(getArgs, getProgName) +import System.Exit(exitFailure) +import Control.Monad(when) +import System.Denominate + +usage = getProgName >>= \name -> + return ("Usage: " ++ name ++ " base_directory") >>= + putStrLn >> exitFailure + +main = do + getArgs >>= \args -> + when (doUsageAndExit args) usage >> + (fileToTypedFilePath . base) args >>= + renameAll defaultFilenameConverter >>= + mapM_ handle + +-- Get base dir to recurse in and ensure there is no terminal '/'. +base [] = error "Main.base" +base (d:_) = + case d == "/" of + True -> d + False -> if (head revD) /= '/' + then d + else reverse $ tail revD + where revD = reverse d + +handle result = + case result of + (Failure (_, fName) msg) -> putStr msg >> putStr " [" >> + putStr fName >> putStrLn "]" + (Success _ _ ) -> return () + +doUsageAndExit args = null args || arg0 == "-h" || arg0 == "--help" + where arg0 = head args diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,13 @@ +import Distribution.Simple +import Distribution.PackageDescription (PackageDescription) +import Distribution.Simple.LocalBuildInfo (LocalBuildInfo, buildDir) +import System.Exit +import Control.Monad +import System.Process + +main :: IO () +main = defaultMainWithHooks (defaultUserHooks { runTests = test }) + +test :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO () +test _ _ _ _ = runCommand commandStr >>= waitForProcess >> return () + where commandStr = "./quickcheck +names System/Denominate_Test.hs" diff --git a/System/Denominate.hs b/System/Denominate.hs new file mode 100644 --- /dev/null +++ b/System/Denominate.hs @@ -0,0 +1,295 @@ +{- | +Module : $Header$ +Description : Supports bulk renaming of directories and files into a + standard, normalized format. +Copyright : (c) Calvin Smith +License : BSD3, see LICENSE.txt + +Maintainer : Calvin Smith +Stability : Experimental +Portability : portable + +Functions to assist in renaming of directories and files into a +standard, normalized format. + +This module defines several functions supporting renaming of files +and directories, and is especially useful for doing a bulk renaming +of all files and directories, recursively, in a given base directory. + +The primary functions of interest are 'rename' and 'renameAll', both +of which accept a function for creating the new filename based on its +current name. The user may supply a custom filename converter function, +or may use the pre-defined function that this module defines. + +The standard pre-defined converter determines the new name for a file +or directory using the following rules: + + 1. all letters are converted to lowercase; + + 2. all non-alphanumeric characters at the beginning of a file or + directory name are removed (with the exception of an initial '.'); + + 3. all non-alphanumeric characters at the end of a directory name + or the end of a filename (before the extension) are removed; + + 4. all other blocks of one or more non-alphanumeric characters are + converted to a single hyphen. + +See the documentation of the exported functions for more information. +-} + +module System.Denominate (FileType(Directory, File), + RenameResult(Success, Failure), + TypedFilePath, FilenameConverter, + normalizeFilename, allFilepaths, + rename, renameAll, + fileToTypedFilePath, defaultFilenameConverter) +where + +import System.Directory +import System.FilePath +import System.IO +import Data.Char +import Data.List +import Control.Monad +import Control.Exception + +-- |Represents the type of a file or directory. These are exhaustive, +-- as for purposes of this module, we consider everything that isn't +-- a directory to be a file. +data FileType = Directory | File + deriving (Eq, Show, Enum, Ord) + +-- |Represents the result of a rename attempt, which either fails or +-- succeeds. In both cases, the typed file path is that of the file +-- for which a rename attempt was made. Upon failure, the string +-- parameter contains information about the error (may have been an +-- os-level error or user error); upon success, the string parameter +-- is the name to which the file was renamed (which includes the case +-- that no change was performed because old and new names were equal). +data RenameResult = Failure TypedFilePath String | + Success TypedFilePath String + deriving (Eq, Show) + +-- |Represents a filepath together with the type of file to which +-- the path refers. +type TypedFilePath = (FileType, FilePath) + +-- |A filename converter maps an old filename to a new filename. A converter +-- takes a typed file representing a directory name or a filename without +-- extension, and only needs to determine the new name based on the old name. +-- It does not need to worry about extracting the file path from an absolute +-- path or determining the file extension, as all functions in this module +-- that use a FilenameConverter will only pass in typed files containing +-- the last directory (if a directory) or the filename without extension +-- if a file. +type FilenameConverter = TypedFilePath -> FilePath + +-- |Rename a single file or directory using the supplied filename converter, +-- which will be passed just the directory name (without any parent +-- directories or a terminal slash) in the case of a directory or just +-- the filename without the extension in the case of a file. If there +-- already exists a file with the intended new name, nothing is done. If +-- the new name is the same as the old name (not considering file extension), +-- then the function successfully returns without touching the filesystem. +-- In all cases where a file is renamed, the extension of a file will be +-- automatically converted to lowercase but otherwise remains the +-- same (no characters are ever removed from the extension). +rename :: FilenameConverter -> TypedFilePath -> IO (RenameResult) +rename convFunc f@(_, oldPath) = + let + newPath = normalizeFilename convFunc f + fail f msg = return (Failure f msg) + in + case (oldPath == newPath) of + True -> return (Success f oldPath) + _ -> do exists <- fileExists newPath + if exists + then fail f "WARN: File already exists with new name." + else doRenameSafe f newPath + +-- |Renames the old file or directory to the new path, returning +-- a result that indicates success or failure. If successful, +-- the name of the new file is the success message; if unsuccessful, +-- the failure message gives more information. +doRenameSafe :: TypedFilePath -> FilePath -> IO RenameResult +doRenameSafe f newPath = + handle (\exc -> return (Failure f ("ERROR: " ++ show exc))) + (doRename f newPath >> (return (Success f newPath))) + where + doRename :: TypedFilePath -> FilePath -> IO() + doRename (fileType, oldPath) newPath = + case fileType of + Directory -> renameDirectory oldPath newPath + File -> renameFile oldPath newPath + +-- |Rename all files and directories, recursively, in the given directory, +-- using the supplied filename converter to determine the new name of each +-- file or directory. The converter function will be called once for each +-- file or directory, and will be passed just the directory name (without +-- the parent directories) in the case of a directory or just the filename +-- without the extension in the case of a file. The extension of files (but +-- not directories if they seem to have an extension) will be converted to +-- lower case, but is not otherwise changed. There will be one RenameResult +-- for each success or failure, and an indication of the reason for failure +-- for failures, or the new name in case of success. +renameAll :: FilenameConverter -> TypedFilePath -> IO ([RenameResult]) +renameAll fn baseDir = (allFilepaths . snd) baseDir >>= mapM (rename fn) + +-- |Determine if the filename does not represent a dot file ("." or ".."). +isNotDotFile :: FilePath -> Bool +isNotDotFile = not . flip elem [".", ".."] + +-- |Determine whether there exists a file or directory with the given path. +fileExists :: FilePath -> IO Bool +fileExists path = do + b1 <- doesDirectoryExist path + b2 <- doesFileExist path + return (b1 || b2) + +-- |Generate a list of all files and directories below the given directory, +-- in depth-first order such that all files in a given directory appear +-- before the directory or any of its parent directories. +allFilepaths :: FilePath -> IO [TypedFilePath] +allFilepaths dir = do + -- get [TypedFilePath] for files in this dir, dirs sorted before files + dirTypedFilePaths <- getFilesAndDirectories dir + -- get [TypedFilePath] for each subdir in this dir + subDirTypedFilePaths <- mapM + (allFilepaths . snd) $ + filter (isDirectoryFileType . fst) dirTypedFilePaths + -- concatenate all the subdir paths with the paths from this dir + return (prepend subDirTypedFilePaths dirTypedFilePaths) + +-- |Get a list of files and directories, as TypedFilePath, for the given +-- directory, with directories sorted before files. +getFilesAndDirectories :: String -> IO [TypedFilePath] +getFilesAndDirectories dir = + getDirectoryContents dir >>= + filterM (return . isNotDotFile) >>= + return . map (joinFileName dir) >>= + mapM fileToTypedFilePath >>= + return . sortPaths + +-- |Converts a list of lists and a list into a single list, +-- ensuring that all items of the single list are *after* +-- all items from the list of lists. E.g., +-- prepend [[1,2], [3,4], [5,6,7]] [66,67] == [1,2,3,4,5,6,7,66,67] +prepend :: [[a]] -> [a] -> [a] +prepend [] out = out +prepend (x:xs) out = x ++ prepend xs out + +-- |Determine whether the given FileType is Directory. +isDirectoryFileType :: FileType -> Bool +isDirectoryFileType Directory = True +isDirectoryFileType _ = False + +-- |Convert a filepath to a TypedFilePath. A Directory is a file +-- for which Directory.doesDirectoryExist returns true. If the path +-- does not represent a directory, it is considered a file, and there +-- is no further testing to verify that a file with that path actually +-- exists. +fileToTypedFilePath :: FilePath -> IO TypedFilePath +fileToTypedFilePath filepath = + doesDirectoryExist filepath >>= \b -> + case b of + True -> return (Directory, filepath) + False -> return (File, filepath) + +-- |Sort the paths in a given directory by putting all directories first +-- and then sorting by path within each type. It is designed for sorting +-- all files and directories in the top level of a directory, and will +-- probably not provide a useful ordering if full paths are used. +sortPaths :: [TypedFilePath] -> [TypedFilePath] +sortPaths = sortBy compareTypedFilePaths + +-- |Compare two typed file paths, using the built-in ordering of +-- FileType (dir before file) and path. +compareTypedFilePaths :: TypedFilePath -> TypedFilePath -> Ordering +compareTypedFilePaths (f1type, f1path) (f2type, f2path) = + case typeComp of + EQ -> compare f1path f2path + _ -> typeComp + where typeComp = compare f1type f2type + +-- |Normalize the filename of the given typed file path using the +-- supplied FilenameConverter function, which will be passed the +-- directory name (without parent directories) in case of a directory +-- or the filename (without any parent directories or the extension) +-- in case of a file. This function takes care of extracting the part +-- of the path that is to be normalized, calling the user-supplied +-- function with only that part, and then reassembling the +-- result of the filename converter into a full path again. +normalizeFilename :: FilenameConverter -> TypedFilePath -> String +normalizeFilename fn (fileType, origPath) = + let (dir, filenameWithExt) = dirAndFile origPath + (filenameNoExt, ext) = if fileType == Directory + then (filenameWithExt, "") + else fileAndExt filenameWithExt + newFilenameNoExt = fn (fileType, filenameNoExt) + result = joinFileName dir $ joinFileExt (if null newFilenameNoExt + then filenameNoExt + else newFilenameNoExt) (map toLower ext) + in if null result then origPath else result + +-- |The default filename converter, which normalizes a filename by +-- converting letters to lowercase and converting one or more undesirable +-- characters into a single hyphen (or removing altogether if at the +-- beginning or the end of the name). The only exception to these rules +-- is that an initial dot of a filename is not removed. +defaultFilenameConverter :: FilenameConverter +defaultFilenameConverter (_, path) = if isDotFile then ('.':result) else result + where result = convert' Initial path + isDotFile = not (null path) && head path == '.' + +convert' :: State -> String -> String +convert' _ [] = [] +convert' currState (i:is) = + case (currState, nextState) of + (HyphenBlock, NormalBlock) -> '-' : chr : rest + (_ , NormalBlock) -> chr : rest + (_ , _ ) -> rest + where + rest = convert' nextState is + (emitted, nextState) = transition currState i + chr = toLower $ maybe (error "FilenameNormalizer.normalize'") id emitted + + +-- |The state of finite state machine for normalizing. +data State = Initial -- initial state, until enter normal + | HyphenBlock -- in block of chars to hyphenate + | NormalBlock -- in block of normal chars to lowercase + deriving (Eq, Show, Enum) + +-- |The transition function of the fsm. The transition rules are +-- very simple: if we see a normal character, we always emit it +-- and transition to normal state. If we see a non-normal character, +-- we never emit it, and we stay in initial state if currently +-- in initial state, or else transition to hyphen state. +-- The normalize' function above takes care of emitting the +-- hyphen when we transition from hyphen to normal. +transition :: State -> Char -> (Maybe Char, State) +transition currState c + | isAlphaNum c = (Just c, NormalBlock) + | otherwise = (Nothing, nonNormalState) + where nonNormalState = case currState of + Initial -> Initial + _ -> HyphenBlock + +joinFileName :: String -> String -> String +joinFileName dirpath filename = joinPath [dirpath, filename] + +joinFileExt :: String -> String -> String +joinFileExt filename ext = addExtension filename ext + +-- |Split path into directory part (without slash) and file part. +dirAndFile :: FilePath -> (String, String) +dirAndFile path = splitFileName path + +-- |Split file path into filename and ext. If +fileAndExt :: FilePath -> (String, String) +fileAndExt filename = + case splitExtension filename of + ([], ext) -> (ext, []) + (file, ext) -> (file, ext) + diff --git a/denominate.cabal b/denominate.cabal new file mode 100644 --- /dev/null +++ b/denominate.cabal @@ -0,0 +1,40 @@ +name: denominate +version: 0.4.1 +cabal-version: >= 1.2 +license: BSD3 +license-file: LICENSE.txt +author: Calvin Smith +copyright: (c) Calvin Smith +maintainer: cs-haskell@protempore.net +homepage: http://protempore.net/denominate/ +category: System +stability: Experimental +synopsis: Functions supporting bulk file and directory name + normalization. +description: Denominate provides a main program for performing bulk + file and directory renaming, using a built-in filename + converter or user-defined converters. + . + Additionally, it provides a module that exposes some + functions related to renaming and name normalization + that might be otherwise useful. + +flag small_base + description: Choose the new smaller, split-up base package. + +library + exposed-modules: System.Denominate + if flag(small_base) + build-depends: base >= 3, directory, filepath + else + build-depends: base < 3, filepath + ghc-options: -O -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-orphans + +executable denominate + main-is: Main.hs + if flag(small_base) + build-depends: base >= 3, directory, filepath + else + build-depends: base < 3, filepath + ghc-options: -O -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-orphans +