    -- 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.

    module Darcs.Patch.Info ( PatchInfo, patchinfo, invert_name, is_inverted,
                              idpatchinfo, add_junk,
                              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, is_tag
                            ) where
    import Text.Html hiding (name, text)
    import System.Random ( randomRIO )
    import Numeric ( showHex )
    import Control.Monad ( when )

    import ByteStringUtils
    import qualified Data.ByteString       as B  (length, splitAt, null, drop
                                                 ,isPrefixOf, tail, concat, ByteString )
    import qualified Data.ByteString.Char8 as BC (index, head, unpack, pack, break)
    import Data.List( isPrefixOf )

    import Printer ( renderString, Doc, packedString,
                     empty, ($$), (<>), (<+>), vcat, text, blueText, prefix )
    import Darcs.Patch.OldDate ( readUTCDate, showIsoDateTime )
    import System.Time ( CalendarTime(ctTZ), calendarTimeToString, toClockTime,
                         toCalendarTime )
    import System.IO.Unsafe ( unsafePerformIO )
    import SHA1 ( sha1PS )
    import Darcs.Utils ( promptYorn )
    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    :: !B.ByteString
                               , _pi_name    :: !B.ByteString
                               , _pi_author  :: !B.ByteString
                               , _pi_log     :: ![B.ByteString]
                               , is_inverted :: !Bool
                               }
                     deriving (Eq,Ord)

    idpatchinfo :: PatchInfo
    idpatchinfo = PatchInfo myid myid myid [] False
        where myid = BC.pack "identity"

    patchinfo :: String -> String -> String -> [String] -> IO PatchInfo
    patchinfo date name author log =
        add_junk $ PatchInfo { _pi_date     = BC.pack date
                             , _pi_name     = BC.pack name
                             , _pi_author   = BC.pack author
                             , _pi_log      = map BC.pack log
                             , is_inverted  = False }

    add_junk :: PatchInfo -> IO PatchInfo
    add_junk pinf =
        do x <- randomRIO (0,2^(128 ::Integer) :: Integer)
           when (_pi_log pinf /= ignore_junk (_pi_log pinf)) $
                do putStrLn "Lines beginning with 'Ignore-this: ' will be ignored."
                   yorn <- promptYorn "Proceed? "
                   when (yorn == 'n') $ fail "User cancelled because of Ignore-this."
           return $ pinf { _pi_log = BC.pack (head ignored++showHex x ""):
                                     _pi_log pinf }

    ignored :: [String] -- this is a [String] so we can change the junk header.
    ignored = ["Ignore-this: "]

    ignore_junk :: [B.ByteString] -> [B.ByteString]
    ignore_junk = filter isnt_ignored
        where isnt_ignored x = doesnt_start_with x (map BC.pack ignored) -- TODO
              doesnt_start_with x ys = not $ any (`B.isPrefixOf` x) ys

    -- * Patch info formatting
    invert_name :: PatchInfo -> PatchInfo
    invert_name pi = pi { is_inverted = not (is_inverted pi) }

    just_name :: PatchInfo -> String
    just_name pinf = if is_inverted pinf then "UNDO: " ++ BC.unpack (_pi_name pinf)
                                         else BC.unpack (_pi_name pinf)

    just_author :: PatchInfo -> String
    just_author = BC.unpack . _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) (ignore_junk $ _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 = BC.unpack . _pi_name

    pi_rename :: PatchInfo -> String -> PatchInfo
    pi_rename x n = x { _pi_name = BC.pack n }

    pi_author :: PatchInfo -> String
    pi_author = BC.unpack . _pi_author

    is_tag :: PatchInfo -> Bool
    is_tag pinfo = "TAG " `isPrefixOf` just_name pinfo

    -- | 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 :: B.ByteString -> CalendarTime
    readPatchDate = ignoreTz . readUTCDate . BC.unpack
      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 = BC.pack date }

    pi_log :: PatchInfo -> [String]
    pi_log = map BC.unpack . ignore_junk . _pi_log

    pi_tag :: PatchInfo -> Maybe String
    pi_tag pinf =
        if l == t
          then Just $ BC.unpack r
          else Nothing
        where (l, r) = B.splitAt (B.length t) (_pi_name pinf)
              t = BC.pack "TAG "

    friendly_d :: B.ByteString -> String
    --friendly_d d = calendarTimeToString . readPatchDate . d
    friendly_d d = unsafePerformIO $ do
        ct <- toCalendarTime $ toClockTime $ readPatchDate d
        return $ calendarTimeToString ct

    to_xml :: PatchInfo -> Doc
    to_xml pi =
            text "<patch"
        <+> text "author='" <> escapeXML (just_author pi) <> text "'"
        <+> text "date='" <> escapeXML (BC.unpack $ _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 "<name>" <> escapeXML (pi_name pi) <> text "</name>"
             $$ comments_as_xml (_pi_log pi))
     $$     text "</patch>"

    comments_as_xml :: [B.ByteString] -> Doc
    comments_as_xml comments
      | B.length comments' > 0 = text "<comment>"
                              <> escapeXML (BC.unpack comments')
                              <> text "</comment>"
      | 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 '\'' "&apos;" . strReplace '"' "&quot;" .
      strReplace '>' "&gt;" . 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)

    make_alt_filename :: PatchInfo -> String
    make_alt_filename pi@(PatchInfo { is_inverted = False }) =
        fix_up_fname (midtrunc (pi_name pi)++"-"++just_author pi++"-"++BC.unpack (_pi_date pi))
    make_alt_filename pi@(PatchInfo { is_inverted = True}) =
        make_alt_filename (pi { is_inverted = False }) ++ "-inverted"

    -- This makes darcs-1 (non-hashed repos) filenames, and is also generally used in both in
    -- hashed and non-hashed repo code for making patch "hashes"
    make_filename :: PatchInfo -> String
    make_filename pi =
        showIsoDateTime d++"-"++sha1_a++"-"++sha1PS sha1_me++".gz"
            where b2ps True = BC.pack "t"
                  b2ps False = BC.pack "f"
                  sha1_me = B.concat [_pi_name pi,
                                      _pi_author pi,
                                      _pi_date pi,
                                      B.concat $ _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

    instance  HTML RepoPatchInfo  where
        toHtml = htmlPatchInfo
    instance  Show PatchInfo  where
        show pi = renderString (showPatchInfo pi)

    -- |Patch is stored between square brackets.
    --
    -- > [ <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.>
    -- > ]
    --
    -- 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

    --
    -- Note, Data.ByteString rewrites break ((==) x) into the memchr-based
    -- breakByte. For this rule to fire, we keep it in prefix application form
    --

    readPatchInfo :: B.ByteString -> Maybe (PatchInfo, B.ByteString)
    readPatchInfo s | B.null (dropSpace s) = Nothing
    readPatchInfo s =
        if BC.head (dropSpace s) /= '[' -- ]
        then Nothing
        else case BC.break ((==) '\n') $ B.tail $ dropSpace s of
             (name,s') ->
                 case BC.break ((==) '*') $ B.tail s' of
                 (author,s2) ->
                     case BC.break (\c->c==']'||c=='\n') $ B.drop 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 = BC.index s2 1 /= '*'
                                                }, s4)
        where dn x = if B.null x || BC.head x /= '\n' then x else B.tail x

    lines_starting_with_ending_with :: Char -> Char -> B.ByteString
                                    -> Maybe ([B.ByteString],B.ByteString)
    lines_starting_with_ending_with st en s = lswew s
        where
      lswew x | B.null x = Nothing
      lswew x =
        if BC.head x == en
        then Just ([], B.tail x)
        else if BC.head x /= st
             then Nothing
             else case BC.break ((==) '\n') $ B.tail x of
                  (l,r) -> case lswew $ B.tail r of
                           Just (ls,r') -> Just (l:ls,r')
                           Nothing ->
                               case breakLastPS en l of
                               Just (l2,_) ->
                                   Just ([l2], B.drop (B.length l2+2) x)
                               Nothing -> Nothing

    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]