hsbackup-0.1: main.hs

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)