1 % Copyright (C) 2009 Petr Rockai
    2 %
    3 % Permission is hereby granted, free of charge, to any person
    4 % obtaining a copy of this software and associated documentation
    5 % files (the "Software"), to deal in the Software without
    6 % restriction, including without limitation the rights to use, copy,
    7 % modify, merge, publish, distribute, sublicense, and/or sell copies
    8 % of the Software, and to permit persons to whom the Software is
    9 % furnished to do so, subject to the following conditions:
   10 %
   11 % The above copyright notice and this permission notice shall be
   12 % included in all copies or substantial portions of the Software.
   13 %
   14 % THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
   15 % EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
   16 % MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
   17 % NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
   18 % BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
   19 % ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
   20 % CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
   21 % SOFTWARE.
   22 
   23 \darcsCommand{show index}
   24 \begin{code}
   25 {-# OPTIONS_GHC -cpp #-}
   26 {-# LANGUAGE CPP #-}
   27 #include "gadts.h"
   28 module Darcs.Commands.ShowIndex ( show_index, show_pristine ) where
   29 import Darcs.Arguments ( DarcsFlag(..), working_repo_dir,
   30                         files, directories, nullFlag )
   31 import Darcs.Commands ( DarcsCommand(..), nodefaults, command_alias )
   32 import Darcs.Repository ( amInRepository, withRepository, ($-) )
   33 
   34 import Darcs.Gorsvet( readIndex )
   35 import Storage.Hashed( readDarcsPristine, floatPath )
   36 import Storage.Hashed.Darcs( darcsFormatHash )
   37 import Storage.Hashed.Tree( list, expand, itemHash, Tree, TreeItem( SubTree ) )
   38 import Storage.Hashed.AnchoredPath( anchorPath )
   39 
   40 import qualified Data.ByteString.Char8 as BS
   41 
   42 show_index :: DarcsCommand
   43 show_index = DarcsCommand {
   44   command_name = "index",
   45   command_description = "Dump contents of working tree index.",
   46   command_help =
   47       "The `darcs show index' command lists all version-controlled files and " ++
   48       "directories along with their hashes as stored in _darcs/index. " ++
   49       "For files, the fields correspond to file size, sha256 of the current " ++
   50       "file content and the filename.",
   51   command_extra_args = 0,
   52   command_extra_arg_help = [],
   53   command_command = show_index_cmd,
   54   command_prereq = amInRepository,
   55   command_get_arg_possibilities = return [],
   56   command_argdefaults = nodefaults,
   57   command_advanced_options = [],
   58   command_basic_options = [files, directories, nullFlag, working_repo_dir] }
   59 
   60 show_pristine :: DarcsCommand
   61 show_pristine = command_alias "pristine" show_index {
   62   command_command = show_pristine_cmd,
   63   command_description = "Dump contents of pristine cache.",
   64   command_help =
   65       "The `darcs show pristine' command lists all version-controlled files " ++
   66       "and directories along with the hashes of their pristine copies. " ++
   67       "For files, the fields correspond to file size, sha256 of the pristine " ++
   68       "file content and the filename." }
   69 
   70 dump :: [DarcsFlag] -> Tree -> IO ()
   71 dump opts tree = do
   72   let line | NullFlag `elem` opts = \t -> putStr t >> putChar '\0'
   73            | otherwise = putStrLn
   74       output (p, i) = do
   75         let hash = case itemHash i of
   76                      Just h -> BS.unpack $ darcsFormatHash h
   77                      Nothing -> "(no hash available)"
   78             path = anchorPath "" p
   79             isdir = case i of
   80                       SubTree _ -> "/"
   81                       _ -> ""
   82         line $ hash ++ " " ++ path ++ isdir
   83   x <- expand tree
   84   mapM_ output $ (floatPath ".", SubTree x) : list x
   85 
   86 show_index_cmd :: [DarcsFlag] -> [String] -> IO ()
   87 show_index_cmd opts _ = withRepository opts $- \repo -> do
   88   readIndex repo >>= dump opts
   89 
   90 show_pristine_cmd :: [DarcsFlag] -> [String] -> IO ()
   91 show_pristine_cmd opts _ = withRepository opts $- \_ -> do
   92   readDarcsPristine "." >>= dump opts
   93 
   94 \end{code}