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