-- | Generic wrapper for prim patches to give them an identity.
module Darcs.Patch.Prim.WithName
  ( PrimWithName(..)
  ) where

import Darcs.Prelude

import Darcs.Patch.Annotate ( Annotate(..) )
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Format ( PatchListFormat(..) )
import Darcs.Patch.Ident
    ( Ident(..)
    , PatchId
    , SignedId(..)
    , StorableId(..)
    , IdEq2(..)
    )
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Prim.Class ( PrimApply(..), PrimClassify(..), PrimDetails(..) )
import Darcs.Patch.Invert ( Invert(..) )
import Darcs.Patch.Merge ( CleanMerge(..) )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.Repair ( RepairToFL(..) )
import Darcs.Patch.Show
    ( ShowPatchBasic(..)
    , ShowPatch(..)
    , ShowContextPatch(..)
    )
import Darcs.Patch.Summary ( plainSummaryPrim, plainSummaryPrims )
import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck(..) )
import Darcs.Patch.Witnesses.Ordered ( mapFL_FL, (:>)(..), (:\/:)(..), (:/\:)(..) )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
import Darcs.Patch.Witnesses.Show ( Show1, Show2, appPrec, showsPrec2 )

import Darcs.Util.Printer

-- |A 'PrimWithName' is a general way of associating an identity
-- with an underlying (presumably unnamed) primitive type. This is
-- required, for example, for V3 patches.
-- Normally the members of the 'name' type will be generated in
-- some way when a patch is initially created, to guarantee global
-- unqiueness across all repositories.
data PrimWithName name p wX wY =
  PrimWithName { PrimWithName name p wX wY -> name
wnName :: !name, PrimWithName name p wX wY -> p wX wY
wnPatch :: !(p wX wY) }

type instance PatchId (PrimWithName name p) = name

instance SignedId name => Ident (PrimWithName name p) where
  ident :: PrimWithName name p wX wY -> PatchId (PrimWithName name p)
ident = PrimWithName name p wX wY -> PatchId (PrimWithName name p)
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> name
wnName

instance (SignedId name, Eq2 p) => IdEq2 (PrimWithName name p)

instance (Eq name, Eq2 p) => Eq2 (PrimWithName name p) where
  PrimWithName name
i p wA wB
p =\/= :: PrimWithName name p wA wB
-> PrimWithName name p wA wC -> EqCheck wB wC
=\/= PrimWithName name
j p wA wC
q
    | name
i name -> name -> Bool
forall a. Eq a => a -> a -> Bool
== name
j, EqCheck wB wC
IsEq <- p wA wB
p p wA wB -> p wA wC -> EqCheck wB wC
forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= p wA wC
q = EqCheck wB wC
forall wA. EqCheck wA wA
IsEq
    | Bool
otherwise = EqCheck wB wC
forall wA wB. EqCheck wA wB
NotEq

instance (Invert p, SignedId name) => Invert (PrimWithName name p) where
  invert :: PrimWithName name p wX wY -> PrimWithName name p wY wX
invert (PrimWithName name
i p wX wY
p) = name -> p wY wX -> PrimWithName name p wY wX
forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName (name -> name
forall a. SignedId a => a -> a
invertId name
i) (p wX wY -> p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert p wX wY
p)

instance PatchInspect p => PatchInspect (PrimWithName name p) where
  listTouchedFiles :: PrimWithName name p wX wY -> [AnchoredPath]
listTouchedFiles = p wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles (p wX wY -> [AnchoredPath])
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> [AnchoredPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
  hunkMatches :: (ByteString -> Bool) -> PrimWithName name p wX wY -> Bool
hunkMatches ByteString -> Bool
m = (ByteString -> Bool) -> p wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
m (p wX wY -> Bool)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch

instance (Show2 p, Show name) => Show (PrimWithName name p wX wY) where
  showsPrec :: Int -> PrimWithName name p wX wY -> ShowS
showsPrec Int
d (PrimWithName name
i p wX wY
p) =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec)
      (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"PrimWithName "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> name -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) name
