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 \darcsCommand{show repo}
   19 
   20 The \verb!show repo! displays information about
   21 the current repository: the location, the type, etc.
   22 
   23 This is provided as informational output for two purposes: curious
   24 users and scripts invoking darcs.  For the latter, this information
   25 can be parsed to facilitate the script; for example,
   26 \verb!darcs show repo | grep Root: | awk {print $2}!
   27 can be used to locate the
   28 top-level \verb!_darcs! directory from anyplace within a darcs repository
   29 working directory.
   30 
   31 \begin{code}
   32 {-# OPTIONS_GHC -cpp #-}
   33 {-# LANGUAGE CPP #-}
   34 #include "gadts.h"
   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.Patch ( RepoPatch )
   49 import Darcs.Ordered ( lengthRL, concatRL )
   50 import qualified Data.ByteString.Char8 as BC  (unpack)
   51 
   52 show_repo_help :: String
   53 show_repo_help =
   54  "The repo command displays information about the current repository\n" ++
   55  "(location, type, etc.).  Some of this information is already available\n" ++
   56  "by inspecting files within the _darcs directory and some is internal\n" ++
   57  "information that is informational only (i.e. for developers).  This\n" ++
   58  "command collects all of the repository information into a readily\n" ++
   59  "available source.\n"
   60 
   61 show_repo_description :: String
   62 show_repo_description = "Show repository summary information"
   63 
   64 show_repo :: DarcsCommand
   65 show_repo = DarcsCommand { command_name = "repo",
   66                            command_help = show_repo_help,
   67                            command_description = show_repo_description,
   68                            command_extra_args = 0,
   69                            command_extra_arg_help = [],
   70                            command_command = repo_cmd,
   71                            command_prereq = amInRepository,
   72                            command_get_arg_possibilities = return [],
   73                            command_argdefaults = nodefaults,
   74                            command_advanced_options = [],
   75                            command_basic_options = [working_repo_dir, files, xmloutput] }
   76 \end{code}
   77 
   78 \begin{options}
   79 --files, --no-files
   80 \end{options}
   81 
   82 If the \verb!--files! option is specified (the default), then the
   83 \verb!show repo! operation will read patch information from the
   84 repository and display the number of patches in the repository.  The
   85 \verb!--no-files! option can be used to suppress this operation (and
   86 improve performance).
   87 
   88 \begin{code}
   89 repo_cmd :: [DarcsFlag] -> [String] -> IO ()
   90 repo_cmd opts _ = let put_mode = if XMLOutput `elem` opts then showInfoXML else showInfoUsr
   91                   in withRepository opts $- \repository -> showRepo (putInfo put_mode) repository
   92 \end{code}
   93 
   94 \begin{options}
   95 --human-readable, --xml-output
   96 \end{options}
   97 
   98 By default, the \verb!show repo! displays output in human readable
   99 form, but the \verb!--xml-output! option can be used to obtain
  100 XML-formatted to facilitate regular parsing by external tools.
  101 
  102 \begin{code}
  103 -- Some convenience functions to output a labelled text string or an
  104 -- XML tag + value (same API).  If no value, output is suppressed
  105 -- entirely.  Borrow some help from Text.Html to perform XML output.
  106 
  107 type ShowInfo = String -> String -> String
  108 
  109 showInfoXML :: ShowInfo
  110 showInfoXML t i = show $ tag (safeTag t) $ stringToHtml i
  111 
  112 safeTag :: String -> String
  113 safeTag [] = []
  114 safeTag (' ':cs) = safeTag cs
  115 safeTag ('#':cs) = "num_" ++ (safeTag cs)
  116 safeTag (c:cs) = toLower c : safeTag cs
  117 
  118 -- labelled strings: labels are right-aligned at 14 characters;
  119 -- subsequent lines in multi-line output are indented accordingly.
  120 showInfoUsr :: ShowInfo
  121 showInfoUsr t i = (replicate (14 - length(t)) ' ') ++ t ++ ": " ++
  122                   (concat $ intersperse ('\n' : (replicate 16 ' ')) $ lines i) ++ "\n"
  123 
  124 type PutInfo = String -> String -> IO ()
  125 putInfo :: ShowInfo -> PutInfo
  126 putInfo m t i = unless (null i) (putStr $ m t i)
  127 
  128 -- Primary show-repo operation.  Determines ordering of output for
  129 -- sub-displays.  The `out' argument is one of the above operations to
  130 -- output a labelled text string or an XML tag and contained value.
  131 
  132 showRepo :: RepoPatch p => PutInfo -> Repository p C(r u r) -> IO ()
  133 showRepo out r@(Repo loc opts rf rt) = do
  134          when (XMLOutput `elem` opts) (putStr "<repository>\n")
  135          showRepoType out rt
  136          when (Verbose `elem` opts) (out "Show" $ show r)
  137          showRepoFormat out rf
  138          out "Root" loc
  139          showRepoAux out rt
  140          showRepoPrefs out
  141          unless (NoFiles `elem` opts) (numPatches r >>= (out "Num Patches" . show ))
  142          showRepoMOTD out r
  143          when (XMLOutput `elem` opts) (putStr "</repository>\n")
  144 
  145 -- Most of the actual elements being displayed are part of the Show
  146 -- class; that's fine for a Haskeller, but not for the common user, so
  147 -- the routines below work to provide more human-readable information
  148 -- regarding the repository elements.
  149 
  150 showRepoType :: PutInfo -> RepoType p -> IO ()
  151 showRepoType out (DarcsRepository _ _) = out "Type" "darcs"
  152 
  153 showRepoFormat :: PutInfo -> RepoFormat -> IO ()
  154 showRepoFormat out (RF rf) = out "Format" $
  155     concat $ intersperse ", " (map (concat . intersperse "|" . map BC.unpack) rf)
  156 
  157 showRepoAux :: PutInfo -> RepoType p -> IO ()
  158 showRepoAux out (DarcsRepository pris cs) =
  159     do out "Pristine" $ show pris
  160        out "Cache" $ concat $ intersperse ", " $ lines $ show cs
  161 
  162 
  163 showRepoPrefs :: PutInfo -> IO ()
  164 showRepoPrefs out = do
  165     get_preflist "prefs" >>= mapM_ prefOut
  166     get_preflist "author" >>= out "Author" . unlines
  167     get_preflist "defaultrepo" >>= out "Default Remote" . unlines
  168   where prefOut = uncurry out . (\(p,v) -> (p++" Pref", (dropWhile isSpace v))) . break isSpace
  169 
  170 showRepoMOTD :: RepoPatch p => PutInfo -> Repository p C(r u r) -> IO ()
  171 showRepoMOTD out (Repo loc _ _ _) = get_motd loc >>= out "MOTD" . BC.unpack
  172 
  173 -- Support routines to provide information used by the PutInfo operations above.
  174 
  175 numPatches :: RepoPatch p => Repository p C(r u r) -> IO Int
  176 numPatches r = read_repo r >>= (return . lengthRL . concatRL)
  177 
  178 \end{code}