ShowIndex.lhs

% Copyright (C) 2009 Petr Rockai
%
% Permission is hereby granted, free of charge, to any person
% obtaining a copy of this software and associated documentation
% files (the "Software"), to deal in the Software without
% restriction, including without limitation the rights to use, copy,
% modify, merge, publish, distribute, sublicense, and/or sell copies
% of the Software, and to permit persons to whom the Software is
% furnished to do so, subject to the following conditions:
%
% The above copyright notice and this permission notice shall be
% included in all copies or substantial portions of the Software.
%
% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
% BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
% ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
% CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
% SOFTWARE.

\darcsCommand{show index}
\begin{code}
{-# OPTIONS_GHC -cpp #-}
{-# LANGUAGE CPP #-}
#include "gadts.h"
module Darcs.Commands.ShowIndex ( show_index, show_pristine ) where
import Darcs.Arguments ( DarcsFlag(..), working_repo_dir,
                        files, directories, nullFlag )
import Darcs.Commands ( DarcsCommand(..), nodefaults, command_alias )
import Darcs.Repository ( amInRepository, withRepository, ($-) )

import Darcs.Gorsvet( readIndex )
import Storage.Hashed( readDarcsPristine, floatPath )
import Storage.Hashed.Darcs( darcsFormatHash )
import Storage.Hashed.Tree( list, expand, itemHash, Tree, TreeItem( SubTree ) )
import Storage.Hashed.AnchoredPath( anchorPath )

import qualified Data.ByteString.Char8 as BS

show_index :: DarcsCommand
show_index = DarcsCommand {
  command_name = "index",
  command_description = "Dump contents of working tree index.",
  command_help =
      "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.",
  command_extra_args = 0,
  command_extra_arg_help = [],
  command_command = show_index_cmd,
  command_prereq = amInRepository,
  command_get_arg_possibilities = return [],
  command_argdefaults = nodefaults,
  command_advanced_options = [],
  command_basic_options = [files, directories, nullFlag, working_repo_dir] }

show_pristine :: DarcsCommand
show_pristine = command_alias "pristine" show_index {
  command_command = show_pristine_cmd,
  command_description = "Dump contents of pristine cache.",
  command_help =
      "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." }

dump :: [DarcsFlag] -> Tree -> 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
                     Just h -> BS.unpack $ darcsFormatHash h
                     Nothing -> "(no hash available)"
            path = anchorPath "" p
            isdir = case i of
                      SubTree _ -> "/"
                      _ -> ""
        line $ hash ++ " " ++ path ++ isdir
  x <- expand tree
  mapM_ output $ (floatPath ".", SubTree x) : list x

show_index_cmd :: [DarcsFlag] -> [String] -> IO ()
show_index_cmd opts _ = withRepository opts $- \repo -> do
  readIndex repo >>= dump opts

show_pristine_cmd :: [DarcsFlag] -> [String] -> IO ()
show_pristine_cmd opts _ = withRepository opts $- \_ -> do
  readDarcsPristine "." >>= dump opts

\end{code}