import Prelude hiding ( readFile ) import System.IO.Strict import System.Console.CmdArgs import qualified Config as C import System.FilePath import System.Directory import Data.Time.Clock import Data.Time.Format import System.Locale import Storage.Hashed.Plain import Storage.Hashed.Darcs import Storage.Hashed.Hash import Storage.Hashed.Tree import Storage.Hashed.AnchoredPath import qualified Data.ByteString.Char8 as BSC data Backup = Backup { root :: Hash , date :: String , path :: String } deriving Show help = "A simple backup utility." showtime = formatTime defaultTimeLocale "%F.%R" readrepo = map (wibble . words) . lines where wibble [h, d, p] = Backup (decodeBase16 $ BSC.pack h) d p wibble x = error $ show x repo path = getrepo path `catch` \_ -> makerepo path listrepo r = putStr $ unlines . map line $ r where line (Backup h d p) = unwords [BSC.unpack $ encodeBase16 h, d, p] listdir r h = do t <- expand =<< readDarcsHashed r (Nothing, h) putStr $ unlines [ unwords [ BSC.unpack $ encodeBase16 $ itemHash i , anchorPath "" p ] | (p, i) <- list t ] {- catpath r h p = do t <- expand =<< readDarcsHashed r (Nothing, h) case findBlob t p of Nothing -> fail $ showPath p ++ " does not exist." -} writerepo r to = writeFile (to "list") (unlines $ map line r) >> return r where line (Backup r d p) = unwords [BSC.unpack $ encodeBase16 r, d, p] makerepo path = writerepo [] path getrepo path = readrepo `fmap` (readFile $ path "list") make from to = do f <- darcsUpdateHashes =<< expand =<< readPlainTree from hash <- writeDarcsHashed f to dt <- getCurrentTime path <- canonicalizePath from r <- repo to writerepo (r ++ [Backup hash (showtime dt) path]) to putStrLn $ "new backup root: " ++ (BSC.unpack $ encodeBase16 hash) restore repo to root = do createDirectory to t <- expand =<< readDarcsHashed repo (Nothing, root) writePlainTree t to main = do cfg <- cmdArgs help C.conf print cfg case cfg of C.Take from to -> make from to C.List r "" -> listrepo =<< getrepo r C.List r h -> listdir r (decodeBase16 $ BSC.pack h) C.Restore r t "" -> do x <- last `fmap` repo r restore r t (root x) C.Restore r t h -> restore r t (decodeBase16 $ BSC.pack h)