module Darcs.Patch.Summary
    ( plainSummary
    , plainSummaryFL
    , plainSummaryPrim
    , plainSummaryPrims
    , xmlSummary
    , Summary(..)
    , ConflictState(..)
    , IsConflictedPrim(..)
    , listConflictedFiles
    ) where

import Darcs.Prelude

import Data.List.Ordered ( nubSort )
import Data.Maybe ( catMaybes )

import Darcs.Patch.Format ( FileNameFormat(FileNameFormatDisplay) )
import Darcs.Patch.FromPrim ( PrimPatchBase(..) )
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.Prim ( PrimDetails(..) )
import Darcs.Patch.Show ( formatFileName )
import Darcs.Patch.SummaryData ( SummDetail(..), SummOp(..) )
import Darcs.Patch.Witnesses.Ordered ( FL, mapFL )
import Darcs.Patch.Witnesses.Show

import Darcs.Util.Path ( AnchoredPath, anchorPath )
import Darcs.Util.Printer
    ( Doc
    , ($$)
    , (<+>)
    , empty
    , minus
    , plus
    , text
    , vcat
    )

-- | This type tags a patch with a 'ConflictState' and also hides the context
-- witnesses (as in 'Sealed2'), so we can put them in a list.
data IsConflictedPrim prim where
    IsC :: !ConflictState -> !(prim wX wY) -> IsConflictedPrim prim
data ConflictState = Okay | Conflicted | Duplicated deriving ( ConflictState -> ConflictState -> Bool
(ConflictState -> ConflictState -> Bool)
-> (ConflictState -> ConflictState -> Bool) -> Eq ConflictState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConflictState -> ConflictState -> Bool
$c/= :: ConflictState -> ConflictState -> Bool
== :: ConflictState -> ConflictState -> Bool
$c== :: ConflictState -> ConflictState -> Bool
Eq, Eq ConflictState
Eq ConflictState
-> (ConflictState -> ConflictState -> Ordering)
-> (ConflictState -> ConflictState -> Bool)
-> (ConflictState -> ConflictState -> Bool)
-> (ConflictState -> ConflictState -> Bool)
-> (ConflictState -> ConflictState -> Bool)
-> (ConflictState -> ConflictState -> ConflictState)
-> (ConflictState -> ConflictState -> ConflictState)
-> Ord ConflictState
ConflictState -> ConflictState -> Bool
ConflictState -> ConflictState -> Ordering
ConflictState -> ConflictState -> ConflictState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConflictState -> ConflictState -> ConflictState
$cmin :: ConflictState -> ConflictState -> ConflictState
max :: ConflictState -> ConflictState -> ConflictState
$cmax :: ConflictState -> ConflictState -> ConflictState
>= :: ConflictState -> ConflictState -> Bool
$c>= :: ConflictState -> ConflictState -> Bool
> :: ConflictState -> ConflictState -> Bool
$c> :: ConflictState -> ConflictState -> Bool
<= :: ConflictState -> ConflictState -> Bool
$c<= :: ConflictState -> ConflictState -> Bool
< :: ConflictState -> ConflictState -> Bool
$c< :: ConflictState -> ConflictState -> Bool
compare :: ConflictState -> ConflictState -> Ordering
$ccompare :: ConflictState -> ConflictState -> Ordering
$cp1Ord :: Eq ConflictState
Ord, Int -> ConflictState -> ShowS
[ConflictState] -> ShowS
ConflictState -> String
(Int -> ConflictState -> ShowS)
-> (ConflictState -> String)
-> ([ConflictState] -> ShowS)
-> Show ConflictState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConflictState] -> ShowS
$cshowList :: [ConflictState] -> ShowS
show :: ConflictState -> String
$cshow :: ConflictState -> String
showsPrec :: Int -> ConflictState -> ShowS
$cshowsPrec :: Int -> ConflictState -> ShowS
Show, ReadPrec [ConflictState]
ReadPrec ConflictState
Int -> ReadS ConflictState
ReadS [ConflictState]
(Int -> ReadS ConflictState)
-> ReadS [ConflictState]
-> ReadPrec ConflictState
-> ReadPrec [ConflictState]
-> Read ConflictState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConflictState]
$creadListPrec :: ReadPrec [ConflictState]
readPrec :: ReadPrec ConflictState
$creadPrec :: ReadPrec ConflictState
readList :: ReadS [ConflictState]
$creadList :: ReadS [ConflictState]
readsPrec :: Int -> ReadS ConflictState
$creadsPrec :: Int -> ReadS ConflictState
Read)

