{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ViewPatterns #-}
module Darcs.Patch.Prim.V1.Show
    ( showHunk )
    where

import Darcs.Prelude

import Darcs.Util.ByteString ( fromPS2Hex )
import qualified Data.ByteString as B (ByteString, length, take, drop)
import qualified Data.ByteString.Char8 as BC (head)

import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.FileHunk ( FileHunk(..), showFileHunk )
import Darcs.Patch.Format ( FileNameFormat )
import Darcs.Patch.Show ( formatFileName )
import Darcs.Patch.Permutations () -- for Invert instance of FL
import Darcs.Patch.Prim.Class ( PrimShow(..) )
import Darcs.Patch.Prim.V1.Core
     ( Prim(..), FilePatchType(..), DirPatchType(..) )
import Darcs.Patch.Prim.V1.Details ()
import Darcs.Patch.Viewing ( showContextHunk )
import Darcs.Patch.Witnesses.Show ( Show1, Show2 )

import Darcs.Util.Path ( AnchoredPath )
import Darcs.Util.Printer ( Doc, vcat,
                 text, userchunk, invisibleText, invisiblePS, blueText,
                 ($$), (<+>)
               )
import Darcs.Util.Show ( appPrec, BSWrapper(..) )
import Darcs.Util.Tree ( Tree )


deriving instance Show (Prim wX wY)

instance Show2 Prim

instance Show1 (Prim wX)

instance Show (FilePatchType wX wY) where
    showsPrec :: Int -> FilePatchType wX wY -> ShowS
showsPrec Int
_ FilePatchType wX wY
RmFile = String -> ShowS
showString String
"RmFile"
    showsPrec Int
_ FilePatchType wX wY
AddFile = String -> ShowS
showString String
"AddFile"
    showsPrec Int
d (Hunk Int
line [ByteString]
old [ByteString]
new) | (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1) (Int -> Bool) -> (ByteString -> Int) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length) [ByteString]
old Bool -> Bool -> Bool
&& (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1) (Int -> Bool) -> (ByteString -> Int) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length) [ByteString]
new
        = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Hunk " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
line ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      [ByteString] -> ShowS
showsPrecC [ByteString]
old ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      [ByteString] -> ShowS
showsPrecC [ByteString]
new
       where showsPrecC :: [ByteString] -> ShowS
showsPrecC [] = String -> ShowS
showString String
"[]"
             showsPrecC [ByteString]
ss = Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"packStringLetters " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((ByteString -> Char) -> [ByteString] -> String
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Char
BC.head [ByteString]
ss)
    showsPrec Int
d (Hunk Int
line [ByteString]
old [ByteString]
new) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Hunk " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
line ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      Int -> [BSWrapper] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((ByteString -> BSWrapper) -> [ByteString] -> [BSWrapper]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> BSWrapper
BSWrapper [ByteString]
old) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      Int -> [BSWrapper] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((ByteString -> BSWrapper) -> [ByteString] -> [BSWrapper]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> BSWrapper
BSWrapper [ByteString]
new)
    showsPrec Int
d (TokReplace String
t String
old String
new) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"TokReplace " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                         Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                         Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
old ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                         Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
new
    -- this case may not work usefully
    showsPrec Int
d (Binary ByteString
old ByteString
new) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Binary " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   Int -> BSWrapper -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ByteString -> BSWrapper
BSWrapper ByteString
old) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   Int -> BSWrapper -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ByteString -> BSWrapper
BSWrapper ByteString
new)

deriving instance Show (DirPatchType wX wY)

instance ApplyState Prim ~ Tree => PrimShow Prim where
  showPrim :: FileNameFormat -> Prim wA wB -> Doc
showPrim FileNameFormat
fmt (FP AnchoredPath
f FilePatchType wA wB
AddFile) = FileNameFormat -> AnchoredPath -> Doc
showAddFile FileNameFormat
fmt AnchoredPath
f
  showPrim FileNameFormat
fmt (FP AnchoredPath
f FilePatchType wA wB
RmFile)  = FileNameFormat -> AnchoredPath -> Doc
showRmFile FileNameFormat
fmt AnchoredPath
f
  showPrim FileNameFormat
