Refactored per Eric's comments. -KQ
Thu Nov 15 23:24:53 MST 2007 Kevin Quick <[EMAIL PROTECTED]>
* Added "darcs show repo" command to display repository information
Tue Nov 20 22:23:21 MST 2007 Kevin Quick <[EMAIL PROTECTED]>
* Refactored ShowRepo implementation
-----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,
}
[Refactored ShowRepo implementation
Kevin Quick <[EMAIL PROTECTED]>**20071121052321] {
hunk ./src/Darcs/Commands/ShowRepo.lhs 23
- -The \verb!show repo! (or \verb!query repo!) displays information about
- -the current repository: the location, the type, etc.
+The \verb!show repo! displays information about
+the current repository: the location, the type, etc.
hunk ./src/Darcs/Commands/ShowRepo.lhs 29
- -\verb!darcs query repo | grep Root: | awk {print $2}!
+\verb!darcs show repo | grep Root: | awk {print $2}!
hunk ./src/Darcs/Commands/ShowRepo.lhs 37
- -import Data.Char ( toLower )
+import Data.Char ( toLower, isSpace )
hunk ./src/Darcs/Commands/ShowRepo.lhs 41
- -import FastPackedString ( unpackPS, nilPS )
+import FastPackedString ( unpackPS )
hunk ./src/Darcs/Commands/ShowRepo.lhs 49
+import Darcs.Repository.Motd ( get_motd )
hunk ./src/Darcs/Commands/ShowRepo.lhs 51
- -import Darcs.Utils ( catchall )
- -import Darcs.External ( fetchFilePS, Cachable(..) )
hunk ./src/Darcs/Commands/ShowRepo.lhs 64
- -show_repo_description = "Show repository information"
+show_repo_description = "Show repository summary information"
hunk ./src/Darcs/Commands/ShowRepo.lhs 95
- -repo_cmd opts _ = identifyRepository opts "." >>= showRepo (putInfoLn $ if XMLOutput `elem` opts then showInfoXML else showInfoUsr)
+repo_cmd opts _ = let put_mode = if XMLOutput `elem` opts then showInfoXML else showInfoUsr
+ in identifyRepository opts "." >>= showRepo (putInfo put_mode)
hunk ./src/Darcs/Commands/ShowRepo.lhs 130
- -putInfoLn :: ShowInfo -> PutInfo
- -putInfoLn m t i = unless (null i) (putStr $ m t i)
+putInfo :: ShowInfo -> PutInfo
+putInfo m t i = unless (null i) (putStr $ m t i)
hunk ./src/Darcs/Commands/ShowRepo.lhs 141
- -showRepo out r@(Repo loc opts rf rt) =
+showRepo out r@(Repo loc opts rf rt) = do
hunk ./src/Darcs/Commands/ShowRepo.lhs 143
- - >> 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
+ 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 "Num Patches" . show ))
+ showRepoMOTD out r
hunk ./src/Darcs/Commands/ShowRepo.lhs 157
- -showRepoType out GitRepository = out "Type" "GIT"
- -showRepoType out (DarcsRepository _ _) = out "Type" "Darcs"
+showRepoType out GitRepository = out "Type" "Git"
+showRepoType out (DarcsRepository _ _) = out "Type" "darcs"
hunk ./src/Darcs/Commands/ShowRepo.lhs 175
- -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
+showRepoPrefs out = do
+ get_preflist "prefs" >>= mapM_ prefOut
+ get_preflist "author" >>= out "Author" . unlines
+ get_preflist "defaultrepo" >>= out "Default Remote" . unlines
+ where prefOut = uncurry out . (\(p,v) -> (p++" Pref", (dropWhile isSpace v))) . break isSpace
hunk ./src/Darcs/Commands/ShowRepo.lhs 182
- -showRepoMOTD out (Repo loc opts _ _) =
- - fetchFilePS opts (loc++"/_darcs/prefs/motd") (MaxAge 600) `catchall` return nilPS
- - >>= out "MOTD" . unpackPS
+showRepoMOTD out (Repo loc opts _ _) = get_motd opts loc >>= out "MOTD" . unpackPS
hunk ./src/Darcs/Repository/Motd.lhs 20
- -module Darcs.Repository.Motd (show_motd) where
+module Darcs.Repository.Motd (get_motd, show_motd) where
hunk ./src/Darcs/Repository/Motd.lhs 24
- -import FastPackedString ( nullPS, nilPS, hPutPS )
+import FastPackedString ( nullPS, nilPS, hPutPS, PackedString )
hunk ./src/Darcs/Repository/Motd.lhs 35
+get_motd :: [DarcsFlag] -> String -> IO PackedString
+get_motd opts repo = fetchFilePS opts (repo++"/_darcs/prefs/motd") (MaxAge 600)
+ `catchall` return nilPS
+
hunk ./src/Darcs/Repository/Motd.lhs 40
- -show_motd opts repo = do
- - motd <- fetchFilePS opts (repo++"/_darcs/prefs/motd") (MaxAge 600)
- - `catchall` return nilPS
- - unless (nullPS motd || Quiet `elem` opts)
+show_motd opts repo = unless (Quiet `elem` opts) $ do
+ motd <- get_motd opts repo
+ unless (nullPS motd)
}
Context:
[TAG darcs unstable 2007-11-04
Eric Kow <[EMAIL PROTECTED]>**20071104235616]
Patch bundle hash:
58cc387688400657e089da5c5c211455f00ed692
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v2.0.6 (GNU/Linux)
iD8DBQFHQ8jJt76lKrRL0ewRAlRxAJ9tvY5sYacPnXomQTsLzGY2kHXIqACeO721
YeEuRlz4Hw7JG1sZ114JgO8=
=xygt
-----END PGP SIGNATURE-----
_______________________________________________
darcs-devel mailing list
[email protected]
http://lists.osuosl.org/mailman/listinfo/darcs-devel