class Summary p where
    conflictedEffect :: p wX wY -> [IsConflictedPrim (PrimOf p)]

instance Summary p => Summary (FL p) where
    conflictedEffect :: FL p wX wY -> [IsConflictedPrim (PrimOf (FL p))]
conflictedEffect = [[IsConflictedPrim (PrimOf p)]] -> [IsConflictedPrim (PrimOf p)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[IsConflictedPrim (PrimOf p)]] -> [IsConflictedPrim (PrimOf p)])
-> (FL p wX wY -> [[IsConflictedPrim (PrimOf p)]])
-> FL p wX wY
-> [IsConflictedPrim (PrimOf p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. p wW wZ -> [IsConflictedPrim (PrimOf p)])
-> FL p wX wY -> [[IsConflictedPrim (PrimOf p)]]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. p wW wZ -> [IsConflictedPrim (PrimOf p)]
forall (p :: * -> * -> *) wX wY.
Summary p =>
p wX wY -> [IsConflictedPrim (PrimOf p)]
conflictedEffect

instance Show2 prim => Show (IsConflictedPrim prim) where
    showsPrec :: Int -> IsConflictedPrim prim -> ShowS
showsPrec Int
d (IsC ConflictState
cs prim wX wY
prim) =
        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
"IsC " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ConflictState -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ConflictState
cs 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 -> prim 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) prim wX wY
prim

listConflictedFiles
  :: (Summary p, PatchInspect (PrimOf p)) => p wX wY -> [AnchoredPath]
listConflictedFiles :: p wX wY -> [AnchoredPath]
listConflictedFiles =
    [AnchoredPath] -> [AnchoredPath]
forall a. Ord a => [a] -> [a]
nubSort ([AnchoredPath] -> [AnchoredPath])
-> (p wX wY -> [AnchoredPath]) -> p wX wY -> [AnchoredPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[AnchoredPath]] -> [AnchoredPath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[AnchoredPath]] -> [AnchoredPath])
-> (p wX wY -> [[AnchoredPath]]) -> p wX wY -> [AnchoredPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [AnchoredPath]] -> [[AnchoredPath]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [AnchoredPath]] -> [[AnchoredPath]])
-> (p wX wY -> [Maybe [AnchoredPath]])
-> p wX wY
-> [[AnchoredPath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsConflictedPrim (PrimOf p) -> Maybe [AnchoredPath])
-> [IsConflictedPrim (PrimOf p)] -> [Maybe [AnchoredPath]]
forall a b. (a -> b) -> [a] -> [b]
map IsConflictedPrim (PrimOf p) -> Maybe [AnchoredPath]
forall (prim :: * -> * -> *).
PatchInspect prim =>
IsConflictedPrim prim -> Maybe [AnchoredPath]
conflictedFiles ([IsConflictedPrim (PrimOf p)] -> [Maybe [AnchoredPath]])
-> (p wX wY -> [IsConflictedPrim (PrimOf p)])
-> p wX wY
-> [Maybe [AnchoredPath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p wX wY -> [IsConflictedPrim (PrimOf p)]
forall (p :: * -> * -> *) wX wY.
Summary p =>
p wX wY -> [IsConflictedPrim (PrimOf p)]
conflictedEffect
  where
    conflictedFiles :: IsConflictedPrim prim -> Maybe [AnchoredPath]
conflictedFiles (IsC ConflictState
Conflicted prim wX wY
p) = [AnchoredPath] -> Maybe [AnchoredPath]
forall a. a -> Maybe a
Just (prim wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles prim wX wY
p)
    conflictedFiles IsConflictedPrim prim
_ = Maybe [AnchoredPath]
forall a. Maybe a
Nothing

plainSummaryPrim :: PrimDetails prim => prim wX wY -> Doc
plainSummaryPrim :: prim wX wY -> Doc
plainSummaryPrim = [Doc] -> Doc
vcat ([Doc] -> Doc) -> (prim wX wY -> [Doc]) -> prim wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SummChunk -> Doc) -> [SummChunk] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> SummChunk -> Doc
summChunkToLine Bool
False) ([SummChunk] -> [Doc])
-> (prim wX wY -> [SummChunk]) -> prim wX wY -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IsConflictedPrim prim] -> [SummChunk]
forall (p :: * -> * -> *).
PrimDetails p =>
[IsConflictedPrim p] -> [SummChunk]
genSummary ([IsConflictedPrim prim] -> [SummChunk])
-> (prim wX wY -> [IsConflictedPrim prim])
-> prim wX wY
-> [SummChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsConflictedPrim prim
-> [IsConflictedPrim prim] -> [IsConflictedPrim prim]
forall a. a -> [a] -> [a]
:[]) (IsConflictedPrim prim -> [IsConflictedPrim prim])
-> (prim wX wY -> IsConflictedPrim prim)
-> prim wX wY
-> [IsConflictedPrim prim]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConflictState -> prim wX wY -> IsConflictedPrim prim
forall (prim :: * -> * -> *) wX wY.
ConflictState -> prim wX wY -> IsConflictedPrim prim
IsC ConflictState
Okay

