src/Darcs/Commands/ShowRepo.lhs

   1 %  Copyright (C) 2007 Kevin Quick
   2 %
   3 %  This program is free software; you can redistribute it and/or modify
   4 %  it under the terms of the GNU General Public License as published by
   5 %  the Free Software Foundation; either version 2, or (at your option)
   6 %  any later version.
   7 %
   8 %  This program is distributed in the hope that it will be useful,
   9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 %  GNU General Public License for more details.
  12 %
  13 %  You should have received a copy of the GNU General Public License
  14 %  along with this program; see the file COPYING.  If not, write to
  15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  16 %  Boston, MA 02110-1301, USA.
  17
  18 \subsubsection{darcs show repo}
  19 %%\label{show-repo}
  20
  21 \options{show repo}
  22
  23 The \verb!show repo! displays information about
  24 the current repository: the location, the type, etc.
  25
  26 This is provided as informational output for two purposes: curious
  27 users and scripts invoking darcs.  For the latter, this information
  28 can be parsed to facilitate the script; for example,
  29 \verb!darcs show repo | grep Root: | awk {print $2}!
  30 can be used to locate the
  31 top-level \verb!_darcs! directory from anyplace within a darcs repository
  32 working directory.
  33
  34 \begin{code}
  35 module Darcs.Commands.ShowRepo ( show_repo ) where
  36
  37 import Data.Char ( toLower, isSpace )
  38 import Data.List ( intersperse )
  39 import Control.Monad ( when, unless )
  40 import Text.Html ( tag, stringToHtml )
  41 import Darcs.Arguments ( DarcsFlag(..), working_repo_dir, files, xmloutput )
  42 import Darcs.Commands ( DarcsCommand(..), nodefaults )
  43 import Darcs.Repository ( withRepository, ($-), amInRepository, read_repo )
  44 import Darcs.Repository.Internal ( Repository(..), RepoType(..) )
  45 import Darcs.Repository.Format ( RepoFormat(..) )
  46 import Darcs.Repository.Prefs ( get_preflist )
  47 import Darcs.Repository.Motd ( get_motd )
  48 import Darcs.Global ( darcsdir )
  49 import Darcs.Patch ( RepoPatch )
  50 import Darcs.Ordered ( lengthRL, mapRL_RL, unsafeUnRL )
  51 import qualified Data.ByteString.Char8 as BC  (unpack)
  52 \end{code}
  53
  54 \begin{code}
  55 show_repo_help :: String
  56 show_repo_help =
  57  "The repo command displays information about the current repository\n" ++
  58  "(location, type, etc.).  Some of this information is already available\n" ++
  59  "by inspecting files within the "++darcsdir++" directory and some is internal\n" ++
  60  "information that is informational only (i.e. for developers).  This\n" ++
  61  "command collects all of the repository information into a readily\n" ++
  62  "available source.\n"
  63
  64 show_repo_description :: String
  65 show_repo_description = "Show repository summary information"
  66 \end{code}
  67
  68
  69 \begin{code}
  70 show_repo :: DarcsCommand
  71 show_repo = DarcsCommand { command_name = "repo",
  72                            command_help = show_repo_help,
  73                            command_description = show_repo_description,
  74                            command_extra_args = 0,
  75                            command_extra_arg_help = [],
  76                            command_command = repo_cmd,
  77                            command_prereq = amInRepository,
  78                            command_get_arg_possibilities = return [],
  79                            command_argdefaults = nodefaults,
  80                            command_advanced_options = [],
  81                            command_basic_options = [working_repo_dir, files, xmloutput] }
  82 \end{code}
  83
  84 \begin{options}
  85 --files, --no-files
  86 \end{options}
  87
  88 If the \verb!--files! option is specified (the default), then the
  89 \verb!show repo! operation will read patch information from the
  90 repository and display the number of patches in the repository.  The
  91 \verb!--no-files! option can be used to suppress this operation (and
  92 improve performance).
  93
  94 \begin{code}
  95 repo_cmd :: [DarcsFlag] -> [String] -> IO ()
  96 repo_cmd opts _ = let put_mode = if XMLOutput `elem` opts then showInfoXML else showInfoUsr
  97                   in withRepository opts $- \repository -> showRepo (putInfo put_mode) repository
  98 \end{code}
  99
 100 \begin{options}
 101 --human-readable, --xml-output
 102 \end{options}
 103
 104 By default, the \verb!show repo! displays output in human readable
 105 form, but the \verb!--xml-output! option can be used to obtain
 106 XML-formatted to facilitate regular parsing by external tools.
 107
 108 \begin{code}
 109 -- Some convenience functions to output a labelled text string or an
 110 -- XML tag + value (same API).  If no value, output is suppressed
 111 -- entirely.  Borrow some help from Text.Html to perform XML output.
 112
 113 type ShowInfo = String -> String -> String
 114
 115 showInfoXML :: ShowInfo
 116 showInfoXML t i = show $ tag (safeTag t) $ stringToHtml i
 117
 118 safeTag :: String -> String
 119 safeTag [] = []
 120 safeTag (' ':cs) = safeTag cs
 121 safeTag ('#':cs) = "num_" ++ (safeTag cs)
 122 safeTag (c:cs) = toLower c : safeTag cs
 123
 124 -- labelled strings: labels are right-aligned at 14 characters;
 125 -- subsequent lines in multi-line output are indented accordingly.
 126 showInfoUsr :: ShowInfo
 127 showInfoUsr t i = (replicate (14 - length(t)) ' ') ++ t ++ ": " ++
 128                   (concat $ intersperse ('\n' : (replicate 16 ' ')) $ lines i) ++ "\n"
 129
 130 type PutInfo = String -> String -> IO ()
 131 putInfo :: ShowInfo -> PutInfo
 132 putInfo m t i = unless (null i) (putStr $ m t i)
 133 \end{code}
 134
 135
 136 \begin{code}
 137 -- Primary show-repo operation.  Determines ordering of output for
 138 -- sub-displays.  The `out' argument is one of the above operations to
 139 -- output a labelled text string or an XML tag and contained value.
 140
 141 showRepo :: RepoPatch p => PutInfo -> Repository p -> IO ()
 142 showRepo out r@(Repo loc opts rf rt) = do
 143          when (XMLOutput `elem` opts) (putStr "<repository>\n")
 144          showRepoType out rt
 145          when (Verbose `elem` opts) (out "Show" $ show r)
 146          showRepoFormat out rf
 147          out "Root" loc
 148          showRepoAux out rt
 149          showRepoPrefs out
 150          unless (NoFiles `elem` opts) (numPatches r >>= (out "Num Patches" . show ))
 151          showRepoMOTD out r
 152          when (XMLOutput `elem` opts) (putStr "</repository>\n")
 153
 154 -- Most of the actual elements being displayed are part of the Show
 155 -- class; that's fine for a Haskeller, but not for the common user, so
 156 -- the routines below work to provide more human-readable information
 157 -- regarding the repository elements.
 158
 159 showRepoType :: PutInfo -> RepoType p -> IO ()
 160 showRepoType out (DarcsRepository _ _) = out "Type" "darcs"
 161
 162 showRepoFormat :: PutInfo -> RepoFormat -> IO ()
 163 showRepoFormat out (RF rf) = out "Format" $
 164     concat $ intersperse ", " (map (concat . intersperse "|" . map BC.unpack) rf)
 165
 166 showRepoAux :: PutInfo -> RepoType p -> IO ()
 167 showRepoAux out (DarcsRepository pris cs) =
 168     do out "Pristine" $ show pris
 169        out "Cache" $ concat $ intersperse ", " $ lines $ show cs
 170
 171
 172 showRepoPrefs :: PutInfo -> IO ()
 173 showRepoPrefs out = do
 174     get_preflist "prefs" >>= mapM_ prefOut
 175     get_preflist "author" >>= out "Author" . unlines
 176     get_preflist "defaultrepo" >>= out "Default Remote" . unlines
 177   where prefOut = uncurry out . (\(p,v) -> (p++" Pref", (dropWhile isSpace v))) . break isSpace
 178
 179 showRepoMOTD :: RepoPatch p => PutInfo -> Repository p -> IO ()
 180 showRepoMOTD out (Repo loc _ _ _) = get_motd loc >>= out "MOTD" . BC.unpack
 181 \end{code}
 182
 183
 184 \begin{code}
 185 -- Support routines to provide information used by the PutInfo operations above.
 186
 187 numPatches :: RepoPatch p => Repository p -> IO Int
 188 numPatches r = read_repo r >>= (return . sum . unsafeUnRL . mapRL_RL lengthRL)
 189
 190 \end{code}