%  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! 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 show 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, isSpace )
import Data.List ( intersperse )
import Control.Monad ( when, unless )
import Text.Html ( tag, stringToHtml )
import FastPackedString ( unpackPS )
import Darcs.Arguments ( DarcsFlag(..), working_repo_dir, files, xmloutput )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Repository ( withRepository, ($-), 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.Repository.Motd ( get_motd )
import Darcs.Global ( darcsdir )
import Darcs.Patch ( RepoPatch )
import Darcs.Patch.Ordered ( lengthRL, mapRL_RL, unsafeUnRL )
import Darcs.Sealed ( unsealM )
\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 "++darcsdir++" 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 summary 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, 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 _ = let put_mode = if XMLOutput `elem` opts then showInfoXML else showInfoUsr
                  in withRepository opts $- \repository -> showRepo (putInfo put_mode) repository
\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 ()
putInfo :: ShowInfo -> PutInfo
putInfo 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 :: RepoPatch p => PutInfo -> Repository p -> IO ()
showRepo out r@(Repo loc opts rf rt) = do
         when (XMLOutput `elem` opts) (putStr "<repository>\n")
         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 "Num Patches" . show ))
         showRepoMOTD out r
         when (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 -> RepoType p -> IO ()
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 p -> IO ()
showRepoAux out (DarcsRepository pris cs) = showPristine out pris
                                            >> showCaches out cs

showRepoPrefs :: PutInfo -> IO ()
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

showRepoMOTD :: RepoPatch p => PutInfo -> Repository p -> IO ()
showRepoMOTD out (Repo loc _ _ _) = get_motd loc >>= out "MOTD" . unpackPS
\end{code}


\begin{code}
-- Support routines to provide information used by the PutInfo operations above.

numPatches :: RepoPatch p => Repository p -> IO Int
numPatches r = read_repo r `unsealM` (return . sum . unsafeUnRL . mapRL_RL lengthRL)

\end{code}