plainSummaryPrims :: PrimDetails prim => Bool -> FL prim wX wY -> Doc
plainSummaryPrims :: Bool -> FL prim wX wY -> Doc
plainSummaryPrims Bool
machineReadable =
 [Doc] -> Doc
vcat ([Doc] -> Doc) -> (FL prim wX wY -> [Doc]) -> FL prim wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SummChunk -> Doc) -> [SummChunk] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> SummChunk -> Doc
summChunkToLine Bool
machineReadable) ([SummChunk] -> [Doc])
-> (FL prim wX wY -> [SummChunk]) -> FL prim wX wY -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IsConflictedPrim prim] -> [SummChunk]
forall (p :: * -> * -> *).
PrimDetails p =>
[IsConflictedPrim p] -> [SummChunk]
genSummary ([IsConflictedPrim prim] -> [SummChunk])
-> (FL prim wX wY -> [IsConflictedPrim prim])
-> FL prim wX wY
-> [SummChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. prim wW wZ -> IsConflictedPrim prim)
-> FL prim wX wY -> [IsConflictedPrim prim]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ConflictState -> prim wW wZ -> IsConflictedPrim prim
forall (prim :: * -> * -> *) wX wY.
ConflictState -> prim wX wY -> IsConflictedPrim prim
IsC ConflictState
Okay)

