%  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; if not, write to the Free Software Foundation,
%  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
\begin{code}
module PatchInfo ( PatchInfo, patchinfo, invert_name, is_inverted,
                   make_filename, make_alt_filename, readPatchInfoPS,
                   just_name, repopatchinfo, RepoPatchInfo,
                   human_friendly, to_xml, pi_date, set_pi_date,
                 ) where
import Time
import Text.Html hiding (name)
import FastPackedString
import IsoDate ( cleanDate, readDate )
import System.Time ( CalendarTime, calendarTimeToString, toClockTime,
                     toCalendarTime )
import List (isPrefixOf)
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 !PackedString !PackedString
                           !PackedString ![PackedString] !Bool
                 deriving (Eq,Ord)

patchinfo :: String -> String -> String -> [String] -> PatchInfo
patchinfo date name author log =
    PatchInfo (packString date) (packString name) (packString author)
              (map packString log) False
\end{code}

\section{Patch info formatting}


\begin{code}
invert_name :: PatchInfo -> PatchInfo
invert_name (PatchInfo d n a l inv) = PatchInfo d n a l (not inv)

is_inverted :: PatchInfo -> Bool
is_inverted (PatchInfo _ _ _ _ inv) = inv
\end{code}

\begin{code}
just_name :: PatchInfo -> String
just_name (PatchInfo _ n _ _ _) = unpackPS n

human_friendly :: PatchInfo -> String
human_friendly (PatchInfo d n a l inv) =
    friendly_d d ++ "  " ++ unpackPS a ++ "\n" ++
    hfn (unpackPS n) ++ "\n" ++
    unlines (map (("  "++).unpackPS) l)
  where hfn x = if "TAG " `isPrefixOf` x then "  tagged "++drop 4 x
                                         else inverted++x
        inverted = if inv then "  UNDO: " else "  * "

pi_date :: PatchInfo -> CalendarTime
pi_date (PatchInfo d _ _ _ _) = readDate $ unpackPS d

set_pi_date :: String -> PatchInfo -> PatchInfo
set_pi_date date (PatchInfo _ a b c d)
    = PatchInfo (packString date) a b c d

friendly_d :: PackedString -> String
--friendly_d d = calendarTimeToString . readDate . unpackPS . d
friendly_d d = unsafePerformIO $ do
    ct <- toCalendarTime $ toClockTime $ readDate $ unpackPS d
    return $ calendarTimeToString ct
\end{code}

\begin{code}
to_xml :: PatchInfo -> String
to_xml pi@(PatchInfo date patch_name author comments inverted) =
  "<patch"++
  " author='" ++ escapeXML (unpackPS author) ++
  "' date='" ++ escapeXML (unpackPS date) ++
  "' local_date='" ++ escapeXML (friendly_d date) ++
  "' inverted='" ++ (show inverted) ++
  "' hash='" ++ make_filename pi ++
  "'>\n\t<name>" ++
  escapeXML (unpackPS patch_name) ++ "</name>" ++
  comments_as_xml comments ++
  "\n</patch>"

comments_as_xml :: [PackedString] -> String
comments_as_xml comments
  | lengthPS comments' > 0 = "\n\t<comment>" ++
    escapeXML (unpackPS comments') ++ "</comment>"
  | otherwise = ""
    where comments' = unlinesPS comments

escapeXML :: String -> String
escapeXML = strReplace '\'' "&apos;" . strReplace '"' "&quot;" .
  strReplace '<' "&lt;" . strReplace '&' "&amp;"

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 (PatchInfo d n a _ False) =
    fix_up_fname (midtrunc (unpackPS n)++"-"++unpackPS a++"-"++unpackPS d)
make_alt_filename (PatchInfo d n a l True) =
    make_alt_filename (PatchInfo d n a l False) ++ "-inverted"

make_filename :: PatchInfo -> String
make_filename (PatchInfo dps nps aps lps inv) =
    cleanDate d++"-"++sha1_a++"-"++sha1PS sha1_me++".gz"
        where b2ps True = packString "t"
              b2ps False = packString "f"
              sha1_me = concatPS [nps, aps, dps, concatPS lps, b2ps inv]
              d = unpackPS dps
              sha1_a = take 5 $ sha1PS aps

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 = showPatchInfo
\end{code}

\paragraph{Patch info}
Patch is stored between square brackets.
\begin{verbatim}
[ <patch name>
<patch author>*<patch date>
 <patch log (may be empty)> (indented one)
 <can have multiple lines in patch log,>
 <as long as they're preceded by a space>
 <and don't end with a square bracket.>
]
\end{verbatim}
\begin{code}
-- note that below I assume the name has no newline in it.
showPatchInfo :: PatchInfo -> String
showPatchInfo (PatchInfo ct name author log inv) =
  "[" ++ unpackPS name ++"\n"++
  unpackPS author ++ inverted ++ unpackPS ct ++
  myunlines log ++
  "] "
    where inverted = if inv then "*-" else "**"
          myunlines [] = ""
          myunlines xs = mul xs
              where mul [] = "\n"
                    mul (s:ss) = "\n "++unpackPS s++mul ss

readPatchInfoPS :: PackedString -> Maybe (PatchInfo,PackedString)
readPatchInfoPS s | nullPS (dropWhitePS s) = Nothing
readPatchInfoPS 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''') ->
                     case lines_starting_with_ending_withPS ' ' ']' $ dnPS s''' of
                     Just (log, s4) ->
                         if indexPS s2 1 == '*'
                         then Just (PatchInfo ct name author log False, s4)
                         else Just (PatchInfo ct name author log True, s4)
                     Nothing -> error $ "Error parsing patchinfo:\n"++
                                        unlines (map show $ lines $ unpackPS $ takePS 480 s)
    where dnPS x = if nullPS x || headPS x /= '\n' then x else tailPS x
\end{code}

\begin{code}
lines_starting_with_ending_withPS :: Char -> Char -> PackedString
                                  -> Maybe ([PackedString],PackedString)
lines_starting_with_ending_withPS 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@(PatchInfo ct _ author _ _)) =
    toHtml $ (td << patch_link r pi) `above`
               ((td ! [align "right"] << mail_link (unpackPS author)) `beside`
                (td << (friendly_d ct)))

patch_link :: String -> PatchInfo -> Html
patch_link r pi@(PatchInfo _ name _ _ _) =
    toHtml $ hotlink
               ("darcs?"++r++"**"++make_filename pi)
               [toHtml $ unpackPS name]
mail_link :: String -> Html
mail_link email = toHtml $ hotlink ("mailto:"++email) [toHtml email]
\end{code}