Rather than provide a broken patch and a patch that fixes it, here's
a single patch for the entire thing and which isn't broken. This
supercedes the previous two (in case the previous version haven't
been committed yet).
-KQ
Thu Nov 15 23:24:53 MST 2007 Kevin Quick <[EMAIL PROTECTED]>
* Added "darcs show repo" command to display repository information
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
New patches:
[Added "darcs show repo" command to display repository information
Kevin Quick <[EMAIL PROTECTED]>**20071116062453] {
hunk ./GNUmakefile 106
- - Show.lhs ShowContents.lhs ShowFiles.lhs ShowTags.lhs \
+ Show.lhs ShowContents.lhs ShowFiles.lhs ShowTags.lhs ShowRepo.lhs \
hunk ./src/Darcs/Commands/Show.lhs 28
+import Darcs.Commands.ShowRepo ( show_repo )
hunk ./src/Darcs/Commands/Show.lhs 46
+ Command_data show_repo,
hunk ./src/Darcs/Commands/Show.lhs 65
+\input{Darcs/Commands/ShowRepo.lhs}
+
addfile ./src/Darcs/Commands/ShowRepo.lhs
hunk ./src/Darcs/Commands/ShowRepo.lhs 1
+% 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.
+
+\subsubsection{darcs show repo}
+%%\label{show-repo}
+
+\options{show repo}
+
+The \verb!show repo! (or \verb!query repo!) displays information about
+the current repository: the location, the type, etc.
+
+This is provided as informational output for two purposes: curious
+users and scripts invoking darcs. For the latter, this information
+can be parsed to facilitate the script; for example,
+\verb!darcs query repo | grep Root: | awk {print $2}!
+can be used to locate the
+top-level \verb!_darcs! directory from anyplace within a darcs repository
+working directory.
+
+\begin{code}
+module Darcs.Commands.ShowRepo ( show_repo ) where
+
+import Data.Char ( toLower )
+import Data.List ( intersperse )
+import Control.Monad ( when, unless )
+import Text.Html ( tag, stringToHtml )
+import FastPackedString ( unpackPS, nilPS )
+import Darcs.Arguments ( DarcsFlag(..), working_repo_dir, verbose, files, xmloutput )
+import Darcs.Commands ( DarcsCommand(..), nodefaults )
+import Darcs.Repository ( identifyRepository, amInRepository, read_repo )
+import Darcs.Repository.Internal ( Repository(..), RepoType(..) )
+import Darcs.Repository.Format ( RepoFormat(..) )
+import Darcs.Repository.Pristine ( Pristine )
+import Darcs.Repository.Prefs ( Cache, get_preflist )
+import Darcs.Patch.Ordered ( lengthRL, mapRL_RL, unsafeUnRL )
+import Darcs.Utils ( catchall )
+import Darcs.External ( fetchFilePS, Cachable(..) )
+\end{code}
+
+\begin{code}
+show_repo_help :: String
+show_repo_help =
+ "The repo command displays information about the current repository\n" ++
+ "(location, type, etc.). Some of this information is already available\n" ++
+ "by inspecting files within the _darcs directory and some is internal\n" ++
+ "information that is informational only (i.e. for developers). This\n" ++
+ "command collects all of the repository information into a readily\n" ++
+ "available source.\n"
+
+show_repo_description :: String
+show_repo_description = "Show repository information"
+\end{code}
+
+
+\begin{code}
+show_repo :: DarcsCommand
+show_repo = DarcsCommand { command_name = "repo",
+ command_help = show_repo_help,
+ command_description = show_repo_description,
+ command_extra_args = 0,
+ command_extra_arg_help = [],
+ command_command = repo_cmd,
+ command_prereq = amInRepository,
+ command_get_arg_possibilities = return [],
+ command_argdefaults = nodefaults,
+ command_advanced_options = [],
+ command_basic_options = [working_repo_dir, verbose, files, xmloutput] }
+\end{code}
+
+\begin{options}
+--files, --no-files
+\end{options}
+
+If the \verb!--files! option is specified (the default), then the
+\verb!show repo! operation will read patch information from the
+repository and display the number of patches in the repository. The
+\verb!--no-files! option can be used to suppress this operation (and
+improve performance).
+
+\begin{code}
+repo_cmd :: [DarcsFlag] -> [String] -> IO ()
+repo_cmd opts _ = identifyRepository opts "." >>= showRepo (putInfoLn $ if XMLOutput `elem` opts then showInfoXML else showInfoUsr)
+\end{code}
+
+\begin{options}
+--human-readable, --xml-output
+\end{options}
+
+By default, the \verb!show repo! displays output in human readable
+form, but the \verb!--xml-output! option can be used to obtain
+XML-formatted to facilitate regular parsing by external tools.
+
+\begin{code}
+-- 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.
+
+type ShowInfo = String -> String -> String
+
+showInfoXML :: ShowInfo
+showInfoXML t i = show $ tag (safeTag t) $ stringToHtml i
+
+safeTag :: String -> String
+safeTag [] = []
+safeTag (' ':cs) = safeTag cs
+safeTag ('#':cs) = "num_" ++ (safeTag cs)
+safeTag (c:cs) = toLower c : safeTag cs
+
+-- labelled strings: labels are right-aligned at 14 characters;
+-- subsequent lines in multi-line output are indented accordingly.
+showInfoUsr :: ShowInfo
+showInfoUsr t i = (replicate (14 - length(t)) ' ') ++ t ++ ": " ++
+ (concat $ intersperse ('\n' : (replicate 16 ' ')) $ lines i) ++ "\n"
+
+type PutInfo = String -> String -> IO ()
+putInfoLn :: ShowInfo -> PutInfo
+putInfoLn m t i = unless (null i) (putStr $ m t i)
+\end{code}
+
+
+\begin{code}
+-- 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.
+
+showRepo :: PutInfo -> Repository -> IO ()
+showRepo out r@(Repo loc opts rf rt) =
+ showRepoType out rt
+ >> when (Verbose `elem` opts) (out "Show" $ show r)
+ >> showRepoFormat out rf
+ >> out "Root" loc
+ >> showRepoAux out rt
+ >> showRepoPrefs out
+ >> unless (NoFiles `elem` opts) (numPatches r >>= (out "# Patches" . show ))
+ >> showRepoMOTD out r
+
+-- 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 -> RepoType -> IO ()
+showRepoType out GitRepository = out "Type" "GIT"
+showRepoType out (DarcsRepository _ _) = out "Type" "Darcs"
+
+showPristine :: PutInfo -> Pristine -> IO ()
+showPristine out p = out "Pristine" $ show p
+
+showCaches :: PutInfo -> Cache -> IO ()
+showCaches out c = out "Cache" $ concat $ intersperse ", " $ lines $ show c
+
+showRepoFormat :: PutInfo -> RepoFormat -> IO ()
+showRepoFormat out (RF rf) = out "Format" $ concat $ intersperse ", " (map (concat . intersperse "|" . map unpackPS) rf)
+
+showRepoAux :: PutInfo -> RepoType -> IO ()
+showRepoAux _ GitRepository = return ()
+showRepoAux out (DarcsRepository pris cs) = showPristine out pris
+ >> showCaches out cs
+
+showRepoPrefs :: PutInfo -> IO ()
+showRepoPrefs out =
+ get_preflist "prefs" >>= mapM_ (uncurry out . (\(p,v) -> (p++" Pref",v)) . break (==' '))
+ >> get_preflist "author" >>= out "Author" . unlines
+ >> get_preflist "defaultrepo" >>= out "Default Remote" . unlines
+
+showRepoMOTD :: PutInfo -> Repository -> IO ()
+showRepoMOTD out (Repo loc opts _ _) =
+ fetchFilePS opts (loc++"/_darcs/prefs/motd") (MaxAge 600) `catchall` return nilPS
+ >>= out "MOTD" . unpackPS
+\end{code}
+
+
+\begin{code}
+-- Support routines to provide information used by the PutInfo operations above.
+
+numPatches :: Repository -> IO Int
+numPatches r = read_repo r >>= return . sum . unsafeUnRL . mapRL_RL lengthRL
+
+\end{code}
hunk ./src/Darcs/Repository/Format.lhs 6
- -module Darcs.Repository.Format ( RepoFormat, RepoProperty(..), identifyRepoFormat,
+module Darcs.Repository.Format ( RepoFormat(..), RepoProperty(..), identifyRepoFormat,
}
Context:
[TAG darcs unstable 2007-11-04
Eric Kow <[EMAIL PROTECTED]>**20071104235616]
Patch bundle hash:
d0df9d28701cd69bd1c015b084bc0fd067ba2c3b
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v2.0.6 (GNU/Linux)
iD8DBQFHPe79t76lKrRL0ewRAqJ+AJ96ZBkmlti00giYuWojhi0yd4zFmQCeNViD
2cgl1z8GhqgR3Xspz6HeEjY=
=IL1F
-----END PGP SIGNATURE-----
_______________________________________________
darcs-devel mailing list
[email protected]
http://lists.osuosl.org/mailman/listinfo/darcs-devel