plainSummary :: (Summary e, PrimDetails (PrimOf e)) => e wX wY -> Doc
plainSummary :: e wX wY -> Doc
plainSummary = [Doc] -> Doc
vcat ([Doc] -> Doc) -> (e wX wY -> [Doc]) -> e wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SummChunk -> Doc) -> [SummChunk] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> SummChunk -> Doc
summChunkToLine Bool
False) ([SummChunk] -> [Doc])
-> (e wX wY -> [SummChunk]) -> e wX wY -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IsConflictedPrim (PrimOf e)] -> [SummChunk]
forall (p :: * -> * -> *).
PrimDetails p =>
[IsConflictedPrim p] -> [SummChunk]
genSummary ([IsConflictedPrim (PrimOf e)] -> [SummChunk])
-> (e wX wY -> [IsConflictedPrim (PrimOf e)])
-> e wX wY
-> [SummChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e wX wY -> [IsConflictedPrim (PrimOf e)]
forall (p :: * -> * -> *) wX wY.
Summary p =>
p wX wY -> [IsConflictedPrim (PrimOf p)]
conflictedEffect

plainSummaryFL :: (Summary e, PrimDetails (PrimOf e)) => FL e wX wY -> Doc
plainSummaryFL :: FL e wX wY -> Doc
plainSummaryFL = [Doc] -> Doc
vcat ([Doc] -> Doc) -> (FL e wX wY -> [Doc]) -> FL e wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SummChunk -> Doc) -> [SummChunk] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> SummChunk -> Doc
summChunkToLine Bool
False) ([SummChunk] -> [Doc])
-> (FL e wX wY -> [SummChunk]) -> FL e wX wY -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IsConflictedPrim (PrimOf e)] -> [SummChunk]
forall (p :: * -> * -> *).
PrimDetails p =>
[IsConflictedPrim p] -> [SummChunk]
genSummary ([IsConflictedPrim (PrimOf e)] -> [SummChunk])
-> (FL e wX wY -> [IsConflictedPrim (PrimOf e)])
-> FL e wX wY
-> [SummChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[IsConflictedPrim (PrimOf e)]] -> [IsConflictedPrim (PrimOf e)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[IsConflictedPrim (PrimOf e)]] -> [IsConflictedPrim (PrimOf e)])
-> (FL e wX wY -> [[IsConflictedPrim (PrimOf e)]])
-> FL e wX wY
-> [IsConflictedPrim (PrimOf e)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. e wW wZ -> [IsConflictedPrim (PrimOf e)])
-> FL e wX wY -> [[IsConflictedPrim (PrimOf e)]]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. e wW wZ -> [IsConflictedPrim (PrimOf e)]
forall (p :: * -> * -> *) wX wY.
Summary p =>
p wX wY -> [IsConflictedPrim (PrimOf p)]
conflictedEffect

xmlSummary :: (Summary p, PrimDetails (PrimOf p)) => p wX wY -> Doc
xmlSummary :: p wX wY -> Doc
xmlSummary p wX wY
p = String -> Doc
text String
"<summary>"
             Doc -> Doc -> Doc
$$ ([Doc] -> Doc
vcat ([Doc] -> Doc) -> (p wX wY -> [Doc]) -> p wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SummChunk -> Doc) -> [SummChunk] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SummChunk -> Doc
summChunkToXML ([SummChunk] -> [Doc])
-> (p wX wY -> [SummChunk]) -> p wX wY -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IsConflictedPrim (PrimOf p)] -> [SummChunk]
forall (p :: * -> * -> *).
PrimDetails p =>
[IsConflictedPrim p] -> [SummChunk]
genSummary ([IsConflictedPrim (PrimOf p)] -> [SummChunk])
-> (p wX wY -> [IsConflictedPrim (PrimOf p)])
-> p wX wY
-> [SummChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p wX wY -> [IsConflictedPrim (PrimOf p)]
forall (p :: * -> * -> *) wX wY.
Summary p =>
p wX wY -> [IsConflictedPrim (PrimOf p)]
conflictedEffect (p wX wY -> Doc) -> p wX wY -> Doc
forall a b. (a -> b) -> a -> b
$ p wX wY
p)
             Doc -> Doc -> Doc
$$ String -> Doc
text String
"</summary>"

-- Yuck duplicated code below...
escapeXML :: String -> Doc
escapeXML :: String -> Doc
escapeXML = String -> Doc
text (String -> Doc) -> ShowS -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> ShowS
strReplace Char
'\'' String
"&apos;" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> ShowS
strReplace Char
'"' String
"&quot;" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Char -> String -> ShowS
strReplace Char
'>' String
"&gt;" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> ShowS
strReplace Char
'<' String
"&lt;" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> ShowS
strReplace Char
'&' String
"&amp;"

strReplace :: Char -> String -> String -> String
strReplace :: Char -> String -> ShowS
strReplace Char
_ String
_ [] = []
strReplace Char
x String
y (Char
z:String
zs)
  | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
z    = String
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String -> ShowS
strReplace Char
x String
y String
zs
  | Bool
otherwise = Char
z Char -> ShowS
forall a. a -> [a] -> [a]
: Char -> String -> ShowS
strReplace Char
x String
y String
zs
-- end yuck duplicated code.