i
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> p wX wY -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) p wX wY
p

instance (Show2 p, Show name) => Show1 (PrimWithName name p wX)

instance (Show2 p, Show name) => Show2 (PrimWithName name p)

instance Apply p => Apply (PrimWithName name p) where
  type ApplyState (PrimWithName name p) = ApplyState p
  apply :: PrimWithName name p wX wY -> m ()
apply = p wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply (p wX wY -> m ())
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
  unapply :: PrimWithName name p wX wY -> m ()
unapply = p wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply (p wX wY -> m ())
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch

instance PatchListFormat (PrimWithName name p)

instance Apply p => RepairToFL (PrimWithName name p) where
  applyAndTryToFixFL :: PrimWithName name p wX wY
-> m (Maybe (String, FL (PrimWithName name p) wX wY))
applyAndTryToFixFL PrimWithName name p wX wY
p = PrimWithName name p wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply PrimWithName name p wX wY
p m ()
-> m (Maybe (String, FL (PrimWithName name p) wX wY))
-> m (Maybe (String, FL (PrimWithName name p) wX wY))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (String, FL (PrimWithName name p) wX wY)
-> m (Maybe (String, FL (PrimWithName name p) wX wY))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, FL (PrimWithName name p) wX wY)
forall a. Maybe a
Nothing

instance Annotate p => Annotate (PrimWithName name p) where
  annotate :: PrimWithName name p wX wY -> AnnotatedM ()
annotate = p wX wY -> AnnotatedM ()
forall (p :: * -> * -> *) wX wY.
Annotate p =>
p wX wY -> AnnotatedM ()
annotate (p wX wY -> AnnotatedM ())
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> AnnotatedM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch

instance IsHunk p => IsHunk (PrimWithName name p) where
  isHunk :: PrimWithName name p wX wY -> Maybe (FileHunk wX wY)
isHunk = p wX wY -> Maybe (FileHunk wX wY)
forall (p :: * -> * -> *) wX wY.
IsHunk p =>
p wX wY -> Maybe (FileHunk wX wY)
isHunk (p wX wY -> Maybe (FileHunk wX wY))
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Maybe (FileHunk wX wY)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch

instance PrimApply p => PrimApply (PrimWithName name p) where
  applyPrimFL :: FL (PrimWithName name p) wX wY -> m ()
applyPrimFL = FL p wX wY -> m ()
forall (prim :: * -> * -> *) (m :: * -> *) wX wY.
(PrimApply prim, ApplyMonad (ApplyState prim) m) =>
FL prim wX wY -> m ()
applyPrimFL (FL p wX wY -> m ())
-> (FL (PrimWithName name p) wX wY -> FL p wX wY)
-> FL (PrimWithName name p) wX wY
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wY. PrimWithName name p wW wY -> p wW wY)
-> FL (PrimWithName name p) wX wY -> FL p wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. PrimWithName name p wW wY -> p wW wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch

instance PrimClassify p => PrimClassify (PrimWithName name p) where
  primIsAddfile :: PrimWithName name p wX wY -> Bool
primIsAddfile = p wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsAddfile (p wX wY -> Bool)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
  primIsRmfile :: PrimWithName name p wX wY -> Bool
primIsRmfile = p wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsRmfile (p wX wY -> Bool)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
  primIsAdddir :: PrimWithName name p wX wY -> Bool
primIsAdddir = p wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsAdddir (p wX wY -> Bool)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
  primIsRmdir :: PrimWithName name p wX wY -> Bool
primIsRmdir = p wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsRmdir (p wX wY -> Bool)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
  primIsHunk :: PrimWithName name p wX wY -> Bool
primIsHunk = p wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsHunk (p wX wY -> Bool)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
  primIsMove :: PrimWithName name p wX wY -> Bool
