%  Copyright (C) 2002-2004 David Roundy
%
%  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; if not, write to the Free Software Foundation,
%  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
\chapter{Web interface}
\label{web_interface}

The \verb!darcs! web interface allows you to conveniently browse the
information stored in a repository.  You can view the repo by file and see
the history of that file as various patches were applied, or you can browse
in patch view mode, seeing which files were modified in each patch.

\begin{code}
module Main (main) where

import CGI
import IO
import Monad ( liftM, liftM2 )
import FastPackedString
import List ( sort )
import Text.Html

import SHA1 ( sha1PS )
import Patch
import PatchInfo
import Repository
import Directory
import Autoconf
import PopulationData
import Population ( getRepoPopVersion )
import DarcsUtils
#include "impossible.h"
\end{code}

\begin{code}
main :: IO ()
main = do
  my_reposdir <- read_conf "reposdir"
  setCurrentDirectory my_reposdir
  wrapper $ cache_page make_page
\end{code}

\begin{code}
cache_page :: ([(String,String)] -> IO Html) -> [(String,String)] -> IO Html
cache_page mp a = do
  cachedir <- read_conf "cachedir"
  have_cachedir <- doesDirectoryExist cachedir
  if not have_cachedir
   then mp a -- if there's no cachedir, just don't use a cache!  :)
   else
    case takeWhile (/='*') query of
    "" -> mp a
    rn ->do cached <- (++"/"++qn) `liftM` read_conf "cachedir"
            repoinv <- (++"/"++rn++"/_darcs/inventory")
                       `liftM` read_conf "reposdir"
            is_cached <- doesFileExist cached
            is_changed <- is_newer repoinv cached
            if is_cached && not is_changed
               then do liftM primHtml $ readFile cached
               else do page <- mp a
                       writeFile cached (renderHtml page)
                       return page
    where query = get_query a
          qn = sha1PS (packString query)
is_newer :: FilePath -> FilePath -> IO Bool
is_newer fa fb = do
  fa_exists <- doesFileExist fa
  fb_exists <- doesFileExist fb
  if fa_exists && fb_exists
     then liftM2 (>) (getModificationTime fa) (getModificationTime fb)
     else return False
\end{code}