-- | High-level representation of a piece of patch summary
data SummChunk = SummChunk SummDetail ConflictState
   deriving (Eq SummChunk
Eq SummChunk
-> (SummChunk -> SummChunk -> Ordering)
-> (SummChunk -> SummChunk -> Bool)
-> (SummChunk -> SummChunk -> Bool)
-> (SummChunk -> SummChunk -> Bool)
-> (SummChunk -> SummChunk -> Bool)
-> (SummChunk -> SummChunk -> SummChunk)
-> (SummChunk -> SummChunk -> SummChunk)
-> Ord SummChunk
SummChunk -> SummChunk -> Bool
SummChunk -> SummChunk -> Ordering
SummChunk -> SummChunk -> SummChunk
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SummChunk -> SummChunk -> SummChunk
$cmin :: SummChunk -> SummChunk -> SummChunk
max :: SummChunk -> SummChunk -> SummChunk
$cmax :: SummChunk -> SummChunk -> SummChunk
>= :: SummChunk -> SummChunk -> Bool
$c>= :: SummChunk -> SummChunk -> Bool
> :: SummChunk -> SummChunk -> Bool
$c> :: SummChunk -> SummChunk -> Bool
<= :: SummChunk -> SummChunk -> Bool
$c<= :: SummChunk -> SummChunk -> Bool
< :: SummChunk -> SummChunk -> Bool
$c< :: SummChunk -> SummChunk -> Bool
compare :: SummChunk -> SummChunk -> Ordering
$ccompare :: SummChunk -> SummChunk -> Ordering
$cp1Ord :: Eq SummChunk
Ord, SummChunk -> SummChunk -> Bool
(SummChunk -> SummChunk -> Bool)
-> (SummChunk -> SummChunk -> Bool) -> Eq SummChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SummChunk -> SummChunk -> Bool
$c/= :: SummChunk -> SummChunk -> Bool
== :: SummChunk -> SummChunk -> Bool
$c== :: SummChunk -> SummChunk -> Bool
Eq)

genSummary :: forall p . PrimDetails p => [IsConflictedPrim p] -> [SummChunk]
genSummary :: [IsConflictedPrim p] -> [SummChunk]
genSummary [IsConflictedPrim p]
p
    = [SummChunk] -> [SummChunk]
combine ([SummChunk] -> [SummChunk]) -> [SummChunk] -> [SummChunk]
forall a b. (a -> b) -> a -> b
$ (IsConflictedPrim p -> [SummChunk])
-> [IsConflictedPrim p] -> [SummChunk]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IsConflictedPrim p -> [SummChunk]
s2 [IsConflictedPrim p]
p
    where s2 :: IsConflictedPrim p -> [SummChunk]
          s2 :: IsConflictedPrim p -> [SummChunk]
s2 (IsC ConflictState
c p wX wY
x) = (SummDetail -> SummChunk) -> [SummDetail] -> [SummChunk]
forall a b. (a -> b) -> [a] -> [b]
map (SummDetail -> ConflictState -> SummChunk
`SummChunk` ConflictState
c) ([SummDetail] -> [SummChunk]) -> [SummDetail] -> [SummChunk]
forall a b. (a -> b) -> a -> b
$ p wX wY -> [SummDetail]
forall (prim :: * -> * -> *) wX wY.
PrimDetails prim =>
prim wX wY -> [SummDetail]
summarizePrim p wX wY
x
          combine :: [SummChunk] -> [SummChunk]
combine (x1 :: SummChunk
x1@(SummChunk SummDetail
d1 ConflictState
c1) : x2 :: SummChunk
x2@(SummChunk SummDetail
d2 ConflictState
c2) : [SummChunk]
ss)
              = case SummDetail -> SummDetail -> Maybe SummDetail
combineDetail SummDetail
d1 SummDetail
d2 of
                  Maybe SummDetail
Nothing -> SummChunk
x1 SummChunk -> [SummChunk] -> [SummChunk]
forall a. a -> [a] -> [a]
: [SummChunk] -> [SummChunk]
combine (SummChunk
x2SummChunk -> [SummChunk] -> [SummChunk]
forall a. a -> [a] -> [a]
:[SummChunk]
ss)
                  Just SummDetail
