% Copyright (C) 2002-2003 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; see the file COPYING. If not, write to
% the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
% Boston, MA 02110-1301, USA.
\begin{code}
module Darcs.Patch.Info ( PatchInfo, patchinfo, invert_name, is_inverted,
idpatchinfo,
make_filename, make_alt_filename, readPatchInfo,
just_name, just_author, repopatchinfo, RepoPatchInfo,
human_friendly, to_xml, pi_date, set_pi_date,
pi_name, pi_rename, pi_author, pi_tag, pi_log,
showPatchInfo,
) where
import Text.Html hiding (name, text)
import FastPackedString
import Printer ( renderString, Doc, packedString,
empty, ($$), (<>), (<+>), vcat, text, blueText, prefix )
import OldDate ( readUTCDate, showIsoDateTime )
import System.Time ( CalendarTime(ctTZ), calendarTimeToString, toClockTime,
toCalendarTime )
import System.IO.Unsafe ( unsafePerformIO )
import SHA1 ( sha1PS )
import Prelude hiding (pi, log)
data RepoPatchInfo = RPI String PatchInfo
repopatchinfo :: String -> PatchInfo -> RepoPatchInfo
repopatchinfo r pi = RPI r pi
data PatchInfo = PatchInfo { _pi_date :: !PackedString
, _pi_name :: !PackedString
, _pi_author :: !PackedString
, _pi_log :: ![PackedString]
, is_inverted :: !Bool
}
deriving (Eq,Ord)
idpatchinfo :: PatchInfo
idpatchinfo = patchinfo "identity" "identity" "identity" []
patchinfo :: String -> String -> String -> [String] -> PatchInfo
patchinfo date name author log =
PatchInfo { _pi_date = packString date
, _pi_name = packString name
, _pi_author = packString author
, _pi_log = map packString log
, is_inverted = False }
\end{code}
\section{Patch info formatting}
\begin{code}
invert_name :: PatchInfo -> PatchInfo
invert_name pi = pi { is_inverted = not (is_inverted pi) }
\end{code}
\begin{code}
just_name :: PatchInfo -> String
just_name pinf = if is_inverted pinf then "UNDO: " ++ unpackPS (_pi_name pinf)
else unpackPS (_pi_name pinf)
just_author :: PatchInfo -> String
just_author = unpackPS . _pi_author
human_friendly :: PatchInfo -> Doc
human_friendly pi =
text (friendly_d $ _pi_date pi) <> text " " <> packedString (_pi_author pi)
$$ hfn (_pi_name pi)
$$ vcat (map ((text " " <>) . packedString) (_pi_log pi))
where hfn x = case pi_tag pi of
Nothing -> inverted <+> packedString x
Just t -> text " tagged" <+> text t
inverted = if is_inverted pi then text " UNDO:" else text " *"
-- note the difference with just_name
pi_name :: PatchInfo -> String
pi_name = unpackPS . _pi_name
pi_rename :: PatchInfo -> String -> PatchInfo
pi_rename x n = x { _pi_name = packString n }
pi_author :: PatchInfo -> String
pi_author = unpackPS . _pi_author
-- | Note: we ignore timezone information in the date string,
-- systematically treating a time as UTC. So if the patch
-- tells me it's 17:00 EST, we're actually treating it as
-- 17:00 UTC, in other words 11:00 EST. This is for
-- backwards compatibility to darcs prior to 2003-11, sometime
-- before 1.0. Fortunately, newer patch dates are written in
-- UTC, so this timezone truncation is harmless for them.
readPatchDate :: PackedString -> CalendarTime
readPatchDate = ignoreTz . readUTCDate . unpackPS
where ignoreTz ct = ct { ctTZ = 0 }
pi_date :: PatchInfo -> CalendarTime
pi_date = readPatchDate . _pi_date
set_pi_date :: String -> PatchInfo -> PatchInfo
set_pi_date date pi = pi { _pi_date = packString date }
pi_log :: PatchInfo -> [String]
pi_log = map unpackPS . _pi_log
pi_tag :: PatchInfo -> Maybe String
pi_tag pinf =
if l == t
then Just $ unpackPS r
else Nothing
where (l, r) = splitAtPS (lengthPS t) (_pi_name pinf)
t = packString "TAG "
friendly_d :: PackedString -> String
--friendly_d d = calendarTimeToString . readPatchDate . d
friendly_d d = unsafePerformIO $ do
ct <- toCalendarTime $ toClockTime $ readPatchDate d
return $ calendarTimeToString ct
\end{code}
\begin{code}
to_xml :: PatchInfo -> Doc
to_xml pi =
text " text "author='" <> escapeXML (just_author pi) <> text "'"
<+> text "date='" <> escapeXML (unpackPS $ _pi_date pi) <> text "'"
<+> text "local_date='" <> escapeXML (friendly_d $ _pi_date pi) <> text "'"
<+> text "inverted='" <> text (show $ is_inverted pi) <> text "'"
<+> text "hash='" <> text (make_filename pi) <> text "'>"
$$ prefix "\t" (
text "" <> escapeXML (pi_name pi) <> text ""
$$ comments_as_xml (_pi_log pi))
$$ text ""
comments_as_xml :: [PackedString] -> Doc
comments_as_xml comments
| lengthPS comments' > 0 = text ""
<> escapeXML (unpackPS comments')
<> text ""
| otherwise = empty
where comments' = unlinesPS comments
-- escapeXML is duplicated in Patch.lhs and Annotate.lhs
-- It should probably be refactored to exist in one place.
escapeXML :: String -> Doc
escapeXML = text . strReplace '\'' "'" . strReplace '"' """ .
strReplace '>' ">" . strReplace '<' "<" . strReplace '&' "&"
strReplace :: Char -> String -> String -> String
strReplace _ _ [] = []
strReplace x y (z:zs)
| x == z = y ++ (strReplace x y zs)
| otherwise = z : (strReplace x y zs)
\end{code}
\begin{code}
make_alt_filename :: PatchInfo -> String
make_alt_filename pi@(PatchInfo { is_inverted = False }) =
fix_up_fname (midtrunc (pi_name pi)++"-"++just_author pi++"-"++unpackPS (_pi_date pi))
make_alt_filename pi@(PatchInfo { is_inverted = True}) =
make_alt_filename (pi { is_inverted = False }) ++ "-inverted"
make_filename :: PatchInfo -> String
make_filename pi =
showIsoDateTime d++"-"++sha1_a++"-"++sha1PS sha1_me++".gz"
where b2ps True = packString "t"
b2ps False = packString "f"
sha1_me = concatPS [_pi_name pi,
_pi_author pi,
_pi_date pi,
concatPS $ _pi_log pi,
b2ps $ is_inverted pi]
d = readPatchDate $ _pi_date pi
sha1_a = take 5 $ sha1PS $ _pi_author pi
midtrunc :: String -> String
midtrunc s
| length s < 73 = s
| otherwise = (take 40 s)++"..."++(reverse $ take 30 $ reverse s)
fix_up_fname :: String -> String
fix_up_fname = map munge_char
munge_char :: Char -> Char
munge_char '*' = '+'
munge_char '?' = '2'
munge_char '>' = '7'
munge_char '<' = '2'
munge_char ' ' = '_'
munge_char '"' = '~'
munge_char '`' = '.'
munge_char '\'' = '.'
munge_char '/' = '1'
munge_char '\\' = '1'
munge_char '!' = '1'
munge_char ':' = '.'
munge_char ';' = ','
munge_char '{' = '~'
munge_char '}' = '~'
munge_char '(' = '~'
munge_char ')' = '~'
munge_char '[' = '~'
munge_char ']' = '~'
munge_char '=' = '+'
munge_char '#' = '+'
munge_char '%' = '8'
munge_char '&' = '6'
munge_char '@' = '9'
munge_char '|' = '1'
munge_char c = c
\end{code}
\begin{code}
instance HTML RepoPatchInfo where
toHtml = htmlPatchInfo
instance Show PatchInfo where
show pi = renderString (showPatchInfo pi)
\end{code}
\paragraph{Patch info}
Patch is stored between square brackets.
\begin{verbatim}
[
*
(indented one)
]
\end{verbatim}
\begin{code}
-- note that below I assume the name has no newline in it.
showPatchInfo :: PatchInfo -> Doc
showPatchInfo pi =
blueText "[" <> packedString (_pi_name pi)
$$ packedString (_pi_author pi) <> text inverted <> packedString (_pi_date pi)
<> myunlines (_pi_log pi) <> blueText "] "
where inverted = if is_inverted pi then "*-" else "**"
myunlines [] = empty
myunlines xs = mul xs
where mul [] = text "\n"
mul (s:ss) = text "\n " <> packedString s <> mul ss
readPatchInfo :: PackedString -> Maybe (PatchInfo, PackedString)
readPatchInfo s | nullPS (dropWhitePS s) = Nothing
readPatchInfo s =
if headPS (dropWhitePS s) /= '[' -- ]
then Nothing
else case breakOnPS '\n' $ tailPS $ dropWhitePS s of
(name,s') ->
case breakOnPS '*' $ tailPS s' of
(author,s2) ->
case breakPS (\c->c==']'||c=='\n') $ dropPS 2 s2 of
(ct,s''') ->
do (log, s4) <- lines_starting_with_ending_with ' ' ']' $ dn s'''
return $ (PatchInfo { _pi_date = ct
, _pi_name = name
, _pi_author = author
, _pi_log = log
, is_inverted = indexPS s2 1 /= '*'
}, s4)
where dn x = if nullPS x || headPS x /= '\n' then x else tailPS x
\end{code}
\begin{code}
lines_starting_with_ending_with :: Char -> Char -> PackedString
-> Maybe ([PackedString],PackedString)
lines_starting_with_ending_with st en s = lswew s
where
lswew x | nullPS x = Nothing
lswew x =
if headPS x == en
then Just ([], tailPS x)
else if headPS x /= st
then Nothing
else case breakOnPS '\n' $ tailPS x of
(l,r) -> case lswew $ tailPS r of
Just (ls,r') -> Just (l:ls,r')
Nothing ->
case breakLastPS en l of
Just (l2,_) ->
Just ([l2], dropPS (lengthPS l2+2) x)
Nothing -> Nothing
\end{code}
\begin{code}
htmlPatchInfo :: RepoPatchInfo -> Html
htmlPatchInfo (RPI r pi) =
toHtml $ (td << patch_link r pi) `above`
((td ! [align "right"] << mail_link (just_author pi)) `beside`
(td << (friendly_d $ _pi_date pi)))
patch_link :: String -> PatchInfo -> Html
patch_link r pi =
toHtml $ hotlink
("darcs?"++r++"**"++make_filename pi)
[toHtml $ pi_name pi]
mail_link :: String -> Html
mail_link email = toHtml $ hotlink ("mailto:"++email) [toHtml email]
\end{code}