1-- | Generic wrapper for prim patches to give them an identity. 2module Darcs.Patch.Prim.WithName 3 ( PrimWithName(..) 4 ) where 5 6import Darcs.Prelude 7 8import Darcs.Patch.Annotate ( Annotate(..) ) 9import Darcs.Patch.Apply ( Apply(..) ) 10import Darcs.Patch.Commute ( Commute(..) ) 11import Darcs.Patch.Format ( PatchListFormat(..) ) 12import Darcs.Patch.Ident 13 ( Ident(..) 14 , PatchId 15 , SignedId(..) 16 , StorableId(..) 17 , IdEq2(..) 18 ) 19import Darcs.Patch.Inspect ( PatchInspect(..) ) 20import Darcs.Patch.FileHunk ( IsHunk(..) ) 21import Darcs.Patch.Prim.Class ( PrimApply(..), PrimClassify(..), PrimDetails(..) ) 22import Darcs.Patch.Invert ( Invert(..) ) 23import Darcs.Patch.Merge ( CleanMerge(..) ) 24import Darcs.Patch.Read ( ReadPatch(..) ) 25import Darcs.Patch.Repair ( RepairToFL(..) ) 26import Darcs.Patch.Show 27 ( ShowPatchBasic(..) 28 , ShowPatch(..) 29 , ShowContextPatch(..) 30 ) 31import Darcs.Patch.Summary ( plainSummaryPrim, plainSummaryPrims ) 32import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck(..) ) 33import Darcs.Patch.Witnesses.Ordered ( mapFL_FL, (:>)(..), (:\/:)(..), (:/\:)(..) ) 34import Darcs.Patch.Witnesses.Sealed ( Sealed(..) ) 35import Darcs.Patch.Witnesses.Show ( Show1, Show2, appPrec, showsPrec2 ) 36 37import Darcs.Util.Printer 38 39-- |A 'PrimWithName' is a general way of associating an identity 40-- with an underlying (presumably unnamed) primitive type. This is 41-- required, for example, for V3 patches. 42-- Normally the members of the 'name' type will be generated in 43-- some way when a patch is initially created, to guarantee global 44-- unqiueness across all repositories. 45data PrimWithName name p wX wY = 46 PrimWithName { wnName :: !name, wnPatch :: !(p wX wY) } 47 48type instance PatchId (PrimWithName name p) = name 49 50instance SignedId name => Ident (PrimWithName name p) where 51 ident = wnName 52 53instance (SignedId name, Eq2 p) => IdEq2 (PrimWithName name p) 54 55instance (Eq name, Eq2 p) => Eq2 (PrimWithName name p) where 56 PrimWithName i p =\/= PrimWithName j q 57 | i == j, IsEq <- p =\/= q = IsEq 58 | otherwise = NotEq 59 60instance (Invert p, SignedId name) => Invert (PrimWithName name p) where 61 invert (PrimWithName i p) = PrimWithName (invertId i) (invert p) 62 63instance PatchInspect p => PatchInspect (PrimWithName name p) where 64 listTouchedFiles = listTouchedFiles . wnPatch 65 hunkMatches m = hunkMatches m . wnPatch 66 67instance (Show2 p, Show name) => Show (PrimWithName name p wX wY) where 68 showsPrec d (PrimWithName i p) = 69 showParen (d > appPrec) 70 $ showString "PrimWithName " 71 . showsPrec (appPrec + 1) i 72 . showString " " 73 . showsPrec2 (appPrec + 1) p 74 75instance (Show2 p, Show name) => Show1 (PrimWithName name p wX) 76 77instance (Show2 p, Show name) => Show2 (PrimWithName name p) 78 79instance Apply p => Apply (PrimWithName name p) where 80 type ApplyState (PrimWithName name p) = ApplyState p 81 apply = apply . wnPatch 82 unapply = unapply . wnPatch 83 84instance PatchListFormat (PrimWithName name p) 85 86instance Apply p => RepairToFL (PrimWithName name p) where 87 applyAndTryToFixFL p = apply p >> return Nothing 88 89instance Annotate p => Annotate (PrimWithName name p) where 90 annotate = annotate . wnPatch 91 92instance IsHunk p => IsHunk (PrimWithName name p) where 93 isHunk = isHunk . wnPatch 94 95instance PrimApply p => PrimApply (PrimWithName name p) where 96 applyPrimFL = applyPrimFL . mapFL_FL wnPatch 97 98instance PrimClassify p => PrimClassify (PrimWithName name p) where 99 primIsAddfile = primIsAddfile . wnPatch 100 primIsRmfile = primIsRmfile . wnPatch 101 primIsAdddir = primIsAdddir . wnPatch 102 primIsRmdir = primIsRmdir . wnPatch 103 primIsHunk = primIsHunk . wnPatch 104 primIsMove = primIsMove . wnPatch 105 primIsBinary = primIsBinary . wnPatch 106 primIsTokReplace = primIsTokReplace . wnPatch 107 primIsSetpref = primIsSetpref . wnPatch 108 is_filepatch = is_filepatch . wnPatch 109 110instance PrimDetails p => PrimDetails (PrimWithName name p) where 111 summarizePrim = summarizePrim . wnPatch 112 113-- this is the most important definition: 114-- it ensures that a patch conflicts with itself 115instance (SignedId name, Commute p) => Commute (PrimWithName name p) where 116 commute (PrimWithName i1 p1 :> PrimWithName i2 p2) 117 -- We should never get into a situation where we try 118 -- to commute identical patches 119 | i1 == i2 = error "internal error: trying to commute identical patches" 120 -- whereas this case is the equivalent of merging a patch 121 -- with itself, so it is correct to just report that they don't commute 122 | i1 == invertId i2 = Nothing 123 | otherwise = do 124 p2' :> p1' <- commute (p1 :> p2) 125 return (PrimWithName i2 p2' :> PrimWithName i1 p1') 126 127instance (SignedId name, CleanMerge p) => CleanMerge (PrimWithName name p) where 128 cleanMerge (PrimWithName i1 p1 :\/: PrimWithName i2 p2) 129 | i1 == i2 = error "cannot cleanMerge identical patches" 130 | otherwise = do 131 p2' :/\: p1' <- cleanMerge (p1 :\/: p2) 132 return $ PrimWithName i2 p2' :/\: PrimWithName i1 p1' 133 134instance (StorableId name, ReadPatch p) => ReadPatch (PrimWithName name p) where 135 readPatch' = do 136 name <- readId 137 Sealed p <- readPatch' 138 return (Sealed (PrimWithName name p)) 139 140instance (StorableId name, ShowPatchBasic p) => ShowPatchBasic (PrimWithName name p) where 141 showPatch use (PrimWithName name p) = showId use name $$ showPatch use p 142 143instance (StorableId name, PrimDetails p, ShowPatchBasic p) => ShowPatch (PrimWithName name p) where 144 summary = plainSummaryPrim . wnPatch 145 summaryFL = plainSummaryPrims False 146 thing _ = "change" 147 148instance (StorableId name, ShowContextPatch p) => ShowContextPatch (PrimWithName name p) where 149 showContextPatch use (PrimWithName name p) = do 150 r <- showContextPatch use p 151 return $ showId use name $$ r 152