d3 -> [SummChunk] -> [SummChunk]
combine ([SummChunk] -> [SummChunk]) -> [SummChunk] -> [SummChunk]
forall a b. (a -> b) -> a -> b
$ SummDetail -> ConflictState -> SummChunk
SummChunk SummDetail
d3 (ConflictState -> ConflictState -> ConflictState
combineConflictStates ConflictState
c1 ConflictState
c2) SummChunk -> [SummChunk] -> [SummChunk]
forall a. a -> [a] -> [a]
: [SummChunk]
ss
          combine (SummChunk
x:[SummChunk]
ss) = SummChunk
x  SummChunk -> [SummChunk] -> [SummChunk]
forall a. a -> [a] -> [a]
: [SummChunk] -> [SummChunk]
combine [SummChunk]
ss
          combine [] = []
          --
          combineDetail :: SummDetail -> SummDetail -> Maybe SummDetail
combineDetail (SummFile SummOp
o1 AnchoredPath
f1 Int
r1 Int
a1 Int
x1) (SummFile SummOp
o2 AnchoredPath
f2 Int
r2 Int
a2 Int
x2) | AnchoredPath
f1 AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
f2 =
            do SummOp
o3 <- SummOp -> SummOp -> Maybe SummOp
combineOp SummOp
o1 SummOp
o2
               SummDetail -> Maybe SummDetail
forall (m :: * -> *) a. Monad m => a -> m a
return (SummDetail -> Maybe SummDetail) -> SummDetail -> Maybe SummDetail
forall a b. (a -> b) -> a -> b
$ SummOp -> AnchoredPath -> Int -> Int -> Int -> SummDetail
SummFile SummOp
o3 AnchoredPath
f1 (Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r2) (Int
a1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a2) (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x2)
          combineDetail SummDetail
_ SummDetail
_ = Maybe SummDetail
forall a. Maybe a
Nothing
          --
          combineConflictStates :: ConflictState -> ConflictState -> ConflictState
combineConflictStates ConflictState
Conflicted ConflictState
_ = ConflictState
Conflicted
          combineConflictStates ConflictState
_ ConflictState
Conflicted = ConflictState
Conflicted
          combineConflictStates ConflictState
Duplicated ConflictState
_ = ConflictState
Duplicated
          combineConflictStates ConflictState
_ ConflictState
Duplicated = ConflictState
Duplicated
          combineConflictStates ConflictState
Okay ConflictState
Okay = ConflictState
Okay
          -- Don't combine AddFile and RmFile: (maybe an old revision of) darcs
          -- allows a single patch to add and remove the same file, see issue 185
          combineOp :: SummOp -> SummOp -> Maybe SummOp
combineOp SummOp
SummAdd SummOp
SummRm  = Maybe SummOp
forall a. Maybe a
Nothing
          combineOp SummOp
SummRm  SummOp
SummAdd = Maybe SummOp
forall a. Maybe a
Nothing
          combineOp SummOp
SummAdd SummOp
_ = SummOp -> Maybe SummOp
forall a. a -> Maybe a
Just SummOp
SummAdd
          combineOp SummOp
_ SummOp
SummAdd = SummOp -> Maybe SummOp
forall a. a -> Maybe a
Just SummOp
SummAdd
          combineOp SummOp
SummRm  SummOp
_ = SummOp -> Maybe SummOp
forall a. a -> Maybe a
Just SummOp
SummRm
          combineOp SummOp
_ SummOp
SummRm  = SummOp -> Maybe SummOp
forall a. a -> Maybe a
Just SummOp
SummRm
          combineOp SummOp
SummMod SummOp
SummMod = SummOp -> Maybe SummOp
forall a. a -> Maybe a
Just SummOp
SummMod

summChunkToXML :: SummChunk -> Doc
summChunkToXML :: SummChunk -> Doc
summChunkToXML (SummChunk SummDetail
detail ConflictState
c) =
 case SummDetail
