module BuildBox.Command.File
( PropFile(..)
, inDir
, inScratchDir
, clobberDir
, ensureDir
, withTempFile
, atomicWriteFile
, exe )
where
import BuildBox.Build
import System.Directory
import Control.Exception
import Control.Monad.State
import System.Info
data PropFile
= HasExecutable String
| HasFile FilePath
| HasDir FilePath
| FileEmpty FilePath
deriving Show
instance Testable PropFile where
test prop
= case prop of
HasExecutable name
-> do bin <- io $ findExecutable name
return $ case bin of
Just _ -> True
Nothing -> False
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
ensureDir name
x <- inDir name build
clobberDir name
return x
clobberDir :: FilePath -> Build ()
clobberDir path
= do e <- io $ try $ removeDirectoryRecursive path
case (e :: Either SomeException ()) of
_ -> return ()
ensureDir :: FilePath -> Build ()
ensureDir path
= do already <- io $ doesDirectoryExist path
if already
then return ()
else do e <- io $ try $ createDirectoryIfMissing True path
case (e :: Either SomeException ()) of
_ -> return ()
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 = (if (null buildDir) then "" else (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
e <- io $ try $ renameFile tmp filePath
case (e :: Either SomeException ()) of
Right _
-> return ()
Left _
-> do io $ copyFile tmp filePath
io $ removeFile tmp
return ()
exe :: String
exe
| os == "mingw32" = "exe"
| otherwise = ""