The \verb!darcs_cgi! cgi script allows you to browse changes made in your
darcs repository via the web.  To use it with apache, you can install it
using \verb!make installserver!, and create a cache directory at
\verb!/var/cache/darcs!.  This cache directory must be writeable by the
cgi script, which for me means \verb!chown!ing it to the user and group
\verb!www-data!.  Finally, you should create a directory named {\tt repos}
in {\tt /var/www}, in which you will place symlinks to the repos
themselves.  Once all this is done, the user can then browse the repos at
{\tt http://your.site/cgi-bin/darcs}.

The repos directory is configurable via the configuration file
\verb!/etc/darcs/cgi.conf!.  This file can contain comments (any line
starting with a `\#' char) and key value pairs with an equal sign in
between.  For example:
\example{cgi/cgi.conf}

\begin{code}
read_conf :: String -> IO String
read_conf var = do
  ls <- (map (takeWhile (/='#')).lines) `liftM` readFile (darcsconfdir ++ "/cgi.conf")
        `catchall` return []
  case filter ((== var).fst) $ map (break (== '=') . filter (/=' ')) ls of
      [(_,val)] -> return $ tail val
      _ -> return ""
\end{code}

\begin{code}
make_page :: [(String,String)] -> IO Html
make_page a =
  case get_query a of
  "" -> home_page
  _ -> case get_reponame a of
       ("Error",msg) -> return $ htmlError $ "Bad URL:\n"++msg
       (repo,fnpn) -> do
         setCurrentDirectory repo
         patches <- read_repo_patches "."
         case fnpn of
           "" -> repo_page repo
           "*" -> patch_page repo
           _ ->
            case get_filename_and_patchname fnpn of
             ["Error",msg] -> return $ htmlError $ "Bad URL:\n"++msg
             [_,""] ->
                 return $ htmlError $ "Haven't yet implemented file view."
             ["",pn] ->
                 case get_patchinfo_from_name pn patches of
                 Nothing -> return $ htmlError $ "Patch "++pn++" does not exist."
                 Just pinfo -> one_patch_page repo pinfo
             [filename,pn,createdname,cn] ->
                 case (get_patchinfo_from_name pn patches,
                       get_patchinfo_from_name cn patches) of
                 (Just pinfo, Just ci) -> do
                     mf <- get_markedup_file ci createdname
                     return $ make_markedup_page repo filename pinfo
                              createdname ci (map fst patches) mf
                 _ -> return $ htmlError $
                      "Patch "++pn++" or maybe "++cn++" does not exist."
             _ -> impossible
\end{code}

The page, {\tt http://your.site/cgi-bin/darcs}, displays a listing of all
repos available on the server.  From this page, the user can get to any
available repository.

\begin{code}
home_page :: IO Html
home_page = do
  repos <- getDirectoryContents "."
  return $ header << thetitle << "Darcs repositories:" +++
         body ! [bgcolor "#ffffff"] <<
                  (h1 << toHtml "Darcs repositories:")
                  +++ h3 << (link_repos $ filter (\s->head s /= '.') repos)

link_repos :: [FilePath] -> Html
link_repos repos = foldl (+++) br $
                   map (\r-> hotlink ("darcs?"++r++"*") [toHtml r] +++ br) repos
\end{code}

Clicking on a given repository will take you to the file view page of that
repository, which shows a listing of all the files in the repo.  This page
also has a link to the patch view page, which is a bit more interesting.

\begin{code}
read_repo_patches :: String -> IO [(PatchInfo, Maybe Patch)]
read_repo_patches d = (reverse . concat) `liftM` read_repo d
repo_page :: String -> IO Html
repo_page repo = do
  patches <- read_repo_patches "."
  case fst $ head $ reverse $ patches of
    pinfo -> do
      pop <- getRepoPopVersion "." pinfo
      return $ header << thetitle << repotitle repo +++
             body ! [bgcolor "#ffffff"] <<
                      (h1 << (toHtml $ repotitle repo) +++
                       h3 << (hotlink ("darcs?"++repo++"**")
                              [toHtml "Switch to patch view"]) +++
                       pop_to_html (repo++"*") pop)
repotitle :: String -> String
repotitle repo = "The darcs '"++repo++"' repository"
\end{code}

In patch view mode, the web interface displays a listing of all the patches
in the repo.  Clicking on a patch gives a listing of all files that were in
the repo at the time that patch was applied.

\begin{code}
patch_page :: String -> IO Html
patch_page repo = do
  patches <- read_repo_patches "."
  return $ header << thetitle << repotitle repo +++
               body ! [bgcolor "#ffffff"] <<
                        (h1 << (toHtml $ repotitle repo) +++
                         h3 << (hotlink ("darcs?"++repo++"*")
                                [toHtml "Switch to file view"]) +++
                         (table ! [border 0] <<
                          (foldl (above) (cell $ h3 << "Patches")
                           (map (toHtml.(repopatchinfo repo).fst) $ reverse patches))))
\end{code}

Clicking on one of the files shows the file contents, with added lines
shown in green, and removed ones in red.  To the left of each line is a
small `+' and `-'.  These are links to the patch which added or removed
that line.

\begin{code}
one_patch_page :: String -> PatchInfo -> IO Html
one_patch_page repo pinfo = do
  pop <- getRepoPopVersion "." pinfo
  return $ header << thetitle << ("Patch:  "++just_name pinfo) +++
         body ! [bgcolor "#ffffff"] <<
                  (h3 << (hotlink ("darcs?"++repo++"**")
                          [toHtml $ "Patch:  "++just_name pinfo]) +++
                   pop_to_html (repo++"*") pop)

\end{code}

\begin{code}
make_markedup_page :: String -> FilePath -> PatchInfo
                   -> FilePath -> PatchInfo -> [PatchInfo]
                   -> MarkedUpFile -> Html
make_markedup_page repo f pinfo cfn ci ps mk =
  header << thetitle << (f++" ** "++just_name pinfo) +++
    body ! [bgcolor "#ffffff"] <<
             (nav repo f pinfo cfn ci ps +++
              h1 << font! [color blue] << f +++
              h2 << ("Patch:  "++just_name pinfo) +++
              font! [face "Courier"] <<
              markup_html (repo++"*"++f) pinfo cfn ci ps mk)

markup_html :: FilePath -> PatchInfo -> FilePath
            -> PatchInfo -> [PatchInfo] -> MarkedUpFile -> Html
markup_html _ _ _ _ _ [] = p << ""
markup_html f pinfo cfn ci ps ((l,None):mk) =
    cl +++ font! [color black] << line_to_html (unpackPS l)
           +++ (markup_html f pinfo cfn ci ps mk)
    where cl = changelink f cfn ci $ None
markup_html f pinfo cfn ci ps ((l,RemovedLine thei):mk) =
    if pinfo == thei
    then cl +++ font! [color red] << line_to_html (unpackPS l)
             +++ (markup_html f pinfo cfn ci ps mk)
    else if is_old_patch pinfo ps thei
    then markup_html f pinfo cfn ci ps mk
    else markup_html f pinfo cfn ci ps mk
    where cl = changelink f cfn ci $ RemovedLine thei
markup_html f pinfo cfn ci ps ((l,AddedLine thei):mk) =
    if pinfo == thei
    then cl +++ font! [color green] << line_to_html (unpackPS l)
             +++ (markup_html f pinfo cfn ci ps mk)
    else if is_old_patch pinfo ps thei
    then cl +++ font! [color black] << line_to_html (unpackPS l)
             +++ (markup_html f pinfo cfn ci ps mk)
    else markup_html f pinfo cfn ci ps mk
    where cl = changelink f cfn ci $ AddedLine thei
markup_html f pinfo cfn ci ps ((l,AddedRemovedLine add removed):mk) =
    if pinfo == removed
    then cl +++ font! [color red] << line_to_html (unpackPS l)
             +++ (markup_html f pinfo cfn ci ps mk)
    else if pinfo == add
    then cl +++ font! [color green] << line_to_html (unpackPS l)
             +++ (markup_html f pinfo cfn ci ps mk)
    else if is_old_patch pinfo ps add && (not $ is_old_patch pinfo ps removed)
    then cl +++ font! [color black] << line_to_html (unpackPS l)
             +++ markup_html f pinfo cfn ci ps mk
    else markup_html f pinfo cfn ci ps mk
    where cl = changelink f cfn ci $ AddedRemovedLine add removed

changelink :: FilePath -> FilePath -> PatchInfo -> LineMark -> Html
changelink f cfn ci (RemovedLine pinfo) =
    font ! [color black] << "+" +++
             (((toHtml $ hotlink ("darcs?"++f++"*"++make_filename pinfo
                                  ++"*"++cfn++"*"++make_filename ci)
                [toHtml "-"])
               ! [thestyle "text-decoration:none"]) +++
              spaceHtml)
changelink f cfn ci (AddedLine pinfo) =
    font ! [color black] <<
             (((toHtml $ hotlink ("darcs?"++f++"*"++make_filename pinfo
                                  ++"*"++cfn++"*"++make_filename ci) [toHtml "+"])
               ! [thestyle "text-decoration:none"]) +++
              "-" +++ spaceHtml)
changelink f cfn ci (AddedRemovedLine add removed) =
    font ! [color black] <<
             (((toHtml $ hotlink ("darcs?"++f++"*"++make_filename add
                                  ++"*"++cfn++"*"++make_filename ci)
                [toHtml "+"])
               ! [thestyle "text-decoration:none"]) +++
              ((toHtml $ hotlink ("darcs?"++f++"*"++make_filename removed
                                  ++"*"++cfn++"*"++make_filename ci)
                [toHtml "-"])
               ! [thestyle "text-decoration:none"]) +++
              spaceHtml)
changelink _ _ _ _ =
    font ! [color black] << "+-" +++ spaceHtml

is_old_patch :: PatchInfo -> [PatchInfo] -> PatchInfo -> Bool
is_old_patch now (i:is) this =
    if this == now then False
    else if i == now then False
    else if i == this then True
    else is_old_patch now is this
is_old_patch _ [] _ = impossible

line_to_html :: String -> Html
line_to_html "" = br
line_to_html (' ':s) = spaceHtml +++ line_to_html s
line_to_html ('\t':s) = spaceHtml +++ spaceHtml +++ line_to_html s
line_to_html (c:s) = c +++ line_to_html s
\end{code}

\begin{code}
htmlError :: String -> Html
htmlError e
      = header
        << thetitle
           << ("Error: "++e)
   +++ body ! [bgcolor "#aaff88"] << (h1 << "Error! "+++br+++e)
\end{code}

\begin{code}
nav :: String -> FilePath -> PatchInfo -> FilePath -> PatchInfo -> [PatchInfo] -> Html
nav repo f pinfo cfn ci ps =
    let
      b = case before_pi pinfo ps of
          Nothing -> "darcs?"++repo++"*"
          Just bi -> "darcs?"++repo++"*"++f++"*"++make_filename bi++
                     "*"++cfn++"*"++make_filename ci
      a = case after_pi pinfo ps of
          Nothing -> "darcs?"++repo++"*"
          Just ai -> "darcs?"++repo++"*"++f++"*"++make_filename ai++
                     "*"++cfn++"*"++make_filename ci
    in
    table ! [border 0] << ((td ! [align "left"] <<
                            hotlink b [h4 << "Previous patch"])
                           `beside`
                           (td ! [align "center"] <<
                            hotlink ("darcs?"++repo++"*") [h4 << "Home"])
                           `beside`
                           (td ! [align "right"] <<
                            hotlink a [h4 << "Next patch"]))

before_pi :: PatchInfo -> [PatchInfo] -> Maybe PatchInfo
before_pi _ [] = Nothing
before_pi _ [_] = Nothing
before_pi pinfo (b:it:ps)
    | it == pinfo = Just b
    | otherwise = before_pi pinfo (it:ps)
after_pi :: PatchInfo -> [PatchInfo] -> Maybe PatchInfo
after_pi _ [] = Nothing
after_pi _ [_] = Nothing
after_pi pinfo (it:a:ps)
    | it == pinfo = Just a
    | otherwise = after_pi pinfo (a:ps)
\end{code}

\begin{code}
get_reponame :: [(String,String)] -> (String,String)
get_reponame env = let query = get_query env in
    if not $ '*' `elem` query
    then ("Error","Bad reponame etc: "++query)
    else case break (=='*') query of
         ("",_) -> ("Error","Empty reponame: "++query)
         (reponame,star_pnfn) -> (reponame, tail star_pnfn)
\end{code}

\begin{code}
get_filename_and_patchname :: String -> [String]
get_filename_and_patchname query =
  case length (filter (=='*') query) of
  3 -> case break (=='*') query of
       (f,q') ->
           case break (=='*') $ tail q' of
           (pn,q'') ->
               case break (=='*') $ tail q'' of
               (cfn,cn) -> [f,pn,cfn,tail cn]
  1 -> case break (=='*') query of
       (f,pat) -> [f,tail pat]
  _ -> ["Error","Bad filename and patchname: "++query]
\end{code}

\begin{code}
pop_to_html :: String -> Population -> Html
pop_to_html before (Pop pinfo (PopDir _ pops)) =
    foldl (+++) noh $ map (p2h before pinfo "./" noh) $ sort pops
    where noh = toHtml ""
pop_to_html _ _ = bug "Bug in pop_to_html"
p2h :: String -> PatchInfo -> FilePath -> Html -> PopTree -> Html
p2h before pinfo dir indent (PopFile info) =
    indent +++
    hotlink ("darcs?"++before++fullf++"*"++make_filename pinfo++"*"++cn++"*"++cp) [toHtml f] +++
    file_change+++br
        where f = unpackPS $ nameI info
              fullf = dir ++ f
              cn = unpackPS $ fromJust $ creationNameI info
              cp = make_filename $ fromJust $ createdByI info
              file_change = if modifiedByI info == pinfo
                            then toHtml $ " "++show (modifiedHowI info)
                            else toHtml ""
p2h before pinfo dir indent (PopDir info pops) =
    foldl (+++) (indent +++ toHtml thisdir +++ dir_change +++ br) $
          map (p2h before pinfo fulldir (indent+++indmore)) $ sort pops
    where fulldir = dir ++ thisdir
          thisdir = unpackPS (nameI info) ++ "/"
          indmore = spaceHtml +++ spaceHtml +++ spaceHtml +++ spaceHtml
          dir_change = if modifiedByI info == pinfo
                       then toHtml $ " "++show (modifiedHowI info)
                       else toHtml ""
\end{code}

\begin{code}
get_patchinfo_from_name :: String -> [(PatchInfo,Maybe Patch)] -> Maybe PatchInfo
get_patchinfo_from_name _ [] = Nothing
get_patchinfo_from_name n ((pinfo,_):pps) =
  if n == make_filename pinfo then Just pinfo
  else get_patchinfo_from_name n pps
\end{code}

\begin{code}
get_query :: [(String,String)] -> String
get_query [] = ""
get_query (("QUERY_STRING",query):_) = query
get_query (_:as) = get_query as
\end{code}