detail of
   SummRmDir AnchoredPath
f  -> ConflictState -> String -> Doc -> Doc
xconf ConflictState
c String
"remove_directory" (AnchoredPath -> Doc
xfn AnchoredPath
f)
   SummAddDir AnchoredPath
f -> ConflictState -> String -> Doc -> Doc
xconf ConflictState
c String
"add_directory"    (AnchoredPath -> Doc
xfn AnchoredPath
f)
   SummFile SummOp
SummRm  AnchoredPath
f Int
_ Int
_ Int
_ -> ConflictState -> String -> Doc -> Doc
xconf ConflictState
c String
"remove_file" (AnchoredPath -> Doc
xfn AnchoredPath
f)
   SummFile SummOp
SummAdd AnchoredPath
f Int
_ Int
_ Int
_ -> ConflictState -> String -> Doc -> Doc
xconf ConflictState
c String
"add_file"    (AnchoredPath -> Doc
xfn AnchoredPath
f)
   SummFile SummOp
SummMod AnchoredPath
f Int
r Int
a Int
x -> ConflictState -> String -> Doc -> Doc
xconf ConflictState
c String
"modify_file" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> Doc
xfn AnchoredPath
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
forall a. (Eq a, Num a, Show a) => a -> Doc
xrm Int
r Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
forall a. (Eq a, Num a, Show a) => a -> Doc
xad Int
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
forall a. (Eq a, Num a, Show a) => a -> Doc
xrp Int
x
   SummMv AnchoredPath
f1 AnchoredPath
f2  -> String -> Doc
text String
"<move from=\"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> AnchoredPath -> Doc
xfn AnchoredPath
f1
                      Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"\" to=\"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> AnchoredPath -> Doc
xfn AnchoredPath
f2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
textString
"\"/>"
   SummDetail
SummNone      -> Doc
empty
 where
   xconf :: ConflictState -> String -> Doc -> Doc
xconf ConflictState
Okay String
t Doc
x       = String -> Doc
text (Char
'<'Char -> ShowS
forall a. a -> [a] -> [a]
:String
tString -> ShowS
forall a. [a] -> [a] -> [a]
++String
">") Doc -> Doc -> Doc
$$ Doc
x Doc -> Doc -> Doc
$$ String -> Doc
text (String
"</"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
tString -> ShowS
forall a. [a] -> [a] -> [a]
++String
">")
   xconf ConflictState
Conflicted String
t Doc
x = String -> Doc
text (Char
'<'Char -> ShowS
forall a. a -> [a] -> [a]
:String
tString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" conflict='true'>") Doc -> Doc -> Doc
$$ Doc
x Doc -> Doc -> Doc
$$ String -> Doc
text (String
"</"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
tString -> ShowS
forall a. [a] -> [a] -> [a]
++String
">")
   xconf ConflictState
Duplicated String
t Doc
x = String -> Doc
text (Char
'<'Char -> ShowS
forall a. a -> [a] -> [a]
:String
tString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" duplicate='true'>") Doc -> Doc -> Doc
$$ Doc
x Doc -> Doc -> Doc
$$ String -> Doc
text (String
"</"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
tString -> ShowS
forall a. [a] -> [a] -> [a]
++String
">")
   xfn :: AnchoredPath -> Doc
xfn = String -> Doc
escapeXML (String -> Doc) -> (AnchoredPath -> String) -> AnchoredPath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AnchoredPath -> String
anchorPath String
""
   --
   xad :: a -> Doc
xad a
0 = Doc
empty
   xad a
a = String -> Doc
text String
"<added_lines num='" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (a -> String
forall a. Show a => a -> String
show a
a) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"'/>"
   xrm :: a -> Doc
xrm a
0 = Doc
empty
   xrm a
a = String -> Doc
text String
"<removed_lines num='" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (a -> String
forall a. Show a => a -> String
show a
a) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"'/>"
   xrp :: a -> Doc
xrp a
0 = Doc
empty
   xrp a
a = String -> Doc
text String
"<replaced_tokens num='" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (a -> String
forall a. Show a => a -> String
show a
a) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"'/>"

