{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
module Darcs.Patch.Prim.FileUUID.Show
    ( displayHunk )
    where

import Darcs.Prelude

import qualified Data.ByteString as B

import Darcs.Patch.Format ( PatchListFormat, FileNameFormat(..) )
import Darcs.Patch.Show
    ( ShowPatchBasic(..), ShowPatch(..)
    , ShowContextPatch(..), ShowPatchFor(..) )
import Darcs.Patch.Summary ( plainSummaryPrim )
import Darcs.Patch.Prim.Class ( PrimShow(..) )
import Darcs.Patch.Prim.FileUUID.Core
    ( Prim(..), Hunk(..), HunkMove(..), UUID(..), Location(..), FileContent )
import Darcs.Patch.Prim.FileUUID.Details ()
import Darcs.Util.ByteString ( linesPS )
import Darcs.Util.Path ( Name, encodeWhiteName )
import Darcs.Util.Printer
    ( text, packedString, blueText, prefix
    , (<+>), ($$), Doc, vcat
    )

-- TODO this instance shouldn't really be necessary, as Prims aren't used generically
instance PatchListFormat Prim

fileNameFormat :: ShowPatchFor -> FileNameFormat
fileNameFormat :: ShowPatchFor -> FileNameFormat
fileNameFormat ShowPatchFor
ForDisplay = FileNameFormat
FileNameFormatDisplay
fileNameFormat ShowPatchFor
ForStorage = FileNameFormat
FileNameFormatV2

instance ShowPatchBasic Prim where
  showPatch :: ShowPatchFor -> Prim wX wY -> Doc
showPatch ShowPatchFor
fmt = FileNameFormat -> Prim wX wY -> Doc
forall (prim :: * -> * -> *) wA wB.
PrimShow prim =>
FileNameFormat -> prim wA wB -> Doc
showPrim (ShowPatchFor -> FileNameFormat
fileNameFormat ShowPatchFor
fmt)

-- dummy instance, does not actually show any context
instance ShowContextPatch Prim where
  -- showContextPatch f = showPrimCtx (fileNameFormat f)
  showContextPatch :: ShowPatchFor -> Prim wX wY -> m Doc
showContextPatch ShowPatchFor
f Prim wX wY
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
$ ShowPatchFor -> Prim wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f Prim wX wY
p

instance ShowPatch Prim where
  summary :: Prim wX wY -> Doc
summary = Prim wX wY -> Doc
forall (prim :: * -> * -> *) wX wY.
PrimDetails prim =>
prim wX wY -> Doc
plainSummaryPrim
  -- summaryFL = plainSummaryPrims False
  thing :: Prim wX wY -> String
thing Prim wX wY
_ = String
"change"

instance PrimShow Prim where
  showPrim :: FileNameFormat -> Prim wA wB -> Doc
showPrim FileNameFormat
FileNameFormatDisplay (Hunk UUID
u Hunk wA wB
h) = Maybe UUID -> Hunk wA wB -> Doc
forall wX wY. Maybe UUID -> Hunk wX wY -> Doc
displayHunk (UUID -> Maybe UUID
forall a. a -> Maybe a
Just UUID
u) Hunk wA wB
h
  showPrim FileNameFormat
_ (Hunk UUID
u Hunk wA wB
h) = UUID -> Hunk wA wB -> Doc
forall wX wY. UUID -> Hunk wX wY -> Doc
storeHunk UUID
u Hunk wA wB
h
  showPrim FileNameFormat
FileNameFormatDisplay (HunkMove HunkMove wA wB
hm) = HunkMove wA wB -> Doc
forall wX wY. HunkMove wX wY -> Doc
displayHunkMove HunkMove wA wB
hm
  showPrim FileNameFormat
_ (HunkMove HunkMove wA wB
hm) = HunkMove wA wB -> Doc
forall wX wY. HunkMove wX wY -> Doc
storeHunkMove HunkMove wA wB
hm
  showPrim FileNameFormat
_ (Manifest UUID
f (L UUID
d Name
p)) = String -> UUID -> UUID -> Name -> Doc
showManifest String
"manifest" UUID
d UUID
f Name
p
  showPrim FileNameFormat
_ (Demanifest UUID
f (L UUID
d Name
p)) = String -> UUID -> UUID -> Name -> Doc
showManifest String
"demanifest" UUID
d UUID
f Name
p
  showPrim FileNameFormat
_ Prim wA wB
Identity = String -> Doc
blueText String
"identity"
  showPrimCtx :: FileNameFormat -> Prim wA wB -> m Doc
showPrimCtx FileNameFormat
_ Prim wA wB
_ = String -> m Doc
forall a. HasCallStack => String -> a
error String
"show with context not implemented"

showManifest :: String -> UUID -> UUID -> Name -> Doc
showManifest :: String -> UUID -> UUID -> Name -> Doc
showManifest String
txt UUID
dir UUID
file Name
name =
  String -> Doc
blueText String
txt Doc -> Doc -> Doc
<+>
  UUID -> Doc
formatUUID UUID
file Doc -> Doc -> Doc
<+>
  UUID -> Doc
formatUUID UUID
dir Doc -> Doc -> Doc
<+>
  ByteString -> Doc
packedString (Name -> ByteString
encodeWhiteName Name
name)

displayHunk :: Maybe UUID -> Hunk wX wY -> Doc
displayHunk :: Maybe UUID -> Hunk wX wY -> Doc
displayHunk Maybe UUID
uid (H Int
off ByteString
old ByteString
new) =
  String -> Doc
blueText String
"hunk" Doc -> Doc -> Doc
<+>
  Doc -> (UUID -> Doc) -> Maybe UUID -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Doc
text String
"<nil>") UUID -> Doc
formatUUID Maybe UUID
uid Doc -> Doc -> Doc
<+>
  String -> Doc
