--  Copyright (C) 2002-2003 David Roundy
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

module Darcs.Patch.Named
       ( Named(..),
         infopatch,
         adddeps, namepatch, anonymous,
         getdeps,
         patch2patchinfo, patchname, patchcontents,
         fmapNamed, fmapFL_Named,
         commuterIdNamed, commuterNamedId,
         mergerIdNamed
       )
       where

import Prelude ()
import Darcs.Prelude

import Prelude hiding ( pi )
import Darcs.Patch.CommuteFn ( CommuteFn, commuterIdFL, commuterFLId
                             , MergeFn, mergerIdFL )
import Darcs.Patch.Conflict ( Conflict(..), CommuteNoConflicts )
import Darcs.Patch.Debug ( PatchDebug(..) )
import Darcs.Patch.Effect ( Effect(effect, effectRL) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Format ( PatchListFormat )
import Darcs.Patch.Info ( PatchInfo, readPatchInfo, showPatchInfo, patchinfo,
                          piName, displayPatchInfo, makePatchname, invertName )
import Darcs.Patch.Merge ( Merge(..) )
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Invert ( Invert(..) )
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.Prim ( PrimPatchBase(..) )
import Darcs.Patch.ReadMonads ( ParserM, option, lexChar,
                                choice, skipWhile, anyChar )
import Darcs.Patch.Repair ( mapMaybeSnd, Repair(..), RepairToFL, Check(..) )
import Darcs.Patch.Show
    ( ShowPatchBasic(..), ShowPatch(..), ShowContextPatch(..), ShowPatchFor(..) )
import Darcs.Patch.Summary ( plainSummary )
import Darcs.Patch.Viewing () -- for ShowPatch FL instances

import Darcs.Patch.Witnesses.Eq ( Eq2(..) )
import Darcs.Patch.Witnesses.Ordered
    ( (:>)(..), (:\/:)(..), (:/\:)(..), FL, mapFL, mapFL_FL )
import Darcs.Patch.Witnesses.Sealed ( Sealed, mapSeal )
import Darcs.Patch.Witnesses.Show ( ShowDict(..), Show1(..), Show2(..) )

import Darcs.Util.Printer
    ( Doc, ($$), (<+>), prefix, text, vcat, cyanText, blueText )

-- | The @Named@ type adds a patch info about a patch, that is a name.
data Named p wX wY where
    NamedP :: !PatchInfo
           -> ![PatchInfo]
           -> !(FL p wX wY)
           -> Named p wX wY
   deriving Int -> Named p wX wY -> ShowS
[Named p wX wY] -> ShowS
Named p wX wY -> String
(Int -> Named p wX wY -> ShowS)
-> (Named p wX wY -> String)
-> ([Named p wX wY] -> ShowS)
-> Show (Named p wX wY)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (p :: * -> * -> *) wX wY.
Show2 p =>
Int -> Named p wX wY -> ShowS
forall (p :: * -> * -> *) wX wY.
Show2 p =>
[Named p wX wY] -> ShowS
forall (p :: * -> * -> *) wX wY. Show2 p => Named p wX wY -> String
showList :: [Named p wX wY] -> ShowS
$cshowList :: forall (p :: * -> * -> *) wX wY.
Show2 p =>
[Named p wX wY] -> ShowS
show :: Named p wX wY -> String
$cshow :: forall (p :: * -> * -> *) wX wY. Show2 p => Named p wX wY -> String
showsPrec :: Int -> Named p wX wY -> ShowS
$cshowsPrec :: forall (p :: * -> * -> *) wX wY.
Show2 p =>
Int -> Named p wX wY -> ShowS
Show
-- ^ @NamedP info deps p@ represents patch @p@ with name
-- @info@. @deps@ is a list of dependencies added at the named patch
-- level, compared with the unnamed level (ie, dependencies added with
-- @darcs record --ask-deps@).

instance PrimPatchBase p => PrimPatchBase (Named p) where
    type PrimOf (Named p) = PrimOf p

instance Effect p => Effect (Named p) where
    effect :: Named p wX wY -> FL (PrimOf (Named p)) wX wY
effect (NamedP _ _ p :: FL p wX wY
p) = FL p wX wY -> FL (PrimOf (FL p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL p wX wY
p
    effectRL :: Named p wX wY -> RL (PrimOf (Named p)) wX wY
effectRL (NamedP _ _ p :: FL p wX wY
p) = FL p wX wY -> RL (PrimOf (FL p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> RL (PrimOf p) wX wY
effectRL FL p wX wY
p

instance IsHunk (Named p) where
    isHunk :: Named p wX wY -> Maybe (FileHunk wX wY)
isHunk _ = Maybe (FileHunk wX wY)
forall a. Maybe a
Nothing

instance PatchListFormat (Named p)

instance (ReadPatch p, PatchListFormat p) => ReadPatch (Named p) where
 readPatch' :: m (Sealed (Named p wX))
readPatch' = m (Sealed (Named p wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, PatchListFormat p, ParserM m) =>
m (Sealed (Named p wX))
readNamed

readNamed :: (ReadPatch p, PatchListFormat p, ParserM m) => m (Sealed (Named p wX))
readNamed :: m (Sealed (Named p wX))
readNamed
          = do PatchInfo
n <- m PatchInfo
forall (m :: * -> *). ParserM m => m PatchInfo
readPatchInfo
               [PatchInfo]
d <- m [PatchInfo]
forall (m :: * -> *). ParserM m => m [PatchInfo]
readDepends
               Sealed (FL p wX)
p <- m (Sealed (FL p wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch'
               Sealed (Named p wX) -> m (Sealed (Named p wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (Named p wX) -> m (Sealed (Named p wX)))
-> Sealed (Named p wX) -> m (Sealed (Named p wX))
forall a b. (a -> b) -> a -> b
$ (PatchInfo -> [PatchInfo] -> FL p wX wX -> Named p wX wX
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n [PatchInfo]
d) (forall wX. FL p wX wX -> Named p wX wX)
-> Sealed (FL p wX) -> Sealed (Named p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
`mapSeal` Sealed (FL p wX)
p

readDepends :: ParserM m => m [PatchInfo]
readDepends :: m [PatchInfo]
readDepends =
  [PatchInfo] -> m [PatchInfo] -> m [PatchInfo]
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [] (m [PatchInfo] -> m [PatchInfo]) -> m [PatchInfo] -> m [PatchInfo]
forall a b. (a -> b) -> a -> b
$ do Char -> m ()
forall (m :: * -> *). ParserM m => Char -> m ()
lexChar '<'
                 m [PatchInfo]
forall (m :: * -> *). ParserM m => m [PatchInfo]
readPis

readPis :: ParserM m => m [PatchInfo]
readPis :: m [PatchInfo]
readPis = [m [PatchInfo]] -> m [PatchInfo]
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [ do PatchInfo
pi <- m PatchInfo
forall (m :: * -> *). ParserM m => m PatchInfo
readPatchInfo
                      [PatchInfo]
pis <- m [PatchInfo]
forall (m :: * -> *). ParserM m => m [PatchInfo]
readPis
                      [PatchInfo] -> m [PatchInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
piPatchInfo -> [PatchInfo] -> [PatchInfo]
forall a. a -> [a] -> [a]
:[PatchInfo]
pis)
                 , do (Char -> Bool) -> m ()
forall (m :: * -> *). ParserM m => (Char -> Bool) -> m ()
skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '>')
                      Char
_ <- m Char
forall (m :: * -> *). ParserM m => m Char
anyChar
                      [PatchInfo] -> m [PatchInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [] ]

instance Apply p => Apply (Named p) where
    type ApplyState (Named p) = ApplyState p
    apply :: Named p wX wY -> m ()
apply (NamedP _ _ p :: FL p wX wY
p) = FL p wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply FL p wX wY
p

instance RepairToFL p => Repair (Named p) where
    applyAndTryToFix :: Named p wX wY -> m (Maybe (String, Named p wX wY))
applyAndTryToFix (NamedP n :: PatchInfo
n d :: [PatchInfo]
d p :: FL p wX wY
p) = (FL p wX wY -> Named p wX wY)
-> Maybe (String, FL p wX wY) -> Maybe (String, Named p wX wY)
forall a b c. (a -> b) -> Maybe (c, a) -> Maybe (c, b)
mapMaybeSnd (PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n [PatchInfo]
d) (Maybe (String, FL p wX wY) -> Maybe (String, Named p wX wY))
-> m (Maybe (String, FL p wX wY))
-> m (Maybe (String, Named p wX wY))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FL p wX wY -> m (Maybe (String, FL p wX wY))
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Repair p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m (Maybe (String, p wX wY))
applyAndTryToFix FL p wX wY
p

namepatch :: String -> String -> String -> [String] -> FL p wX wY -> IO (Named p wX wY)
namepatch :: String
-> String -> String -> [String] -> FL p wX wY -> IO (Named p wX wY)
namepatch date :: String
date name :: String
name author :: String
author desc :: [String]
desc p :: FL p wX wY
p
    | '\n' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
name = String -> IO (Named p wX wY)
forall a. HasCallStack => String -> a
error "Patch names cannot contain newlines."
    | Bool
otherwise = do PatchInfo
pinf <- String -> String -> String -> [String] -> IO PatchInfo
patchinfo String
date String
name String
author [String]
desc
                     Named p wX wY -> IO (Named p wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Named p wX wY -> IO (Named p wX wY))
-> Named p wX wY -> IO (Named p wX wY)
forall a b. (a -> b) -> a -> b
$ PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
pinf [] FL p wX wY
p

anonymous :: FL p wX wY -> IO (Named p wX wY)
anonymous :: FL p wX wY -> IO (Named p wX wY)
anonymous p :: FL p wX wY
p = String
-> String -> String -> [String] -> FL p wX wY -> IO (Named p wX wY)
forall (p :: * -> * -> *) wX wY.
String
-> String -> String -> [String] -> FL p wX wY -> IO (Named p wX wY)
namepatch "today" "anonymous" "unknown" ["anonymous"] FL p wX wY
p

infopatch :: PatchInfo -> FL p wX wY -> Named p wX wY
infopatch :: PatchInfo -> FL p wX wY -> Named p wX wY
infopatch pi :: PatchInfo
pi p :: FL p wX wY
p = PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
pi [] FL p wX wY
p

adddeps :: Named p wX wY -> [PatchInfo] -> Named p wX wY
adddeps :: Named p wX wY -> [PatchInfo] -> Named p wX wY
adddeps (NamedP pi :: PatchInfo
pi _ p :: FL p wX wY
p) ds :: [PatchInfo]
ds = PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
pi [PatchInfo]
ds FL p wX wY
p

getdeps :: Named p wX wY -> [PatchInfo]
getdeps :: Named p wX wY -> [PatchInfo]
getdeps (NamedP _ ds :: [PatchInfo]
ds _) = [PatchInfo]
ds

patch2patchinfo :: Named p wX wY -> PatchInfo
patch2patchinfo :: Named p wX wY -> PatchInfo
patch2patchinfo (NamedP i :: PatchInfo
i _ _) = PatchInfo
i

patchname :: Named p wX wY -> String
patchname :: Named p wX wY -> String
patchname (NamedP i :: PatchInfo
i _ _) = SHA1 -> String
forall a. Show a => a -> String
show (SHA1 -> String) -> SHA1 -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname PatchInfo
i

patchcontents :: Named p wX wY -> FL p wX wY
patchcontents :: Named p wX wY -> FL p wX wY
patchcontents (NamedP _ _ p :: FL p wX wY
p) = FL p wX wY
p

fmapNamed :: (forall wA wB . p wA wB -> q wA wB) -> Named p wX wY -> Named q wX wY
fmapNamed :: (forall wA wB. p wA wB -> q wA wB)
-> Named p wX wY -> Named q wX wY
fmapNamed f :: forall wA wB. p wA wB -> q wA wB
f (NamedP i :: PatchInfo
i deps :: [PatchInfo]
deps p :: FL p wX wY
p) = PatchInfo -> [PatchInfo] -> FL q wX wY -> Named q wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
i [PatchInfo]
deps ((forall wA wB. p wA wB -> q wA wB) -> FL p wX wY -> FL q 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 wA wB. p wA wB -> q wA wB
f FL p wX wY
p)

fmapFL_Named :: (FL p wA wB -> FL q wC wD) -> Named p wA wB -> Named q wC wD
fmapFL_Named :: (FL p wA wB -> FL q wC wD) -> Named p wA wB -> Named q wC wD
fmapFL_Named f :: FL p wA wB -> FL q wC wD
f (NamedP i :: PatchInfo
i deps :: [PatchInfo]
deps p :: FL p wA wB
p) = PatchInfo -> [PatchInfo] -> FL q wC wD -> Named q wC wD
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
i [PatchInfo]
deps (FL p wA wB -> FL q wC wD
f FL p wA wB
p)

instance (Commute p, Eq2 p) => Eq2 (Named p) where
    unsafeCompare :: Named p wA wB -> Named p wC wD -> Bool
unsafeCompare (NamedP n1 :: PatchInfo
n1 d1 :: [PatchInfo]
d1 p1 :: FL p wA wB
p1) (NamedP n2 :: PatchInfo
n2 d2 :: [PatchInfo]
d2 p2 :: FL p wC wD
p2) =
        PatchInfo
n1 PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
n2 Bool -> Bool -> Bool
&& [PatchInfo]
d1 [PatchInfo] -> [PatchInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [PatchInfo]
d2 Bool -> Bool -> Bool
&& FL p wA wB -> FL p wC wD -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
unsafeCompare FL p wA wB
p1 FL p wC wD
p2

instance Invert p => Invert (Named p) where
    invert :: Named p wX wY -> Named p wY wX
invert (NamedP n :: PatchInfo
n d :: [PatchInfo]
d p :: FL p wX wY
p)  = PatchInfo -> [PatchInfo] -> FL p wY wX -> Named p wY wX
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP (PatchInfo -> PatchInfo
invertName PatchInfo
n) ((PatchInfo -> PatchInfo) -> [PatchInfo] -> [PatchInfo]
forall a b. (a -> b) -> [a] -> [b]
map PatchInfo -> PatchInfo
invertName [PatchInfo]
d) (FL p wX wY -> FL p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL p wX wY
p)


instance Commute p => Commute (Named p) where
    commute :: (:>) (Named p) (Named p) wX wY
-> Maybe ((:>) (Named p) (Named p) wX wY)
commute (NamedP n1 :: PatchInfo
n1 d1 :: [PatchInfo]
d1 p1 :: FL p wX wZ
p1 :> NamedP n2 :: PatchInfo
n2 d2 :: [PatchInfo]
d2 p2 :: FL p wZ wY
p2) =
        if PatchInfo
n2 PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
d1 Bool -> Bool -> Bool
|| PatchInfo
n1 PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
d2
        then Maybe ((:>) (Named p) (Named p) wX wY)
forall a. Maybe a
Nothing
        else do (p2' :: FL p wX wZ
p2' :> p1' :: FL p wZ wY
p1') <- (:>) (FL p) (FL p) wX wY -> Maybe ((:>) (FL p) (FL p) wX wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (FL p wX wZ
p1 FL p wX wZ -> FL p wZ wY -> (:>) (FL p) (FL p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p wZ wY
p2)
                (:>) (Named p) (Named p) wX wY
-> Maybe ((:>) (Named p) (Named p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo -> [PatchInfo] -> FL p wX wZ -> Named p wX wZ
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p wX wZ
p2' Named p wX wZ -> Named p wZ wY -> (:>) (Named p) (Named p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PatchInfo -> [PatchInfo] -> FL p wZ wY -> Named p wZ wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n1 [PatchInfo]
d1 FL p wZ wY
p1')

commuterIdNamed :: CommuteFn p1 p2 -> CommuteFn p1 (Named p2)
commuterIdNamed :: CommuteFn p1 p2 -> CommuteFn p1 (Named p2)
commuterIdNamed commuter :: CommuteFn p1 p2
commuter (p1 :: p1 wX wZ
p1 :> NamedP n2 :: PatchInfo
n2 d2 :: [PatchInfo]
d2 p2 :: FL p2 wZ wY
p2) =
   do p2' :: FL p2 wX wZ
p2' :> p1' :: p1 wZ wY
p1' <- CommuteFn p1 p2
-> (:>) p1 (FL p2) wX wY -> Maybe ((:>) (FL p2) p1 wX wY)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL CommuteFn p1 p2
commuter (p1 wX wZ
p1 p1 wX wZ -> FL p2 wZ wY -> (:>) p1 (FL p2) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p2 wZ wY
p2)
      (:>) (Named p2) p1 wX wY -> Maybe ((:>) (Named p2) p1 wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo -> [PatchInfo] -> FL p2 wX wZ -> Named p2 wX wZ
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p2 wX wZ
p2' Named p2 wX wZ -> p1 wZ wY -> (:>) (Named p2) p1 wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p1 wZ wY
p1')

commuterNamedId :: CommuteFn p1 p2 -> CommuteFn (Named p1) p2
commuterNamedId :: CommuteFn p1 p2 -> CommuteFn (Named p1) p2
commuterNamedId commuter :: CommuteFn p1 p2
commuter (NamedP n1 :: PatchInfo
n1 d1 :: [PatchInfo]
d1 p1 :: FL p1 wX wZ
p1 :> p2 :: p2 wZ wY
p2) =
   do p2' :: p2 wX wZ
p2' :> p1' :: FL p1 wZ wY
p1' <- CommuteFn p1 p2
-> (:>) (FL p1) p2 wX wY -> Maybe ((:>) p2 (FL p1) wX wY)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn (FL p1) p2
commuterFLId CommuteFn p1 p2
commuter (FL p1 wX wZ
p1 FL p1 wX wZ -> p2 wZ wY -> (:>) (FL p1) p2 wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p2 wZ wY
p2)
      (:>) p2 (Named p1) wX wY -> Maybe ((:>) p2 (Named p1) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (p2 wX wZ
p2' p2 wX wZ -> Named p1 wZ wY -> (:>) p2 (Named p1) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PatchInfo -> [PatchInfo] -> FL p1 wZ wY -> Named p1 wZ wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n1 [PatchInfo]
d1 FL p1 wZ wY
p1')

instance Merge p => Merge (Named p) where
    merge :: (:\/:) (Named p) (Named p) wX wY
-> (:/\:) (Named p) (Named p) wX wY
merge (NamedP n1 :: PatchInfo
n1 d1 :: [PatchInfo]
d1 p1 :: FL p wZ wX
p1 :\/: NamedP n2 :: PatchInfo
n2 d2 :: [PatchInfo]
d2 p2 :: FL p wZ wY
p2)
        = case (:\/:) (FL p) (FL p) wX wY -> (:/\:) (FL p) (FL p) wX wY
forall (p :: * -> * -> *) wX wY.
Merge p =>
(:\/:) p p wX wY -> (:/\:) p p wX wY
merge (FL p wZ wX
p1 FL p wZ wX -> FL p wZ wY -> (:\/:) (FL p) (FL p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL p wZ wY
p2) of
          (p2' :: FL p wX wZ
p2' :/\: p1' :: FL p wY wZ
p1') -> PatchInfo -> [PatchInfo] -> FL p wX wZ -> Named p wX wZ
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p wX wZ
p2' Named p wX wZ -> Named p wY wZ -> (:/\:) (Named p) (Named p) wX wY
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: PatchInfo -> [PatchInfo] -> FL p wY wZ -> Named p wY wZ
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n1 [PatchInfo]
d1 FL p wY wZ
p1'

mergerIdNamed :: MergeFn p1 p2 -> MergeFn p1 (Named p2)
mergerIdNamed :: MergeFn p1 p2 -> MergeFn p1 (Named p2)
mergerIdNamed merger :: MergeFn p1 p2
merger (p1 :: p1 wZ wX
p1 :\/: NamedP n2 :: PatchInfo
n2 d2 :: [PatchInfo]
d2 p2 :: FL p2 wZ wY
p2) =
   case MergeFn p1 p2 -> (:\/:) p1 (FL p2) wX wY -> (:/\:) (FL p2) p1 wX wY
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (FL p2)
mergerIdFL MergeFn p1 p2
merger (p1 wZ wX
p1 p1 wZ wX -> FL p2 wZ wY -> (:\/:) p1 (FL p2) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL p2 wZ wY
p2) of
     p2' :: FL p2 wX wZ
p2' :/\: p1' :: p1 wY wZ
p1' -> PatchInfo -> [PatchInfo] -> FL p2 wX wZ -> Named p2 wX wZ
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p2 wX wZ
p2' Named p2 wX wZ -> p1 wY wZ -> (:/\:) (Named p2) p1 wX wY
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: p1 wY wZ
p1'

instance PatchInspect p => PatchInspect (Named p) where
    listTouchedFiles :: Named p wX wY -> [String]
listTouchedFiles (NamedP _ _ p :: FL p wX wY
p) = FL p wX wY -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
listTouchedFiles FL p wX wY
p
    hunkMatches :: (ByteString -> Bool) -> Named p wX wY -> Bool
hunkMatches f :: ByteString -> Bool
f (NamedP _ _ p :: FL p wX wY
p) = (ByteString -> Bool) -> FL p wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f FL p wX wY
p

instance (CommuteNoConflicts p, Conflict p) => Conflict (Named p) where
    resolveConflicts :: Named p wX wY -> [[Sealed (FL (PrimOf (Named p)) wY)]]
resolveConflicts (NamedP _ _ p :: FL p wX wY
p) = FL p wX wY -> [[Sealed (FL (PrimOf (FL p)) wY)]]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [[Sealed (FL (PrimOf p) wY)]]
resolveConflicts FL p wX wY
p
    conflictedEffect :: Named p wX wY -> [IsConflictedPrim (PrimOf (Named p))]
conflictedEffect (NamedP _ _ p :: FL p wX wY
p) = FL p wX wY -> [IsConflictedPrim (PrimOf (FL p))]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [IsConflictedPrim (PrimOf p)]
conflictedEffect FL p wX wY
p

instance Check p => Check (Named p) where
    isInconsistent :: Named p wX wY -> Maybe Doc
isInconsistent (NamedP _ _ p :: FL p wX wY
p) = FL p wX wY -> Maybe Doc
forall (p :: * -> * -> *) wX wY. Check p => p wX wY -> Maybe Doc
isInconsistent FL p wX wY
p

-- ForStorage: note the difference between use of <> when there are
-- no explicit dependencies vs. <+> when there are
showNamedPrefix :: ShowPatchFor -> PatchInfo -> [PatchInfo] -> Doc -> Doc
showNamedPrefix :: ShowPatchFor -> PatchInfo -> [PatchInfo] -> Doc -> Doc
showNamedPrefix f :: ShowPatchFor
f@ShowPatchFor
ForStorage n :: PatchInfo
n [] p :: Doc
p =
    ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
p
showNamedPrefix f :: ShowPatchFor
f@ShowPatchFor
ForStorage n :: PatchInfo
n d :: [PatchInfo]
d p :: Doc
p =
    ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
n
    Doc -> Doc -> Doc
$$ String -> Doc
blueText "<"
    Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((PatchInfo -> Doc) -> [PatchInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f) [PatchInfo]
d)
    Doc -> Doc -> Doc
$$ String -> Doc
blueText ">"
    Doc -> Doc -> Doc
<+> Doc
p
showNamedPrefix f :: ShowPatchFor
f@ShowPatchFor
ForDisplay n :: PatchInfo
n [] p :: Doc
p =
    ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
n
    Doc -> Doc -> Doc
$$ Doc
p
showNamedPrefix f :: ShowPatchFor
f@ShowPatchFor
ForDisplay n :: PatchInfo
n d :: [PatchInfo]
d p :: Doc
p =
    ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
n
    Doc -> Doc -> Doc
$$ ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsVerbose [PatchInfo]
d
    Doc -> Doc -> Doc
$$ Doc
p

data ShowDepsFormat = ShowDepsVerbose | ShowDepsSummary
                        deriving (ShowDepsFormat -> ShowDepsFormat -> Bool
(ShowDepsFormat -> ShowDepsFormat -> Bool)
-> (ShowDepsFormat -> ShowDepsFormat -> Bool) -> Eq ShowDepsFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowDepsFormat -> ShowDepsFormat -> Bool
$c/= :: ShowDepsFormat -> ShowDepsFormat -> Bool
== :: ShowDepsFormat -> ShowDepsFormat -> Bool
$c== :: ShowDepsFormat -> ShowDepsFormat -> Bool
Eq)

showDependencies :: ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies :: ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies format :: ShowDepsFormat
format deps :: [PatchInfo]
deps = [Doc] -> Doc
vcat ((PatchInfo -> Doc) -> [PatchInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PatchInfo -> Doc
showDependency [PatchInfo]
deps)
                    where
                      showDependency :: PatchInfo -> Doc
showDependency d :: PatchInfo
d = Doc
mark
                                         Doc -> Doc -> Doc
<+> String -> Doc
cyanText "patch"
                                         Doc -> Doc -> Doc
<+> String -> Doc
cyanText (SHA1 -> String
forall a. Show a => a -> String
show (PatchInfo -> SHA1
makePatchname PatchInfo
d))
                                         Doc -> Doc -> Doc
$$ Doc
asterisk Doc -> Doc -> Doc
<+> String -> Doc
text (PatchInfo -> String
piName PatchInfo
d)
                      mark :: Doc
mark | ShowDepsFormat
format ShowDepsFormat -> ShowDepsFormat -> Bool
forall a. Eq a => a -> a -> Bool
== ShowDepsFormat
ShowDepsVerbose = String -> Doc
blueText "depend"
                           | Bool
otherwise = String -> Doc
text "D"
                      asterisk :: Doc
asterisk | ShowDepsFormat
format ShowDepsFormat -> ShowDepsFormat -> Bool
forall a. Eq a => a -> a -> Bool
== ShowDepsFormat
ShowDepsVerbose = String -> Doc
text "*"
                               | Bool
otherwise = String -> Doc
text "  *"

instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (Named p) where
    showPatch :: ShowPatchFor -> Named p wX wY -> Doc
showPatch f :: ShowPatchFor
f (NamedP n :: PatchInfo
n d :: [PatchInfo]
d p :: FL p wX wY
p) = ShowPatchFor -> PatchInfo -> [PatchInfo] -> Doc -> Doc
showNamedPrefix ShowPatchFor
f PatchInfo
n [PatchInfo]
d (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ ShowPatchFor -> FL p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f FL p wX wY
p

instance (Apply p, IsHunk p, PatchListFormat p,
          ShowContextPatch p) => ShowContextPatch (Named p) where
    showContextPatch :: ShowPatchFor -> Named p wX wY -> m Doc
showContextPatch f :: ShowPatchFor
f (NamedP n :: PatchInfo
n d :: [PatchInfo]
d p :: FL p wX wY
p) =
        ShowPatchFor -> PatchInfo -> [PatchInfo] -> Doc -> Doc
showNamedPrefix ShowPatchFor
f PatchInfo
n [PatchInfo]
d (Doc -> Doc) -> m Doc -> m Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShowPatchFor -> FL p wX wY -> m Doc
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(ShowContextPatch p, ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> p wX wY -> m Doc
showContextPatch ShowPatchFor
f FL p wX wY
p

instance (CommuteNoConflicts p, Conflict p, PatchListFormat p,
          PrimPatchBase p, ShowPatch p) => ShowPatch (Named p) where
    description :: Named p wX wY -> Doc
description (NamedP n :: PatchInfo
n _ _) = PatchInfo -> Doc
displayPatchInfo PatchInfo
n
    summary :: Named p wX wY -> Doc
summary p :: Named p wX wY
p@(NamedP _ ds :: [PatchInfo]
ds _) =
        let
            indent :: Doc -> Doc
indent = String -> Doc -> Doc
prefix "    "
            deps :: Doc
deps | [PatchInfo]
ds [PatchInfo] -> [PatchInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== []  = String -> Doc
text ""
                 | Bool
otherwise = String -> Doc
text ""
                               Doc -> Doc -> Doc
$$ Doc -> Doc
indent (ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsSummary [PatchInfo]
ds)
        in
            Named p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description Named p wX wY
p Doc -> Doc -> Doc
$$ Doc
deps Doc -> Doc -> Doc
$$ Doc -> Doc
indent (Named p wX wY -> Doc
forall (e :: * -> * -> *) wX wY.
(Conflict e, PrimPatchBase e) =>
e wX wY -> Doc
plainSummary Named p wX wY
p)
                                        -- this isn't summary because summary
                                        -- does the wrong thing with
                                        -- (Named (FL p)) so that it can get
                                        -- the summary of a sequence of named
                                        -- patches right.
    summaryFL :: FL (Named p) wX wY -> Doc
summaryFL = [Doc] -> Doc
vcat ([Doc] -> Doc)
-> (FL (Named p) wX wY -> [Doc]) -> FL (Named p) wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wX wY. Named p wX wY -> Doc) -> FL (Named p) wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wX wY. Named p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
summary
    showNicely :: Named p wX wY -> Doc
showNicely p :: Named p wX wY
p@(NamedP _ ds :: [PatchInfo]
ds pt :: FL p wX wY
pt) =
        let
            indent :: Doc -> Doc
indent = String -> Doc -> Doc
prefix "    "
            deps :: Doc
deps | [PatchInfo]
ds [PatchInfo] -> [PatchInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== []  = String -> Doc
text ""
                 | Bool
otherwise = String -> Doc
text ""
                               Doc -> Doc -> Doc
$$ Doc -> Doc
indent (ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsVerbose [PatchInfo]
ds)
        in
            Named p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description Named p wX wY
p Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
deps Doc -> Doc -> Doc
$$ Doc -> Doc
indent (FL p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
showNicely FL p wX wY
pt)

instance Show2 p => Show1 (Named p wX) where
    showDict1 :: ShowDict (Named p wX wX)
showDict1 = ShowDict (Named p wX wX)
forall a. Show a => ShowDict a
ShowDictClass

instance Show2 p => Show2 (Named p) where
    showDict2 :: ShowDict (Named p wX wY)
showDict2 = ShowDict (Named p wX wY)
forall a. Show a => ShowDict a
ShowDictClass

instance PatchDebug p => PatchDebug (Named p)