summChunkToLine :: Bool -> SummChunk -> Doc
summChunkToLine :: Bool -> SummChunk -> Doc
summChunkToLine Bool
machineReadable (SummChunk SummDetail
detail ConflictState
c) =
  case SummDetail
detail of
   SummRmDir AnchoredPath
f   -> ConflictState -> String -> Doc -> Doc
lconf ConflictState
c String
"R" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
FileNameFormatDisplay AnchoredPath
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"/"
   SummAddDir AnchoredPath
f  -> ConflictState -> String -> Doc -> Doc
lconf ConflictState
c String
"A" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
FileNameFormatDisplay AnchoredPath
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"/"
   SummFile SummOp
SummRm  AnchoredPath
f Int
_ Int
_ Int
_ -> ConflictState -> String -> Doc -> Doc
lconf ConflictState
c String
"R" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
FileNameFormatDisplay AnchoredPath
f
   SummFile SummOp
SummAdd AnchoredPath
f Int
_ Int
_ Int
_ -> ConflictState -> String -> Doc -> Doc
lconf ConflictState
c String
"A" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
FileNameFormatDisplay AnchoredPath
f
   SummFile SummOp
SummMod AnchoredPath
f Int
r Int
a Int
x
     | Bool
machineReadable -> ConflictState -> String -> Doc -> Doc
lconf ConflictState
c String
"M" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
FileNameFormatDisplay AnchoredPath
f
     | Bool
otherwise       -> ConflictState -> String -> Doc -> Doc
lconf ConflictState
c String
"M" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
FileNameFormatDisplay AnchoredPath
f Doc -> Doc -> Doc
<+> Int -> Doc
forall a. (Eq a, Num a, Show a) => a -> Doc
rm Int
r Doc -> Doc -> Doc
<+> Int -> Doc
forall a. (Eq a, Num a, Show a) => a -> Doc
ad Int
a Doc -> Doc -> Doc
<+> Int -> Doc
forall a. (Eq a, Num a, Show a) => a -> Doc
rp Int
x
   SummMv AnchoredPath
f1 AnchoredPath
f2
     | Bool
machineReadable -> String -> Doc
text String
"F " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
FileNameFormatDisplay AnchoredPath
f1
                       Doc -> Doc -> Doc
$$ String -> Doc
text String
"T " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
FileNameFormatDisplay AnchoredPath
f2
     | Bool
otherwise       -> String -> Doc
text String
" "    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
FileNameFormatDisplay AnchoredPath
f1
                       Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" -> " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
FileNameFormatDisplay AnchoredPath
f2
   SummDetail
SummNone -> case ConflictState
c of
               ConflictState
Okay -> Doc
empty
               ConflictState
_    -> ConflictState -> String -> Doc -> Doc
lconf ConflictState
c String
""  Doc
empty
  where
   lconf :: ConflictState -> String -> Doc -> Doc
lconf ConflictState
Okay       String
t Doc
x = String -> Doc
text String
t Doc -> Doc -> Doc
<+> Doc
x
   lconf ConflictState
Conflicted String
t Doc
x = String -> Doc
text (String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"!") Doc -> Doc -> Doc
<+> Doc
x
   lconf ConflictState
Duplicated String
t Doc
x
     | Bool
machineReadable = String -> Doc
text String
t Doc -> Doc -> Doc
<+> Doc
x
     | Bool
otherwise       = String -> Doc
text String
t Doc -> Doc -> Doc
<+> Doc
x Doc -> Doc -> Doc
<+> String -> Doc
text String
"duplicate"
   --
   ad :: a -> Doc
ad a
0 = Doc
empty
   ad a
a = Doc
plus Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (a -> String
forall a. Show a => a -> String
show a
a)
   rm :: a -> Doc
rm a
0 = Doc
empty
   rm a
a = Doc
minus Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (a -> String
forall a. Show a => a -> String
show a
a)
   rp :: a -> Doc
rp a
0 = Doc
empty
   rp a
a = String -> Doc
text String
"r" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (a -> String
forall a. Show a => a -> String
show a
a)