#include "gadts.h"
module Darcs.Commands.ShowIndex ( showIndex
, showPristineCmd
) where
import Darcs.Arguments ( DarcsFlag(..), workingRepoDir,
files, directories, nullFlag )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Repository ( amInRepository, withRepository, RepoJob(..), readIndex )
import Darcs.Repository.State ( readRecorded )
import Storage.Hashed( floatPath )
import Storage.Hashed.Hash( encodeBase16, Hash( NoHash ) )
import Storage.Hashed.Tree( list, expand, itemHash, Tree, TreeItem( SubTree ) )
import Storage.Hashed.Index( updateIndex )
import Storage.Hashed.AnchoredPath( anchorPath )
import qualified Data.ByteString.Char8 as BS
showIndex :: DarcsCommand
showIndex = DarcsCommand {
commandProgramName = "darcs",
commandName = "index",
commandDescription = "Dump contents of working tree index.",
commandHelp =
"The `darcs show index' command lists all version-controlled files and " ++
"directories along with their hashes as stored in _darcs/index. " ++
"For files, the fields correspond to file size, sha256 of the current " ++
"file content and the filename.",
commandExtraArgs = 0,
commandExtraArgHelp = [],
commandCommand = showIndexCmd,
commandPrereq = amInRepository,
commandGetArgPossibilities = return [],
commandArgdefaults = nodefaults,
commandAdvancedOptions = [],
commandBasicOptions = [files, directories, nullFlag, workingRepoDir] }
dump :: [DarcsFlag] -> Tree IO -> IO ()
dump opts tree = do
let line | NullFlag `elem` opts = \t -> putStr t >> putChar '\0'
| otherwise = putStrLn
output (p, i) = do
let hash = case itemHash i of
NoHash -> "(no hash available)"
h -> BS.unpack $ encodeBase16 h
path = anchorPath "" p
isdir = case i of
SubTree _ -> "/"
_ -> ""
line $ hash ++ " " ++ path ++ isdir
x <- expand tree
mapM_ output $ (floatPath ".", SubTree x) : list x
showIndexCmd :: [DarcsFlag] -> [String] -> IO ()
showIndexCmd opts _ = withRepository opts $ RepoJob $ \repo -> do
readIndex repo >>= updateIndex >>= dump opts
showPristineCmd :: [DarcsFlag] -> [String] -> IO ()
showPristineCmd opts _ = withRepository opts $ RepoJob $ \repo -> do
readRecorded repo >>= dump opts