module BuildBox.Command.File
( PropFile(..)
, inDir
, inScratchDir
, clobberDir
, ensureDir
, withTempFile
, atomicWriteFile)
where
import BuildBox.Build
import BuildBox.Command.System
import System.Directory
import Control.Monad.State
data PropFile
= HasExecutable String
| HasFile FilePath
| HasDir FilePath
| FileEmpty FilePath
deriving Show
instance Testable PropFile where
test prop
= case prop of
HasExecutable name
-> do code <- qsystem $ "which " ++ name
return $ code == ExitSuccess
HasFile path
-> io $ doesFileExist path
HasDir path
-> io $ doesDirectoryExist path
FileEmpty path
-> do contents <- io $ readFile path
return (null contents)
inDir :: FilePath -> Build a -> Build a
inDir name build
= do check $ HasDir name
oldDir <- io $ getCurrentDirectory
io $ setCurrentDirectory name
x <- build
io $ setCurrentDirectory oldDir
return x
inScratchDir :: FilePath -> Build a -> Build a
inScratchDir name build
= do
checkFalse $ HasDir name
ssystem $ "mkdir -p " ++ name
x <- inDir name build
ssystem $ "rm -Rf " ++ name
return x
clobberDir :: FilePath -> Build ()
clobberDir path
= ssystem $ "rm -Rf " ++ path
ensureDir :: FilePath -> Build ()
ensureDir path
= do already <- io $ doesDirectoryExist path
if already
then return ()
else ssystem $ "mkdir -p " ++ path
withTempFile :: (FilePath -> Build a) -> Build a
withTempFile build
= do fileName <- newTempFile
result <- build fileName
io $ removeFile fileName
return result
newTempFile :: Build FilePath
newTempFile
= do buildDir <- gets buildStateScratchDir
buildId <- gets buildStateId
buildSeq <- gets buildStateSeq
modify $ \s -> s { buildStateSeq = buildStateSeq s + 1 }
ensureDir buildDir
let fileName = buildDir ++ "/buildbox-" ++ show buildId ++ "-" ++ show buildSeq
exists <- io $ doesFileExist fileName
when exists
$ error "buildbox: panic, supposedly fresh file already exists."
io $ writeFile fileName ""
io $ canonicalizePath fileName
atomicWriteFile :: FilePath -> String -> Build ()
atomicWriteFile filePath str
= do tmp <- newTempFile
io $ writeFile tmp str
ssystem $ "mv " ++ tmp ++ " " ++ filePath