primIsMove = p wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsMove (p wX wY -> Bool)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
  primIsBinary :: PrimWithName name p wX wY -> Bool
primIsBinary = p wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsBinary (p wX wY -> Bool)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
  primIsTokReplace :: PrimWithName name p wX wY -> Bool
primIsTokReplace = p wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsTokReplace (p wX wY -> Bool)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
  primIsSetpref :: PrimWithName name p wX wY -> Bool
primIsSetpref = p wX wY -> Bool
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsSetpref (p wX wY -> Bool)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
  is_filepatch :: PrimWithName name p wX wY -> Maybe AnchoredPath
is_filepatch = p wX wY -> Maybe AnchoredPath
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Maybe AnchoredPath
is_filepatch (p wX wY -> Maybe AnchoredPath)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Maybe AnchoredPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch

instance PrimDetails p => PrimDetails (PrimWithName name p) where
  summarizePrim :: PrimWithName name p wX wY -> [SummDetail]
summarizePrim = p wX wY -> [SummDetail]
forall (prim :: * -> * -> *) wX wY.
PrimDetails prim =>
prim wX wY -> [SummDetail]
summarizePrim (p wX wY -> [SummDetail])
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> [SummDetail]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch

-- this is the most important definition:
-- it ensures that a patch conflicts with itself
instance (SignedId name, Commute p) => Commute (PrimWithName name p) where
  commute :: (:>) (PrimWithName name p) (PrimWithName name p) wX wY
-> Maybe ((:>) (PrimWithName name p) (PrimWithName name p) wX wY)
commute (PrimWithName name
i1 p wX wZ
p1 :> PrimWithName name
i2 p wZ wY
p2)
    -- We should never get into a situation where we try
    -- to commute identical patches
    | name
i1 name -> name -> Bool
forall a. Eq a => a -> a -> Bool
== name
i2 = String
-> Maybe ((:>) (PrimWithName name p) (PrimWithName name p) wX wY)
forall a. HasCallStack => String -> a
error String
"internal error: trying to commute identical patches"
    -- whereas this case is the equivalent of merging a patch
    -- with itself, so it is correct to just report that they don't commute
    | name
i1 name -> name -> Bool
forall a. Eq a => a -> a -> Bool
== name -> name
forall a. SignedId a => a -> a
invertId name
i2 = Maybe ((:>) (PrimWithName name p) (PrimWithName name p) wX wY)
forall a. Maybe a
Nothing
    | Bool
otherwise = do
        p wX wZ
p2' :> p wZ wY
p1' <- (:>) p p wX wY -> Maybe ((:>) p p wX wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (p wX wZ
p1 p wX wZ -> p wZ wY -> (:>) p p wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wY
p2)
        (:>) (PrimWithName name p) (PrimWithName name p) wX wY
