FilePather (empty) → 0.0.1
raw patch · 4 files changed
+454/−0 lines, 4 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, directory, filepath, test-framework, test-framework-hunit, test-framework-quickcheck2
Files
- FilePather.cabal +45/−0
- LICENSE +27/−0
- Setup.hs +3/−0
- System/FilePath/FilePather.hs +379/−0
+ FilePather.cabal view
@@ -0,0 +1,45 @@+Name: FilePather+Version: 0.0.1+Author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+Maintainer: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+Copyright: Tony Morris+License: BSD3+License-File: LICENSE+Synopsis: Functions on System.FilePath+Category: System+Description:+ Functions over @System.FilePath@ including a find function for recursing down directories.+ .+ /This package is similar to the filemanip package but without the unix and mtl dependencies./+ .+ Usage example:+ .+ @+ -- find all haskell source files in the current directory, recursing all the way down+ findHere always (extensionEq "hs") >>= mapM_ putStrLn+ ./Setup.hs+ ./System/FilePath/FilePather.hs+ @+Homepage: https://bitbucket.org/dibblego/filepather/+Cabal-version: >= 1.2+Build-Type: Simple++Flag small_base+ Description: Choose the new, split-up base package.++Library+ Build-Depends:+ base < 5 && >= 3,+ directory,+ filepath,+ HUnit,+ QuickCheck,+ test-framework,+ test-framework-hunit,+ test-framework-quickcheck2++ GHC-Options:+ -Wall++ Exposed-Modules:+ System.FilePath.FilePather
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2009 Tony Morris++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,3 @@+import Distribution.Simple+main = defaultMain+
+ System/FilePath/FilePather.hs view
@@ -0,0 +1,379 @@+module System.FilePath.FilePather+(+ -- * Data type+ FilePather,+ -- * Constructor and unwrapper+ (<?>),+ filePather,+ -- * 'FilePather' values+ filePath,+ always,+ always',+ never,+ never',+ extension,+ extension',+ directory,+ directory',+ hasExtension,+ hasExtension',+ splitExtension,+ splitExtension',+ splitDirectories,+ splitDirectories',+ hasTrailingPathSeparator,+ hasTrailingPathSeparator',+ fileName,+ fileName',+ baseName,+ baseName',+ normalise,+ normalise',+ makeValid,+ makeValid',+ isRelative,+ isRelative',+ isAbsolute,+ isAbsolute',+ isValid,+ isValid',+ -- * Find predicates+ FileType(..),+ RecursePredicate,+ FilterPredicate,+ isFile,+ isDirectory,+ isUnknown,+ -- * Find+ find,+ -- * Combinators+ extensionSatisfies,+ extensionOneOf,+ extensionEq,+ findHere+) where++import Control.Applicative+import Control.Monad+import Data.Monoid+import System.FilePath((</>), takeExtension, takeDirectory, takeFileName, takeBaseName)+import qualified System.FilePath as P+import System.Directory++-- | A function that takes a 'FilePath' and produces a value.+newtype FilePather a = FilePather {+ (<?>) :: FilePath -> a+}++instance Functor FilePather where+ fmap f (FilePather k) =+ FilePather (f . k)++instance Applicative FilePather where+ FilePather f <*> FilePather a =+ FilePather (f <*> a)+ pure =+ FilePather . const++instance Monad FilePather where+ FilePather f >>= k =+ FilePather (f >>= (<?>) . k)+ return =+ pure++instance (Monoid a) => Monoid (FilePather a) where+ mempty =+ return mempty+ FilePather x `mappend` FilePather y =+ FilePather (x `mappend` y)++-- | Construct a 'FilePather' from the given function+filePather ::+ (FilePath -> a)+ -> FilePather a+filePather =+ FilePather++-- | A value that runs the identity function.+filePath ::+ FilePather FilePath+filePath =+ filePather id++-- | A value that always produces the value 'True'.+always ::+ FilePather Bool+always =+ filePather (const True)++-- | A value using a constant function that produces the value 'True'.+always' ::+ FilePather (a -> Bool)+always' =+ constant always++-- | A value that always produces the value 'False'.+never ::+ FilePather Bool+never =+ filePather (const False)++-- | A value that always produces a constant function that produces the value 'False'.+never' ::+ FilePather (a -> Bool)+never' =+ constant never++-- | A value that produces the extension of the given 'FilePath'.+extension ::+ FilePather FilePath+extension =+ filePather takeExtension++-- | A value using a constant function that produces the extension of the given 'FilePath'.+extension' ::+ FilePather (a -> FilePath)+extension' =+ constant extension++-- | A value that produces the directory of the given 'FilePath'.+directory ::+ FilePather FilePath+directory =+ filePather takeDirectory++-- | A value using a constant function that produces the directory of the given 'FilePath'.+directory' ::+ FilePather (a -> FilePath)+directory' =+ constant directory++-- | A value that produces a value denoting whether or not the given 'FilePath' has an extension.+hasExtension ::+ FilePather Bool+hasExtension =+ filePather P.hasExtension++-- | A value using a constant function that produces a value denoting whether or not the given 'FilePath' has an extension.+hasExtension' ::+ FilePather (a -> Bool)+hasExtension' =+ constant hasExtension++-- | A value that produces a value splitting the given 'FilePath' by its extension.+splitExtension ::+ FilePather (String, String)+splitExtension =+ filePather P.splitExtension++-- | A value using a constant function that produces a value splitting the given 'FilePath' by its extension.+splitExtension' ::+ FilePather (a -> (String, String))+splitExtension' =+ constant splitExtension++-- | A value that produces a value splitting the given 'FilePath' into its directories.+splitDirectories ::+ FilePather [FilePath]+splitDirectories =+ filePather P.splitDirectories++-- | A value using a constant function that produces a value splitting the given 'FilePath' into its directories.+splitDirectories' ::+ FilePather (a -> [FilePath])+splitDirectories' =+ constant splitDirectories++-- | A value that produces a value denoting whether or not the given 'FilePath' has a trailing path separator.+hasTrailingPathSeparator ::+ FilePather Bool+hasTrailingPathSeparator =+ filePather P.hasTrailingPathSeparator++-- | A value using a constant function that produces a value denoting whether or not the given 'FilePath' has a trailing path separator.+hasTrailingPathSeparator' ::+ FilePather (a -> Bool)+hasTrailingPathSeparator' =+ constant hasTrailingPathSeparator++-- | A value that produces the file name of the given 'FilePath'.+fileName ::+ FilePather FilePath+fileName =+ filePather takeFileName++-- | A value using a constant function that produces the file name of the given 'FilePath'.+fileName' ::+ FilePather (a -> FilePath)+fileName' =+ constant fileName++-- | A value that produces the base name of the given 'FilePath'.+baseName ::+ FilePather FilePath+baseName =+ filePather takeBaseName++-- | A value using a constant function that produces the base name of the given 'FilePath'.+baseName' ::+ FilePather (a -> FilePath)+baseName' =+ constant baseName++-- | A value that normalises the given 'FilePath'.+normalise ::+ FilePather FilePath+normalise =+ filePather P.normalise++-- | A value using a constant function that normalises the given 'FilePath'.+normalise' ::+ FilePather (a -> FilePath)+normalise' =+ constant normalise++-- | A value that makes valid the given 'FilePath'.+makeValid ::+ FilePather FilePath+makeValid =+ filePather P.makeValid++-- | A value using a constant function that makes valid the given 'FilePath'.+makeValid' ::+ FilePather (a -> FilePath)+makeValid' =+ constant makeValid++-- | A value that produces a value denoting whether or not the given 'FilePath' has is relative.+isRelative ::+ FilePather Bool+isRelative =+ filePather P.isRelative++-- | A value using a constant function that produces a value denoting whether or not the given 'FilePath' has is relative.+isRelative' ::+ FilePather (a -> Bool)+isRelative' =+ constant isRelative++-- | A value that produces a value denoting whether or not the given 'FilePath' has is absolute.+isAbsolute ::+ FilePather Bool+isAbsolute =+ filePather P.isAbsolute++-- | A value using a constant function that produces a value denoting whether or not the given 'FilePath' has is absolute.+isAbsolute' ::+ FilePather (a -> Bool)+isAbsolute' =+ constant isAbsolute++-- | A value that produces a value denoting whether or not the given 'FilePath' has is valid.+isValid ::+ FilePather Bool+isValid =+ filePather P.isValid++-- | A value using a constant function that produces a value denoting whether or not the given 'FilePath' has is valid.+isValid' ::+ FilePather (a -> Bool)+isValid' =+ constant isValid++-- | The possible types of a file.+data FileType = File -- ^ The type is a normal file.+ | Directory -- ^ The type is a directory.+ | Unknown -- ^ The type is unknown.+ deriving (Eq, Show)++-- | A recurse predicate takes a 'FilePath' and returns whether or not to continue recursing on that file.+type RecursePredicate = FilePather Bool++-- | A filter predicate takes a 'FilePath' and a file type and returns whether or not to filter the value.+type FilterPredicate = FilePather (FileType -> Bool)++-- | Compares for equivalence to a 'File' in an applicative functor.+isFile ::+ Applicative f =>+ f (FileType -> Bool)+isFile =+ pure (== File)++-- | Compares for equivalence to a 'Directory' in an applicative functor.+isDirectory ::+ Applicative f =>+ f (FileType -> Bool)+isDirectory =+ pure (== Directory)++-- | Compares for equivalence to 'Unknown' in an applicative functor.+isUnknown ::+ Applicative f =>+ f (FileType -> Bool)+isUnknown =+ pure (== Unknown)++-- | Finds all files using the given recurse predicate and filter predicate in the given file path.+find ::+ RecursePredicate -- ^ The recurse predicate determines whether to continue recursing on the given file path.+ -> FilterPredicate -- ^ The filter predicate determines whether to keep the current file path.+ -> FilePath -- ^ The file path to begin finding files.+ -> IO [FilePath] -- ^ All files found.+find =+ find' []+ where+ find' :: FilePath -> RecursePredicate -> FilterPredicate -> FilePath -> IO [FilePath]+ find' k r x p = let z = if null k then p else k </> p+ z' t = [z | x <?> z $ t]+ ifM c t f = do c' <- c+ t' <- t+ f' <- f+ return (if c' then t' else f')+ in ifM (doesFileExist z)+ (return (z' File)) $+ do e <- doesDirectoryExist z+ if e+ then if r <?> z+ then do c <- getDirectoryContents z+ t <- fmap join $ forM (filter (`notElem` [".", ".."]) c) (find' k r x . (z </>))+ return (z' Directory ++ t)+ else return (z' Directory)+ else return (z' Unknown)++-- | Returns a filter predicate based on whether a file extension satisfies a predicate.+extensionSatisfies ::+ (FilePath -> Bool)+ -> FilterPredicate+extensionSatisfies f =+ (const . f) <$> extension++-- | Returns a filter predicate based on whether a file extension is one of the given list of extensions.+extensionOneOf ::+ [FilePath]+ -> FilterPredicate+extensionOneOf =+ extensionSatisfies . flip elem . map ('.':)++-- | Returns a filter predicate based on whether a file extension equals the given extension.+extensionEq ::+ FilePath+ -> FilterPredicate+extensionEq =+ extensionOneOf . return++-- | Find in the current directory.+findHere ::+ RecursePredicate -- ^ The recurse predicate determines whether to continue recursing on the given file path.+ -> FilterPredicate -- ^ The filter predicate determines whether to keep the current file path.+ -> IO [FilePath] -- ^ All files found.+findHere r x =+ find r x =<< getCurrentDirectory++-- not exported+constant ::+ Functor f =>+ f a+ -> f (t -> a)+constant =+ fmap const+