summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChrisForno <>2013-07-08 23:00:47 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2013-07-08 23:00:47 (GMT)
commita9a302b979a66e23500368f637d97c22d354b87c (patch)
tree021e5ca18cdc20702ab0c9f9734566fc7b23b3eb
version 0.1.00.1.0
-rw-r--r--LICENSE1
-rw-r--r--Setup.hs2
-rw-r--r--redo.cabal30
-rw-r--r--redo.hs103
4 files changed, 136 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..2159d90
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1 @@
+I hereby place the source code for "redo" into the public domain.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/redo.cabal b/redo.cabal
new file mode 100644
index 0000000..00eeaaa
--- /dev/null
+++ b/redo.cabal
@@ -0,0 +1,30 @@
+name: redo
+version: 0.1.0
+synopsis: software build system, make replacement, implementation of djb's redo
+description: redo builds a target file from source files using a "do" script. It also tracks when source files have changed and rebuilds target files as necessary.
+homepage: https://github.com/jekor/redo
+bug-reports: https://github.com/jekor/redo/issues
+license: PublicDomain
+license-file: LICENSE
+author: Chris Forno (jekor)
+maintainer: jekor@jekor.com
+category: Distribution
+build-type: Simple
+cabal-version: >=1.8
+tested-with: GHC == 7.6.2
+
+source-repository head
+ type: git
+ location: git://github.com/jekor/redo.git
+
+executable redo
+ main-is: redo.hs
+ build-depends: base >= 4 && < 5,
+ bytestring,
+ containers >= 0.5,
+ directory,
+ filepath,
+ process,
+ pureMD5
+ extensions: ScopedTypeVariables
+ ghc-options: -Wall -fno-warn-missing-signatures \ No newline at end of file
diff --git a/redo.hs b/redo.hs
new file mode 100644
index 0000000..927aecf
--- /dev/null
+++ b/redo.hs
@@ -0,0 +1,103 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+import Control.Exception (catch, catchJust, IOException)
+import Control.Monad (filterM, liftM, unless, guard)
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Digest.Pure.MD5 as MD5
+import Data.Map.Lazy (insert, fromList, toList, adjust)
+import Data.Maybe (listToMaybe)
+-- import Debug.Trace (traceShow)
+import GHC.IO.Exception (IOErrorType(..))
+import System.Directory (renameFile, removeFile, doesFileExist, getDirectoryContents, removeDirectoryRecursive, createDirectoryIfMissing, getCurrentDirectory, setCurrentDirectory)
+import System.Environment (getArgs, getEnvironment, getProgName, lookupEnv)
+import System.Exit (ExitCode(..))
+import System.FilePath (hasExtension, replaceBaseName, takeBaseName, (</>), splitFileName)
+import System.IO (hPutStrLn, stderr, hGetLine, withFile, IOMode(..), hFileSize)
+import System.IO.Error (ioeGetErrorType, isDoesNotExistError)
+import System.Process (createProcess, waitForProcess, shell, CreateProcess(..))
+
+-- traceShow' arg = traceShow arg arg
+
+metaDir = ".redo"
+
+main :: IO ()
+main = do
+ topDir <- getCurrentDirectory
+ getArgs >>= mapM_ (\arg -> do
+ let (dir, file) = splitFileName arg
+ setCurrentDirectory dir
+ redo file dir
+ setCurrentDirectory topDir)
+ progName <- getProgName
+ redoTarget' <- lookupEnv "REDO_TARGET"
+ case (progName, redoTarget') of
+ ("redo-ifchange", Just redoTarget) -> mapM_ (writeMD5 redoTarget) =<< getArgs
+ ("redo-ifchange", Nothing) -> error "Missing REDO_TARGET environment variable."
+ _ -> return ()
+
+redo :: String -> FilePath -> IO ()
+redo target dir = do
+ upToDate' <- upToDate target
+ unless upToDate' $ maybe missingDo redo' =<< doPath target
+ where redo' :: FilePath -> IO ()
+ redo' path = do
+ hPutStrLn stderr $ "redo " ++ show (dir </> target)
+ catchJust (guard . isDoesNotExistError)
+ (removeDirectoryRecursive metaDepsDir)
+ (\_ -> return ())
+ createDirectoryIfMissing True metaDepsDir
+ writeMD5 target path
+ oldEnv <- getEnvironment
+ let newEnv = toList $ adjust (++ ":.") "PATH" $ insert "REDO_TARGET" target $ fromList oldEnv
+ (_, _, _, ph) <- createProcess $ (shell $ cmd path) {env = Just newEnv}
+ exit <- waitForProcess ph
+ case exit of
+ ExitSuccess -> do
+ size <- fileSize tmp
+ if size > 0
+ then renameFile tmp target
+ else removeFile tmp
+ ExitFailure code -> do hPutStrLn stderr $ "Redo script exited with non-zero exit code: " ++ show code
+ removeFile tmp
+ tmp = target ++ "---redoing"
+ metaDepsDir = metaDir </> target
+ missingDo = do
+ exists <- doesFileExist target
+ unless exists $ error $ "No .do file found for target '" ++ target ++ "'"
+ cmd path = unwords ["sh -e", path, "0", takeBaseName target, tmp, ">", tmp]
+
+doPath :: FilePath -> IO (Maybe FilePath)
+doPath target = listToMaybe `liftM` filterM doesFileExist candidates
+ where candidates = (target ++ ".do") : if hasExtension target
+ then [replaceBaseName target "default" ++ ".do"]
+ else []
+
+upToDate :: FilePath -> IO Bool
+upToDate target = catch
+ (do exists <- doesFileExist target
+ if exists
+ then do md5s <- getDirectoryContents (metaDir </> target)
+ and `liftM` mapM depUpToDate md5s
+ else return False)
+ (\(_ :: IOException) -> return False)
+ where depUpToDate :: String -> IO Bool
+ depUpToDate oldMD5 = catch
+ (do dep <- withFile (metaDir </> target </> oldMD5) ReadMode hGetLine
+ newMD5 <- fileMD5 dep
+ doScript <- doPath dep
+ case doScript of
+ Nothing -> return $ oldMD5 == newMD5
+ Just _ -> do upToDate' <- upToDate dep
+ return $ (oldMD5 == newMD5) && upToDate')
+ (\e -> return (ioeGetErrorType e == InappropriateType))
+
+fileMD5 :: FilePath -> IO String
+fileMD5 path = (show . MD5.md5) `liftM` BL.readFile path
+
+writeMD5 :: String -> FilePath -> IO ()
+writeMD5 redoTarget dep = do
+ md5 <- fileMD5 dep
+ writeFile (metaDir </> redoTarget </> md5) dep
+
+fileSize :: FilePath -> IO Integer
+fileSize path = withFile path ReadMode hFileSize