module Darcs.UI.Commands.ShowIndex
( showIndex
, showPristine
) where
import Darcs.Prelude
import Control.Monad ( (>=>) )
import Darcs.UI.Flags ( DarcsFlag, useCache )
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInRepository )
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Options ( (^), oid, odesc, ocheck, defaultFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository ( withRepository, RepoJob(..), readIndex )
import Darcs.Repository.State ( readRecorded )
import Darcs.Util.Hash( encodeBase16, Hash( NoHash ) )
import Darcs.Util.Tree( list, expand, itemHash, Tree, TreeItem( SubTree ) )
import Darcs.Util.Index( updateIndex, listFileIDs )
import Darcs.Util.Path( anchorPath, AbsolutePath, floatPath )
import Darcs.Util.Printer ( Doc, text )
import System.Posix.Types ( FileID )
import qualified Data.ByteString.Char8 as BC
import Data.Maybe ( fromJust )
import qualified Data.Map as M ( Map, lookup, fromList )
showIndexHelp :: Doc
showIndexHelp = text $
"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."
showIndex :: DarcsCommand
showIndex = DarcsCommand
{ commandProgramName = "darcs"
, commandName = "index"
, commandDescription = "Dump contents of working tree index."
, commandHelp = showIndexHelp
, commandExtraArgs = 0
, commandExtraArgHelp = []
, commandCommand = showIndexCmd
, commandPrereq = amInRepository
, commandCompleteArgs = noArgs
, commandArgdefaults = nodefaults
, commandAdvancedOptions = []
, commandBasicOptions = odesc showIndexBasicOpts
, commandDefaults = defaultFlags showIndexOpts
, commandCheckOptions = ocheck showIndexOpts
}
where
showIndexBasicOpts = O.nullFlag ^ O.repoDir
showIndexOpts = showIndexBasicOpts `withStdOpts` oid
dump :: [DarcsFlag] -> Maybe (M.Map FilePath FileID) -> Tree IO -> IO ()
dump opts fileids tree = do
let line | O.nullFlag ? opts = \t -> putStr t >> putChar '\0'
| otherwise = putStrLn
output (p, i) = do
let hash = case itemHash i of
NoHash -> "(no hash available)"
h -> BC.unpack $ encodeBase16 h
path = anchorPath "" p
isdir = case i of
SubTree _ -> "/"
_ -> ""
fileid = case fileids of
Nothing -> ""
Just fileids' -> " " ++ (show $ fromJust $ M.lookup path fileids')
line $ hash ++ fileid ++ " " ++ path ++ isdir
x <- expand tree
mapM_ output $ (floatPath ".", SubTree x) : list x
showIndexCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
showIndexCmd _ opts _ = withRepository (useCache ? opts) $ RepoJob $ \repo ->
do index <- readIndex repo
index_tree <- updateIndex index
fileids <- (M.fromList . map (\((a,_),b) -> (anchorPath "" a,b))) <$> listFileIDs index
dump opts (Just fileids) index_tree
showPristineCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
showPristineCmd _ opts _ = withRepository (useCache ? opts) $ RepoJob $
readRecorded >=> dump opts Nothing
showPristineHelp :: Doc
showPristineHelp = text $
"The `darcs show pristine` command lists all version-controlled files " ++
"and directories along with the hashes of their pristine copies. " ++
"For files, the fields correspond to file size, sha256 of the pristine " ++
"file content and the filename."
showPristine :: DarcsCommand
showPristine = showIndex
{ commandName = "pristine"
, commandDescription = "Dump contents of pristine cache."
, commandHelp = showPristineHelp
, commandCommand = showPristineCmd
}