-> Maybe ((:>) (PrimWithName name p) (PrimWithName name p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (name -> p wX wZ -> PrimWithName name p wX wZ
forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName name
i2 p wX wZ
p2' PrimWithName name p wX wZ
-> PrimWithName name p wZ wY
-> (:>) (PrimWithName name p) (PrimWithName name p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> name -> p wZ wY -> PrimWithName name p wZ wY
forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName name
i1 p wZ wY
p1')

instance (SignedId name, CleanMerge p) => CleanMerge (PrimWithName name p) where
  cleanMerge :: (:\/:) (PrimWithName name p) (PrimWithName name p) wX wY
-> Maybe ((:/\:) (PrimWithName name p) (PrimWithName name p) wX wY)
cleanMerge (PrimWithName name
i1 p wZ wX
p1 :\/: PrimWithName name
i2 p wZ wY
p2)
    | name
i1 name -> name -> Bool
forall a. Eq a => a -> a -> Bool
== name
i2 = String
-> Maybe ((:/\:) (PrimWithName name p) (PrimWithName name p) wX wY)
forall a. HasCallStack => String -> a
error String
"cannot cleanMerge identical patches"
    | Bool
otherwise = do
        p wX wZ
p2' :/\: p wY wZ
p1' <- (:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
forall (p :: * -> * -> *) wX wY.
CleanMerge p =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
cleanMerge (p wZ wX
p1 p wZ wX -> p wZ wY -> (:\/:) p p wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: p wZ wY
p2)
        (:/\:) (PrimWithName name p) (PrimWithName name p) wX wY
-> Maybe ((:/\:) (PrimWithName name p) (PrimWithName name p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:/\:) (PrimWithName name p) (PrimWithName name p) wX wY
 -> Maybe
      ((:/\:) (PrimWithName name p) (PrimWithName name p) wX wY))
-> (:/\:) (PrimWithName name p) (PrimWithName name p) wX wY
-> Maybe ((:/\:) (PrimWithName name p) (PrimWithName name p) wX wY)
forall a b. (a -> b) -> a -> b
$ name -> p wX wZ -> PrimWithName name p wX wZ
forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName name
i2 p wX wZ
p2' PrimWithName name p wX wZ
-> PrimWithName name p wY wZ
-> (:/\:) (PrimWithName name p) (PrimWithName name p) wX wY
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: name -> p wY wZ -> PrimWithName name p wY wZ
forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName name
i1 p wY wZ
p1'

instance (StorableId name, ReadPatch p) => ReadPatch (PrimWithName name p) where
  readPatch' :: Parser (Sealed (PrimWithName name p wX))
readPatch' = do
      name
name <- Parser name
forall a. StorableId a => Parser a
readId
      Sealed p wX wX
p <- Parser (Sealed (p wX))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
      Sealed (PrimWithName name p wX)
-> Parser (Sealed (PrimWithName name p wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimWithName name p wX wX -> Sealed (PrimWithName name p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (name -> p wX wX -> PrimWithName name p wX wX
forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName name
name p wX wX
p))

instance (StorableId name, ShowPatchBasic p) => ShowPatchBasic (PrimWithName name p) where
  showPatch :: ShowPatchFor -> PrimWithName name p wX wY -> Doc
showPatch ShowPatchFor
use (PrimWithName name
name p wX wY
p) = ShowPatchFor -> name -> Doc
forall a. StorableId a => ShowPatchFor -> a -> Doc
showId ShowPatchFor
use name
name Doc -> Doc -> Doc
$$ ShowPatchFor -> p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
use p wX wY
p

instance (StorableId name, PrimDetails p, ShowPatchBasic p) => ShowPatch (PrimWithName name p) where
  summary :: PrimWithName name p wX wY -> Doc
summary = p wX wY -> Doc
forall (prim :: * -> * -> *) wX wY.
PrimDetails prim =>
prim wX wY -> Doc
plainSummaryPrim (p wX wY -> Doc)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
  summaryFL :: FL (PrimWithName name p) wX wY -> Doc
summaryFL = Bool -> FL (PrimWithName name p) wX wY -> Doc
forall (prim :: * -> * -> *) wX wY.
PrimDetails prim =>
Bool -> FL prim wX wY -> Doc
plainSummaryPrims Bool
False
  thing :: PrimWithName name p wX wY -> String
thing PrimWithName name p wX wY
_ = String
"change"

instance (StorableId name, ShowContextPatch p) => ShowContextPatch (PrimWithName name p) where
  showContextPatch :: ShowPatchFor -> PrimWithName name p wX wY -> m Doc
showContextPatch ShowPatchFor
use (PrimWithName name
name p wX wY
p) = do
    Doc
r <- ShowPatchFor -> p wX wY -> m Doc
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(ShowContextPatch p, ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> p wX wY -> m Doc
showContextPatch ShowPatchFor
use p 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 -> name -> Doc
forall a. StorableId a => ShowPatchFor -> a -> Doc
showId ShowPatchFor
use name
name Doc -> Doc -> Doc
$$ Doc
r