text (Int -> String
forall a. Show a => a -> String
show Int
off) Doc -> Doc -> Doc
$$
  String -> ByteString -> Doc
displayFileContent String
"-" ByteString
old Doc -> Doc -> Doc
$$
  String -> ByteString -> Doc
displayFileContent String
"+" ByteString
new

storeHunk :: UUID -> Hunk wX wY -> Doc
storeHunk :: UUID -> Hunk wX wY -> Doc
storeHunk UUID
uid (H Int
off ByteString
old ByteString
new) =
  String -> Doc
text String
"hunk" Doc -> Doc -> Doc
<+>
  UUID -> Doc
formatUUID UUID
uid Doc -> Doc -> Doc
<+>
  String -> Doc
text (Int -> String
forall a. Show a => a -> String
show Int
off) Doc -> Doc -> Doc
$$
  ByteString -> Doc
storeFileContent ByteString
old Doc -> Doc -> Doc
$$
  ByteString -> Doc
storeFileContent ByteString
new

displayHunkMove :: HunkMove wX wY -> Doc
displayHunkMove :: HunkMove wX wY -> Doc
displayHunkMove (HM UUID
sid Int
soff UUID
tid Int
toff ByteString
c) =
  String -> Doc
blueText String
"hunkmove" Doc -> Doc -> Doc
<+>
  UUID -> Doc
formatUUID UUID
sid Doc -> Doc -> Doc
<+>
  String -> Doc
text (Int -> String
forall a. Show a => a -> String
show Int
soff) Doc -> Doc -> Doc
<+>
  UUID -> Doc
formatUUID UUID
tid Doc -> Doc -> Doc
<+>
  String -> Doc
text (Int -> String
forall a. Show a => a -> String
show Int
toff) Doc -> Doc -> Doc
$$
  String -> ByteString -> Doc
displayFileContent String
"|" ByteString
c

storeHunkMove :: HunkMove wX wY -> Doc
storeHunkMove :: HunkMove wX wY -> Doc
storeHunkMove (HM UUID
sid Int
soff UUID
tid Int
toff ByteString
c) =
  String -> Doc
text String
"hunkmove" Doc -> Doc -> Doc
<+>
  UUID -> Doc
formatUUID UUID
sid Doc -> Doc -> Doc
<+>
  String -> Doc
text (Int -> String
forall a. Show a => a -> String
show Int
soff) Doc -> Doc -> Doc
<+>
  UUID -> Doc
formatUUID UUID
tid Doc -> Doc -> Doc
<+>
  String -> Doc
text (Int -> String
forall a. Show a => a -> String
show Int
toff) Doc -> Doc -> Doc
$$
  ByteString -> Doc
storeFileContent ByteString
c

-- TODO add some heuristics to recognize binary content
displayFileContent :: String -> FileContent -> Doc
displayFileContent :: String -> ByteString -> Doc
displayFileContent String
pre = [Doc] -> Doc
vcat ([Doc] -> Doc) -> (ByteString -> [Doc]) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc -> Doc
prefix String
pre) ([Doc] -> [Doc]) -> (ByteString -> [Doc]) -> ByteString -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [Doc]
showLines ([ByteString] -> [Doc])
-> (ByteString -> [ByteString]) -> ByteString -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
linesPS
  where
    context :: Doc
context = String -> Doc
blueText String
"[...]"
    showLines :: [ByteString] -> [Doc]
showLines [] = []
    showLines [ByteString
x]
      | ByteString -> Bool
B.null ByteString
x = []
      | Bool
otherwise = [Doc
context Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ByteString -> Doc
packedString ByteString
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
context]
    showLines (ByteString
x:[ByteString]
xs) =
      [Doc
context Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ByteString -> Doc
packedString ByteString
x] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
      (ByteString -> Doc) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Doc
packedString ([ByteString] -> [ByteString]
forall a. [a] -> [a]
init [ByteString]
xs) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
      [ByteString -> Doc
packedString ([ByteString] -> ByteString
forall a. [a] -> a
last [ByteString]
xs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
context]

storeFileContent :: FileContent -> Doc
storeFileContent :: ByteString -> Doc
storeFileContent ByteString
c =
  String -> Doc
text String
"content" Doc -> Doc -> Doc
<+> String -> Doc
text (Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
B.length ByteString
c)) Doc -> Doc -> Doc
$$ ByteString -> Doc
packedString ByteString
c

formatUUID :: UUID -> Doc
formatUUID :: UUID -> Doc
formatUUID (UUID ByteString
x) = ByteString -> Doc
packedString ByteString
x