fmt (FP AnchoredPath
f (Hunk Int
line [ByteString]
old [ByteString]
new))  = FileNameFormat
-> AnchoredPath -> Int -> [ByteString] -> [ByteString] -> Doc
showHunk FileNameFormat
fmt AnchoredPath
f Int
line [ByteString]
old [ByteString]
new
  showPrim FileNameFormat
fmt (FP AnchoredPath
f (TokReplace String
t String
old String
new))  = FileNameFormat -> AnchoredPath -> String -> String -> String -> Doc
showTok FileNameFormat
fmt AnchoredPath
f String
t String
old String
new
  showPrim FileNameFormat
fmt (FP AnchoredPath
f (Binary ByteString
old ByteString
new))  = FileNameFormat -> AnchoredPath -> ByteString -> ByteString -> Doc
showBinary FileNameFormat
fmt AnchoredPath
f ByteString
old ByteString
new
  showPrim FileNameFormat
fmt (DP AnchoredPath
d DirPatchType wA wB
AddDir) = FileNameFormat -> AnchoredPath -> Doc
showAddDir FileNameFormat
fmt AnchoredPath
d
  showPrim FileNameFormat
fmt (DP AnchoredPath
d DirPatchType wA wB
RmDir)  = FileNameFormat -> AnchoredPath -> Doc
showRmDir FileNameFormat
fmt AnchoredPath
d
  showPrim FileNameFormat
