{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ViewPatterns, UndecidableInstances #-}
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 Darcs.Patch.Apply ( Apply(..), ObjectIdOfPatch )
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.Tree ( Tree )


instance Show2 Prim
instance Show1 (Prim wX)
deriving instance Show (Prim wX wY)
deriving instance Show (FilePatchType wX wY)
deriving instance Show (DirPatchType wX wY)

instance (Apply Prim, ApplyState Prim ~ Tree, ObjectIdOfPatch Prim ~ AnchoredPath) =>
         PrimShow Prim where
  showPrim :: forall wA wB. 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
  showPrimWithContextAndApply :: forall (m :: * -> *) wA wB.
ApplyMonad (ApplyState Prim) m =>
FileNameFormat -> Prim wA wB -> m Doc
showPrimWithContextAndApply FileNameFormat
fmt p :: Prim wA wB
p@(FP AnchoredPath
f (Hunk Int
line [ByteString]
old [ByteString]
new)) = do
    Doc
r <- FileNameFormat -> FileHunk AnchoredPath Any Any -> m Doc
forall (state :: (* -> *) -> *) (m :: * -> *) oid wX wY.
(ApplyMonad state m, oid ~ ObjectIdOf state, ObjectId oid) =>
FileNameFormat -> FileHunk oid wX wY -> m Doc
showContextHunk FileNameFormat
fmt (AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> FileHunk AnchoredPath Any Any
forall oid wX wY.
oid -> Int -> [ByteString] -> [ByteString] -> FileHunk oid wX wY
FileHunk AnchoredPath
f Int
line [ByteString]
old [ByteString]
new)
    Prim wA wB -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState Prim) m =>
Prim wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply Prim wA wB
p
    Doc -> m Doc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
r
  showPrimWithContextAndApply FileNameFormat
fmt Prim wA wB
p = do
    Prim wA wB -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState Prim) m =>
Prim wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply Prim wA wB
p
    Doc -> m Doc
forall a. a -> m a
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 wA wB. 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 AnchoredPath Any Any -> Doc
forall oid wX wY.
ObjectId oid =>
FileNameFormat -> FileHunk oid wX wY -> Doc
showFileHunk FileNameFormat
fmt (AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> FileHunk AnchoredPath Any Any
forall oid wX wY.
oid -> Int -> [ByteString] -> [ByteString] -> FileHunk oid 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)