{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, DeriveDataTypeable #-}{-# LANGUAGE TypeFamilies, ConstraintKinds #-}-- | Both System.Directory and System.Environment wrappersmoduleDevelopment.Shake.Internal.Rules.Directory(doesFileExist ,doesDirectoryExist ,getDirectoryContents ,getDirectoryFiles ,getDirectoryDirs ,getEnv ,getEnvWithDefault ,removeFiles ,removeFilesAfter ,getDirectoryFilesIO ,defaultRuleDirectory )whereimportControl.ApplicativeimportControl.Monad.ExtraimportControl.Monad.IO.ClassimportData.MaybeimportData.BinaryimportData.ListimportData.Tuple.ExtraimportqualifiedData.HashSetasSetimportqualifiedSystem.DirectoryasIOimportqualifiedSystem.Environment.ExtraasIOimportDevelopment.Shake.Internal.Core.Types importDevelopment.Shake.Internal.Core.Action importDevelopment.Shake.Internal.Core.Rules importDevelopment.Shake.Internal.Core.Build importDevelopment.Shake.Internal.Value importDevelopment.Shake.Classes importDevelopment.Shake.FilePath importDevelopment.Shake.Internal.FilePattern importGeneral.Extra importGeneral.Binary importPrelude----------------------------------------------------------------------- KEY/VALUE TYPEStypeinstanceRuleResult DoesFileExistQ =DoesFileExistA newtypeDoesFileExistQ =DoesFileExistQ FilePathderiving(Typeable,Eq,Hashable,Binary,BinaryEx ,NFData)instanceShowDoesFileExistQ whereshow (DoesFileExistQ a )="doesFileExist "++wrapQuote a newtypeDoesFileExistA =DoesFileExistA {fromDoesFileExistA ::Bool}deriving(Typeable,Eq,BinaryEx ,NFData)instanceShowDoesFileExistA whereshow (DoesFileExistA a )=showa typeinstanceRuleResult DoesDirectoryExistQ =DoesDirectoryExistA newtypeDoesDirectoryExistQ =DoesDirectoryExistQ FilePathderiving(Typeable,Eq,Hashable,Binary,BinaryEx ,NFData)instanceShowDoesDirectoryExistQ whereshow (DoesDirectoryExistQ a )="doesDirectoryExist "++wrapQuote a newtypeDoesDirectoryExistA =DoesDirectoryExistA {fromDoesDirectoryExistA ::Bool}deriving(Typeable,Eq,BinaryEx ,NFData)instanceShowDoesDirectoryExistA whereshow (DoesDirectoryExistA a )=showa typeinstanceRuleResult GetEnvQ =GetEnvA newtypeGetEnvQ =GetEnvQ Stringderiving(Typeable,Eq,Hashable,Binary,BinaryEx ,NFData)instanceShowGetEnvQ whereshow (GetEnvQ a )="getEnv "++wrapQuote a newtypeGetEnvA =GetEnvA {fromGetEnvA ::MaybeString}deriving(Typeable,Eq,Hashable,BinaryEx ,NFData)instanceShowGetEnvA whereshow (GetEnvA a )=maybe"<unset>"wrapQuote a typeinstanceRuleResult GetDirectoryContentsQ =GetDirectoryA typeinstanceRuleResult GetDirectoryFilesQ =GetDirectoryA typeinstanceRuleResult GetDirectoryDirsQ =GetDirectoryA newtypeGetDirectoryContentsQ =GetDirectoryContentsQ FilePathderiving(Typeable,Eq,Hashable,Binary,BinaryEx ,NFData)instanceShowGetDirectoryContentsQ whereshow (GetDirectoryContentsQ dir )="getDirectoryContents "++wrapQuote dir newtypeGetDirectoryFilesQ =GetDirectoryFilesQ (FilePath,[FilePattern ])deriving(Typeable,Eq,Hashable,Binary,BinaryEx ,NFData)instanceShowGetDirectoryFilesQ whereshow (GetDirectoryFilesQ (dir ,pat ))="getDirectoryFiles "++wrapQuote dir ++" ["++unwords(mapwrapQuote pat )++"]"newtypeGetDirectoryDirsQ =GetDirectoryDirsQ FilePathderiving(Typeable,Eq,Hashable,Binary,BinaryEx ,NFData)instanceShowGetDirectoryDirsQ whereshow (GetDirectoryDirsQ dir )="getDirectoryDirs "++wrapQuote dir newtypeGetDirectoryA =GetDirectoryA {fromGetDirectoryA ::[FilePath]}deriving(Typeable,Eq,Hashable,BinaryEx ,NFData)instanceShowGetDirectoryA whereshow (GetDirectoryA xs )=unwords$mapwrapQuote xs ----------------------------------------------------------------------- RULE DEFINITIONSqueryRule::(RuleResultkey ~value ,BinaryEx witness ,Eqwitness ,BinaryEx key ,ShakeValue key ,Typeablevalue ,NFDatavalue ,Showvalue ,Eqvalue )=>(value ->witness )->(key ->IOvalue )->Rules ()queryRule witness query =addBuiltinRuleEx (\k old ->donew <-query k return$ifold ==new thenNothingelseJust$shownew )(\_v ->runBuilder $putEx $witness v )(\k old _->liftIO$donew <-query k letwnew =witness new return$caseold ofJustold |wnew ==getEx old ->RunResult ChangedNothing old new _->RunResult ChangedRecomputeDiff (runBuilder $putEx wnew )new )defaultRuleDirectory::Rules ()defaultRuleDirectory =do-- for things we are always going to rerun, and which might take up a lot of memory to store,-- we only store their hash, so we can compute change, but not know what changed happenedqueryRule id(\(DoesFileExistQ x )->DoesFileExistA <$>IO.doesFileExistx )queryRule id(\(DoesDirectoryExistQ x )->DoesDirectoryExistA <$>IO.doesDirectoryExistx )queryRule hash(\(GetEnvQ x )->GetEnvA <$>IO.lookupEnvx )queryRule hash(\(GetDirectoryContentsQ x )->GetDirectoryA <$>getDirectoryContentsIO x )queryRule hash(\(GetDirectoryFilesQ (a ,b ))->GetDirectoryA <$>getDirectoryFilesIO a b )queryRule hash(\(GetDirectoryDirsQ x )->GetDirectoryA <$>getDirectoryDirsIO x )----------------------------------------------------------------------- RULE ENTRY POINTS-- | Returns 'True' if the file exists. The existence of the file is tracked as a-- dependency, and if the file is created or deleted the rule will rerun in subsequent builds.---- You should not call 'doesFileExist' on files which can be created by the build system.doesFileExist::FilePath->Action BooldoesFileExist =fmapfromDoesFileExistA.apply1 .DoesFileExistQ .toStandard -- | Returns 'True' if the directory exists. The existence of the directory is tracked as a-- dependency, and if the directory is created or delete the rule will rerun in subsequent builds.---- You should not call 'doesDirectoryExist' on directories which can be created by the build system.doesDirectoryExist::FilePath->Action BooldoesDirectoryExist =fmapfromDoesDirectoryExistA.apply1 .DoesDirectoryExistQ .toStandard -- | Return 'Just' the value of the environment variable, or 'Nothing'-- if the variable is not set. The environment variable is tracked as a-- dependency, and if it changes the rule will rerun in subsequent builds.-- This function is a tracked version of 'getEnv' / 'lookupEnv' from the base library.---- @-- flags <- getEnv \"CFLAGS\"-- 'cmd' \"gcc -c\" [out] (maybe [] words flags)-- @getEnv::String->Action (MaybeString)getEnv =fmapfromGetEnvA.apply1 .GetEnvQ -- | @'getEnvWithDefault' def var@ returns the value of the environment variable @var@, or the-- default value @def@ if it is not set. Similar to 'getEnv'.---- @-- flags <- getEnvWithDefault \"-Wall\" \"CFLAGS\"-- 'cmd' \"gcc -c\" [out] flags-- @getEnvWithDefault::String->String->Action StringgetEnvWithDefault def var =fromMaybedef <$>getEnv var -- | Get the contents of a directory. The result will be sorted, and will not contain-- the entries @.@ or @..@ (unlike the standard Haskell version).-- The resulting paths will be relative to the first argument.-- The result itself is tracked as a dependency, but the files in the result are not.-- If the list of files changes in subsequent builds any rule calling it will rerun.---- It is usually simpler to call either 'getDirectoryFiles' or 'getDirectoryDirs'.getDirectoryContents::FilePath->Action [FilePath]getDirectoryContents =fmapfromGetDirectoryA.apply1 .GetDirectoryContentsQ -- | Get the files anywhere under a directory that match any of a set of patterns.-- For the interpretation of the patterns see '?=='. All results will be-- relative to the directory argument.-- The result itself is tracked as a dependency, but the files in the result are not.-- If the list of files changes in subsequent builds any rule calling it will rerun.-- Some examples:---- > getDirectoryFiles "Config" ["//*.xml"]-- > -- All .xml files anywhere under the Config directory-- > -- If Config/foo/bar.xml exists it will return ["foo/bar.xml"]-- > getDirectoryFiles "Modules" ["*.hs","*.lhs"]-- > -- All .hs or .lhs in the Modules directory-- > -- If Modules/foo.hs and Modules/foo.lhs exist, it will return ["foo.hs","foo.lhs"]---- If you require a qualified file name it is often easier to use @\"\"@ as the 'FilePath' argument,-- for example the following two expressions are equivalent:---- > fmap (map ("Config" </>)) (getDirectoryFiles "Config" ["//*.xml"])-- > getDirectoryFiles "" ["Config//*.xml"]---- If the first argument directory does not exist it will raise an error.-- If @foo@ does not exist, then the first of these error, but the second will not.---- > getDirectoryFiles "foo" ["//*"] -- error-- > getDirectoryFiles "" ["foo//*"] -- returns []---- This function is tracked and serves as a dependency. If a rule calls-- @getDirectoryFiles \"\" [\"*.c\"]@ and someone adds @foo.c@ to the-- directory, that rule will rebuild. If someone changes one of the @.c@ files,-- but the /list/ of @.c@ files doesn't change, then it will not rebuild.-- As a consequence of being tracked, if the contents change during the build-- (e.g. you are generating @.c@ files in this directory) then the build not reach-- a stable point, which is an error - detected by running with @--lint@.-- You should normally only call this function returning source files.---- For an untracked variant see 'getDirectoryFilesIO'.getDirectoryFiles::FilePath->[FilePattern ]->Action [FilePath]getDirectoryFiles dir pat =fmapfromGetDirectoryA$apply1 $GetDirectoryFilesQ (dir ,pat )-- | Get the directories in a directory, not including @.@ or @..@.-- All directories are relative to the argument directory.-- The result itself is tracked as a dependency, but the directories in the result are not.-- If the list of directories changes in subsequent builds any rule calling it will rerun.-- The rules about creating entries described in 'getDirectoryFiles' also apply here.---- > getDirectoryDirs "/Users"-- > -- Return all directories in the /Users directory-- > -- e.g. ["Emily","Henry","Neil"]getDirectoryDirs::FilePath->Action [FilePath]getDirectoryDirs =fmapfromGetDirectoryA.apply1 .GetDirectoryDirsQ ----------------------------------------------------------------------- IO ROUTINESgetDirectoryContentsIO::FilePath->IO[FilePath]-- getDirectoryContents "" is equivalent to getDirectoryContents "." on Windows,-- but raises an error on Linux. We smooth out the difference.getDirectoryContentsIO dir =fmap(sort.filter(not.all(=='.')))$IO.getDirectoryContents$ifdir ==""then"."elsedir getDirectoryDirsIO::FilePath->IO[FilePath]getDirectoryDirsIO dir =filterMf =<<getDirectoryContentsIO dir wheref x =IO.doesDirectoryExist$dir </>x -- | A version of 'getDirectoryFiles' that is in IO, and thus untracked.getDirectoryFilesIO::FilePath->[FilePattern ]->IO[FilePath]-- Known infelicity: on Windows, if you search for "foo", but have the file "FOO",-- it will match if on its own, or not if it is paired with "*", since that forces-- a full directory scan, and then it uses Haskell equality (case sensitive)getDirectoryFilesIO root pat =f ""$snd$walk pat where-- Even after we know they are there because we called contents, we still have to check they are directories/files-- as requiredf dir (Walk op )=f dir .WalkTo .op =<<getDirectoryContentsIO (root </>dir )fdir (WalkTo (files ,dirs ))=dofiles <-filterM(IO.doesFileExist.(root </>))$map(dir </>)files dirs <-concatMapM(uncurryf )=<<filterM(IO.doesDirectoryExist.(root </>).fst)(map(first(dir </>))dirs )return$files ++dirs ----------------------------------------------------------------------- REMOVE UTILITIES-- | Remove all files and directories that match any of the patterns within a directory.-- Some examples:---- @-- 'removeFiles' \"output\" [\"\/\/*\"] -- delete everything inside \'output\'-- 'removeFiles' \"output\" [\"\/\/\"] -- delete \'output\' itself-- 'removeFiles' \".\" [\"\/\/*.hi\",\"\/\/*.o\"] -- delete all \'.hi\' and \'.o\' files-- @---- If the argument directory is missing no error is raised.-- This function will follow symlinks, so should be used with care.---- This function is often useful when writing a @clean@ action for your build system,-- often as a 'phony' rule.removeFiles::FilePath->[FilePattern ]->IO()removeFiles dir pat =whenM(IO.doesDirectoryExistdir )$dolet(b ,w )=walk pat ifb thenremoveDir dir elsef dir w wheref dir (Walk op )=f dir .WalkTo .op =<<getDirectoryContentsIO dir fdir (WalkTo (files ,dirs ))=doforM_files $\fil ->tryIO $removeItem $dir </>fil letdone =Set.fromListfiles forM_(filter(not.flipSet.memberdone .fst)dirs )$\(d ,w )->doletdir2 =dir </>d whenM(IO.doesDirectoryExistdir2 )$f dir2 w removeItem::FilePath->IO()removeItem x =IO.removeFilex `catchIO `\_->removeDir x -- In newer GHC's removeDirectoryRecursive is probably better, but doesn't follow-- symlinks, so it's got different behaviourremoveDir::FilePath->IO()removeDir x =domapM_(removeItem .(x </>))=<<getDirectoryContentsIO x IO.removeDirectoryx -- | Remove files, like 'removeFiles', but executed after the build completes successfully using 'runAfter'.-- Useful for implementing @clean@ actions that delete files Shake may have open for building, e.g. 'shakeFiles'.-- Where possible, delete the files as a normal part of the build, e.g. using @'liftIO' $ 'removeFiles' dir pats@.removeFilesAfter::FilePath->[FilePattern ]->Action ()removeFilesAfter a b =doputLoud $"Will remove "++unwordsb ++" from "++a runAfter $removeFiles a b