--  Copyright (C) 2002-2005 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.Show
     ( ShowPatchBasic(..)
     , displayPatch
     , ShowPatchFor(..)
     , ShowPatch(..)
     , ShowContextPatch(..)
     , formatFileName
     ) where

import Darcs.Prelude

import qualified Data.ByteString.Char8 as BC ( unpack )

import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.ApplyMonad ( ApplyMonad )
import Darcs.Patch.Format ( FileNameFormat(..) )
import Darcs.Patch.Witnesses.Ordered ( FL, mapFL )

import Darcs.Util.ByteString ( packStringToUTF8, encodeLocale )
import Darcs.Util.English ( plural, Noun(Noun) )
import Darcs.Util.Path ( AnchoredPath, encodeWhite, anchorPath )
import Darcs.Util.Printer ( Doc, vcat, text, packedString )

data ShowPatchFor = ForDisplay | ForStorage

displayPatch :: ShowPatchBasic p => p wX wY -> Doc
displayPatch :: p wX wY -> Doc
displayPatch p wX wY
p = ShowPatchFor -> p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForDisplay p wX wY
p

class ShowPatchBasic p where
    showPatch :: ShowPatchFor -> p wX wY -> Doc

class ShowPatchBasic p => ShowContextPatch p where
    -- | showContextPatch is used to add context to a patch, as diff
    -- -u does. Thus, it differs from showPatch only for hunks. It is
    -- used for instance before putting it into a bundle. As this
    -- unified context is not included in patch representation, this
    -- requires access to the tree.
    showContextPatch :: (ApplyMonad (ApplyState p) m)
                     => ShowPatchFor -> p wX wY -> m Doc

-- | This class is used only for user interaction, not for storage. The default
-- implementations for 'description' and 'content' are suitable only for
-- 'PrimPatch' and 'RepoPatch' types. Logically, 'description' should default
-- to 'mempty' while 'content' should default to 'displayPatch'. We define them
-- the other way around so that 'Darcs.UI.PrintPatch.showFriendly' gives
-- reasonable results for all patch types.
class ShowPatchBasic p => ShowPatch p where
    content :: p wX wY -> Doc
    content = p wX wY -> Doc
forall a. Monoid a => a
mempty

    description :: p wX wY -> Doc
    description = p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch

    summary :: p wX wY -> Doc

    summaryFL :: FL p wX wY -> Doc
    summaryFL = [Doc] -> Doc
vcat ([Doc] -> Doc) -> (FL p wX wY -> [Doc]) -> FL p wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. p wW wZ -> Doc) -> FL p wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. p wW wZ -> Doc
forall (p :: * -> * -> *) wW wZ. ShowPatch p => p wW wZ -> Doc
summary

    thing :: p wX wY -> String
    thing p wX wY
_ = String
"patch"

    things :: p wX wY -> String
    things p wX wY
x = Noun -> ShowS
forall a. Countable a => a -> ShowS
plural (String -> Noun
Noun (String -> Noun) -> String -> Noun
forall a b. (a -> b) -> a -> b
$ p wX wY -> String
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> String
thing p wX wY
x) String
""

-- | Format a 'AnchoredPath' to a 'Doc' according to the given 'FileNameFormat'.
--
-- NOTE: This is not only used for display but also to format patch files. This is
--       why we have to do the white space encoding here.
--       See 'Darcs.Repository.Hashed.writePatchIfNecessary'.
--
-- Besides white space encoding, for 'FileNameFormatV2' we just pack it into a 'Doc'. For
-- 'FileNameFormatV1' we must emulate the non-standard darcs-1 encoding of file paths: it
-- is an UTF8 encoding of the raw byte stream, interpreted as code points.
--
-- See also 'Darcs.Patch.Show.readFileName'.
formatFileName :: FileNameFormat -> AnchoredPath -> Doc
formatFileName :: FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
FileNameFormatV1 = ByteString -> Doc
packedString (ByteString -> Doc)
-> (AnchoredPath -> ByteString) -> AnchoredPath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
packStringToUTF8 (String -> ByteString)
-> (AnchoredPath -> String) -> AnchoredPath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BC.unpack (ByteString -> String)
-> (AnchoredPath -> ByteString) -> AnchoredPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            String -> ByteString
encodeLocale (String -> ByteString)
-> (AnchoredPath -> String) -> AnchoredPath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
encodeWhite ShowS -> (AnchoredPath -> String) -> AnchoredPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredPath -> String
ap2fp
formatFileName FileNameFormat
FileNameFormatV2 = String -> Doc
text (String -> Doc) -> (AnchoredPath -> String) -> AnchoredPath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
encodeWhite ShowS -> (AnchoredPath -> String) -> AnchoredPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredPath -> String
ap2fp
formatFileName FileNameFormat
FileNameFormatDisplay = String -> Doc
text (String -> Doc) -> (AnchoredPath -> String) -> AnchoredPath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredPath -> String
ap2fp

ap2fp :: AnchoredPath -> FilePath
ap2fp :: AnchoredPath -> String
ap2fp AnchoredPath
ap = Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: String -> AnchoredPath -> String
anchorPath String
"" AnchoredPath
ap