fmt (Move AnchoredPath
f AnchoredPath
f') = FileNameFormat -> AnchoredPath -> AnchoredPath -> Doc
showMove FileNameFormat
fmt AnchoredPath
f AnchoredPath
f'
  showPrim FileNameFormat
_ (ChangePref String
p String
f String
t) = String -> String -> String -> Doc
showChangePref String
p String
f String
t
  showPrimCtx :: FileNameFormat -> Prim wA wB -> m Doc
showPrimCtx FileNameFormat
fmt (FP AnchoredPath
f (Hunk Int
line [ByteString]
old [ByteString]
new)) = FileNameFormat -> FileHunk Any Any -> m Doc
forall (m :: * -> *) wX wY.
ApplyMonad Tree m =>
FileNameFormat -> FileHunk wX wY -> m Doc
showContextHunk FileNameFormat
fmt (AnchoredPath
-> Int -> [ByteString] -> [ByteString] -> FileHunk Any Any
forall wX wY.
AnchoredPath
-> Int -> [ByteString] -> [ByteString] -> FileHunk wX wY
FileHunk AnchoredPath
f Int
line [ByteString]
old [ByteString]
new)
  showPrimCtx FileNameFormat
fmt Prim wA wB
p = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Prim wA wB -> Doc
forall (prim :: * -> * -> *) wA wB.
PrimShow prim =>
FileNameFormat -> prim wA wB -> Doc
showPrim FileNameFormat
fmt Prim wA wB
p

showAddFile :: FileNameFormat -> AnchoredPath -> Doc
showAddFile :: FileNameFormat -> AnchoredPath -> Doc
showAddFile FileNameFormat
fmt AnchoredPath
f = String -> Doc
blueText String
"addfile" Doc -> Doc -> Doc
<+> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
fmt AnchoredPath
f

showRmFile :: FileNameFormat -> AnchoredPath -> Doc
showRmFile :: FileNameFormat -> AnchoredPath -> Doc
showRmFile FileNameFormat
fmt AnchoredPath
f = String -> Doc
blueText String
"rmfile" Doc -> Doc -> Doc
<+> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
fmt AnchoredPath
f

showMove :: FileNameFormat -> AnchoredPath -> AnchoredPath -> Doc
showMove :: FileNameFormat -> AnchoredPath -> AnchoredPath -> Doc
showMove FileNameFormat
fmt AnchoredPath
d AnchoredPath
d' = String -> Doc
blueText String
"move" Doc -> Doc -> Doc
<+> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
fmt AnchoredPath
d Doc -> Doc -> Doc
<+> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
fmt AnchoredPath
d'

showChangePref :: String -> String -> String -> Doc
showChangePref :: String -> String -> String -> Doc
showChangePref String
p String
f String
t = String -> Doc
blueText String
"changepref" Doc -> Doc -> Doc
<+> String -> Doc
text String
p
                    Doc -> Doc -> Doc
$$ String -> Doc
userchunk String
f
                    Doc -> Doc -> Doc
$$ String -> Doc
userchunk String
t

showAddDir :: FileNameFormat -> AnchoredPath -> Doc
showAddDir :: FileNameFormat -> AnchoredPath -> Doc
showAddDir FileNameFormat
fmt AnchoredPath
d = String -> Doc
blueText String
"adddir" Doc -> Doc -> Doc
<+> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
fmt AnchoredPath
d

showRmDir :: FileNameFormat -> AnchoredPath -> Doc
showRmDir :: FileNameFormat -> AnchoredPath -> Doc
showRmDir FileNameFormat
fmt AnchoredPath
d = String -> Doc
blueText String
"rmdir" Doc -> Doc -> Doc
<+> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
fmt AnchoredPath
d

showHunk :: FileNameFormat -> AnchoredPath -> Int -> [B.ByteString] -> [B.ByteString] -> Doc
showHunk :: FileNameFormat
-> AnchoredPath -> Int -> [ByteString] -> [ByteString] -> Doc
showHunk FileNameFormat
fmt AnchoredPath
f Int
line [ByteString]
old [ByteString]
new = FileNameFormat -> FileHunk Any Any -> Doc
forall wX wY. FileNameFormat -> FileHunk wX wY -> Doc
showFileHunk FileNameFormat
fmt (AnchoredPath
-> Int -> [ByteString] -> [ByteString] -> FileHunk Any Any
forall wX wY.
AnchoredPath
-> Int -> [ByteString] -> [ByteString] -> FileHunk wX wY
FileHunk AnchoredPath
f Int
line [ByteString]
old [ByteString]
new)

showTok :: FileNameFormat -> AnchoredPath -> String -> String -> String -> Doc
showTok :: FileNameFormat -> AnchoredPath -> String -> String -> String -> Doc
showTok FileNameFormat
fmt AnchoredPath
f String
t String
o String
n = String -> Doc
blueText String
"replace" Doc -> Doc -> Doc
<+> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
fmt AnchoredPath
f
                                     Doc -> Doc -> Doc
<+> String -> Doc
text String
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
userchunk String
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"
                                     Doc -> Doc -> Doc
<+> String -> Doc
userchunk String
o
                                     Doc -> Doc -> Doc
<+> String -> Doc
userchunk String
n

showBinary :: FileNameFormat -> AnchoredPath -> B.ByteString -> B.ByteString -> Doc
showBinary :: FileNameFormat -> AnchoredPath -> ByteString -> ByteString -> Doc
showBinary FileNameFormat
fmt AnchoredPath
f ByteString
o ByteString
n =
    String -> Doc
blueText String
"binary" Doc -> Doc -> Doc
<+> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
fmt AnchoredPath
f
 Doc -> Doc -> Doc
$$ String -> Doc
invisibleText String
"oldhex"
 Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((ByteString -> Doc) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Doc
makeprintable ([ByteString] -> [Doc]) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
breakEvery Int
78 (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromPS2Hex ByteString
o)
 Doc -> Doc -> Doc
$$ String -> Doc
invisibleText String
"newhex"
 Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((ByteString -> Doc) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Doc
makeprintable ([ByteString] -> [Doc]) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
breakEvery Int
78 (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromPS2Hex ByteString
n)
     where makeprintable :: ByteString -> Doc
makeprintable ByteString
ps = String -> Doc
invisibleText String
"*" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ByteString -> Doc
invisiblePS ByteString
ps

breakEvery :: Int -> B.ByteString -> [B.ByteString]
breakEvery :: Int -> ByteString -> [ByteString]
breakEvery Int
n ByteString
ps | ByteString -> Int
B.length ByteString
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = [ByteString
ps]
                 | Bool
otherwise = Int -> ByteString -> ByteString
B.take Int
n ByteString
ps ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> ByteString -> [ByteString]
breakEvery Int
n (Int -> ByteString -> ByteString
B.drop Int
n ByteString
ps)