% Copyright (C) 2007 Kevin Quick
%
% This program is free software; you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 2, or (at your option)
% any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program; see the file COPYING. If not, write to
% the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
% Boston, MA 02110-1301, USA.
\darcsCommand{show repo}
\begin{code}

{-# OPTIONS_GHC -cpp #-}{-# LANGUAGE CPP #-}#include "gadts.h"moduleDarcs.Commands.ShowRepo(showRepo)whereimportData.Char(toLower,isSpace)importData.List(intersperse)importControl.Monad(when,unless)importText.Html(tag,stringToHtml)importDarcs.Arguments(DarcsFlag(..),workingRepoDir,files,xmloutput)importDarcs.Commands(DarcsCommand(..),nodefaults)importDarcs.Repository(withRepository,($-),amInRepository,readRepo)importDarcs.Repository.Internal(Repository(..),RepoType(..))importDarcs.Repository.Format(RepoFormat(..))importDarcs.Repository.Prefs(getPreflist)importDarcs.Repository.Motd(getMotd)importDarcs.Patch(RepoPatch)importDarcs.Patch.Set(newset2RL)importDarcs.Witnesses.Ordered(lengthRL)importqualifiedData.ByteString.Char8asBC(unpack)showRepoHelp::StringshowRepoHelp="The `darcs show repo' command displays statistics about the current\n"++"repository, allowing third-party scripts to access this information\n"++"without inspecting _darcs directly (and without breaking when the\n"++"_darcs format changes).\n"++"\n"++"By default, the number of patches is shown. If this data isn't\n"++"needed, use --no-files to accelerate this command from O(n) to O(1).\n"++"\n"++"By default, output is in a human-readable format. The --xml-output\n"++"option can be used to generate output for machine postprocessing.\n"showRepoDescription::StringshowRepoDescription="Show repository summary information"showRepo::DarcsCommandshowRepo=DarcsCommand{commandName="repo",commandHelp=showRepoHelp,commandDescription=showRepoDescription,commandExtraArgs=0,commandExtraArgHelp=[],commandCommand=repoCmd,commandPrereq=amInRepository,commandGetArgPossibilities=return[],commandArgdefaults=nodefaults,commandAdvancedOptions=[],commandBasicOptions=[workingRepoDir,files,xmloutput]}repoCmd::[DarcsFlag]->[String]->IO()repoCmdopts_=letput_mode=ifXMLOutput`elem`optsthenshowInfoXMLelseshowInfoUsrinwithRepositoryopts$-\repository->actuallyShowRepo(putInfoput_mode)repository-- Some convenience functions to output a labelled text string or an-- XML tag + value (same API). If no value, output is suppressed-- entirely. Borrow some help from Text.Html to perform XML output.typeShowInfo=String->String->StringshowInfoXML::ShowInfoshowInfoXMLti=show$tag(safeTagt)$stringToHtmlisafeTag::String->StringsafeTag[]=[]safeTag(' ':cs)=safeTagcssafeTag('#':cs)="num_"++(safeTagcs)safeTag(c:cs)=toLowerc:safeTagcs-- labelled strings: labels are right-aligned at 14 characters;-- subsequent lines in multi-line output are indented accordingly.showInfoUsr::ShowInfoshowInfoUsrti=(replicate(14-length(t))' ')++t++": "++(concat$intersperse('\n':(replicate16' '))$linesi)++"\n"typePutInfo=String->String->IO()putInfo::ShowInfo->PutInfoputInfomti=unless(nulli)(putStr$mti)-- Primary show-repo operation. Determines ordering of output for-- sub-displays. The `out' argument is one of the above operations to-- output a labelled text string or an XML tag and contained value.actuallyShowRepo::RepoPatchp=>PutInfo->RepositorypC(rur)->IO()actuallyShowRepooutr@(Repolocoptsrfrt)=dowhen(XMLOutput`elem`opts)(putStr"<repository>\n")showRepoTypeoutrtwhen(Verbose`elem`opts)(out"Show"$showr)showRepoFormatoutrfout"Root"locshowRepoAuxoutrtshowRepoPrefsoutunless(NoFiles`elem`opts)(numPatchesr>>=(out"Num Patches".show))showRepoMOTDoutrwhen(XMLOutput`elem`opts)(putStr"</repository>\n")-- Most of the actual elements being displayed are part of the Show-- class; that's fine for a Haskeller, but not for the common user, so-- the routines below work to provide more human-readable information-- regarding the repository elements.showRepoType::PutInfo->RepoTypep->IO()showRepoTypeout(DarcsRepository__)=out"Type""darcs"showRepoFormat::PutInfo->RepoFormat->IO()showRepoFormatout(RFrf)=out"Format"$concat$intersperse", "(map(concat.intersperse"|".mapBC.unpack)rf)showRepoAux::PutInfo->RepoTypep->IO()showRepoAuxout(DarcsRepositorypriscs)=doout"Pristine"$showprisout"Cache"$concat$intersperse", "$lines$showcsshowRepoPrefs::PutInfo->IO()showRepoPrefsout=dogetPreflist"prefs">>=mapM_prefOutgetPreflist"author">>=out"Author".unlinesgetPreflist"defaultrepo">>=out"Default Remote".unlineswhereprefOut=uncurryout.(\(p,v)->(p++" Pref",(dropWhileisSpacev))).breakisSpaceshowRepoMOTD::RepoPatchp=>PutInfo->RepositorypC(rur)->IO()showRepoMOTDout(Repoloc___)=getMotdloc>>=out"MOTD".BC.unpack-- Support routines to provide information used by the PutInfo operations above.numPatches::RepoPatchp=>RepositorypC(rur)->IOIntnumPatchesr=readRepor>>=(return.lengthRL.newset2RL)