{-# 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 ()
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)