-- Copyright (C) 2002-2004 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.

{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-imports #-}

module Darcs.Patch.Viewing
    ( showContextHunk
    ) where

import Darcs.Prelude hiding ( readFile )

import Control.Applicative( (<$>) )
import qualified Data.ByteString as B ( null )
import Darcs.Util.Tree ( Tree )
import Darcs.Util.Tree.Monad ( virtualTreeMonad )

import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.ApplyMonad ( getApplyState,
                                ApplyMonad(..), ApplyMonadTree(..), toTree )
import Darcs.Patch.FileHunk ( IsHunk(..), FileHunk(..), showFileHunk )
import Darcs.Patch.Format ( PatchListFormat(..), ListFormat(..),
                            FileNameFormat(..) )
import Darcs.Patch.Show
    ( ShowPatchBasic(..), ShowPatch(..)
    , formatFileName, ShowPatchFor(..), ShowContextPatch(..) )
import Darcs.Patch.Witnesses.Ordered ( RL(..), FL(..), mapFL, mapFL_FL,
                                       reverseRL, concatFL )
import Darcs.Util.ByteString ( linesPS )
import Darcs.Util.Printer ( Doc, empty, vcat, text, blueText, Color(Cyan, Magenta),
                 lineColor, ($$), (<+>), prefix, userchunkPS )

showContextSeries :: forall p m wX wY . (Apply p, ShowContextPatch p, IsHunk p,
                                         ApplyMonad (ApplyState p) m)
                  => ShowPatchFor -> FileNameFormat -> FL p wX wY -> m Doc
showContextSeries :: ShowPatchFor -> FileNameFormat -> FL p wX wY -> m Doc
showContextSeries ShowPatchFor
use FileNameFormat
fmt = Maybe (FileHunk Any wX) -> FL p wX wY -> m Doc
forall wWw wXx wYy.
Maybe (FileHunk wWw wXx) -> FL p wXx wYy -> m Doc
scs Maybe (FileHunk Any wX)
forall a. Maybe a
Nothing
  where
    scs :: forall wWw wXx wYy . Maybe (FileHunk wWw wXx) -> FL p wXx wYy -> m Doc
    scs :: Maybe (FileHunk wWw wXx) -> FL p wXx wYy -> m Doc
scs Maybe (FileHunk wWw wXx)
pold (p wXx wY
p :>: FL p wY wYy
ps) = do
        (()
_, ApplyState p (ApplyMonadBase m)
s') <- m ()
-> ApplyState p (ApplyMonadBase m)
-> m ((), ApplyState p (ApplyMonadBase m))
forall (state :: (* -> *) -> *) (m :: * -> *) x.
ApplyMonad state m =>
m x -> state (ApplyMonadBase m) -> m (x, state (ApplyMonadBase m))
nestedApply (p wXx wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply p wXx wY
p) (ApplyState p (ApplyMonadBase m)
 -> m ((), ApplyState p (ApplyMonadBase m)))
-> m (ApplyState p (ApplyMonadBase m))
-> m ((), ApplyState p (ApplyMonadBase m))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (ApplyState p (ApplyMonadBase m))
forall (state :: (* -> *) -> *) (m :: * -> *).
ApplyMonad state m =>
m (state (ApplyMonadBase m))
getApplyState
        case p wXx wY -> Maybe (FileHunk wXx wY)
forall (p :: * -> * -> *) wX wY.
IsHunk p =>
p wX wY -> Maybe (FileHunk wX wY)
isHunk p wXx wY
p of
            Maybe (FileHunk wXx wY)
Nothing -> do
                Doc
a <- ShowPatchFor -> p wXx wY -> m Doc
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(ShowContextPatch p, ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> p wX wY -> m Doc
showContextPatch ShowPatchFor
use p wXx wY
p
                (Doc, ApplyState p (ApplyMonadBase m))
b <- m Doc
-> ApplyState p (ApplyMonadBase m)
-> m (Doc, ApplyState p (ApplyMonadBase m))
forall (state :: (* -> *) -> *) (m :: * -> *) x.
ApplyMonad state m =>
m x -> state (ApplyMonadBase m) -> m (x, state (ApplyMonadBase m))
nestedApply (Maybe (FileHunk Any wY) -> FL p wY wYy -> m Doc
forall wWw wXx wYy.
Maybe (FileHunk wWw wXx) -> FL p wXx wYy -> m Doc
scs Maybe (FileHunk Any wY)
forall a. Maybe a
Nothing FL p wY wYy
ps) ApplyState p (ApplyMonadBase m)
s'
                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
$ Doc
a Doc -> Doc -> Doc
$$ (Doc, ApplyState p (ApplyMonadBase m)) -> Doc
forall a b. (a, b) -> a
fst (Doc, ApplyState p (ApplyMonadBase m))
b
            Just FileHunk wXx wY
fh -> case FL p wY wYy
ps of
                FL p wY wYy
NilFL -> (Doc, ApplyState p (ApplyMonadBase m)) -> Doc
forall a b. (a, b) -> a
fst ((Doc, ApplyState p (ApplyMonadBase m)) -> Doc)
-> m (Doc, ApplyState p (ApplyMonadBase m)) -> m Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ApplyState p (ApplyMonadBase m) -> ApplyMonadBase m Doc)
-> ApplyState p (ApplyMonadBase m)
-> m (Doc, ApplyState p (ApplyMonadBase m))
forall (state :: (* -> *) -> *) (m :: * -> *) x.
ApplyMonad state m =>
(state (ApplyMonadBase m) -> ApplyMonadBase m x)
-> state (ApplyMonadBase m) -> m (x, state (ApplyMonadBase m))
liftApply (Maybe (FileHunk wWw wXx)
-> FileHunk wXx wY
-> Maybe (FileHunk wY Any)
-> ApplyState p (ApplyMonadBase m)
-> ApplyMonadBase m Doc
forall wA wB wC wD.
Maybe (FileHunk wA wB)
-> FileHunk wB wC
-> Maybe (FileHunk wC wD)
-> ApplyState p (ApplyMonadBase m)
-> ApplyMonadBase m Doc
cool Maybe (FileHunk wWw wXx)
pold FileHunk wXx wY
fh Maybe (FileHunk wY Any)
forall a. Maybe a
Nothing) ApplyState p (ApplyMonadBase m)
s'
                (p wY wY
p2 :>: FL p wY wYy
_) -> do
                    Doc
a <- (Doc, ApplyState p (ApplyMonadBase m)) -> Doc
forall a b. (a, b) -> a
fst ((Doc, ApplyState p (ApplyMonadBase m)) -> Doc)
-> m (Doc, ApplyState p (ApplyMonadBase m)) -> m Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ApplyState p (ApplyMonadBase m) -> ApplyMonadBase m Doc)
-> ApplyState p (ApplyMonadBase m)
-> m (Doc, ApplyState p (ApplyMonadBase m))
forall (state :: (* -> *) -> *) (m :: * -> *) x.
ApplyMonad state m =>
(state (ApplyMonadBase m) -> ApplyMonadBase m x)
-> state (ApplyMonadBase m) -> m (x, state (ApplyMonadBase m))
liftApply (Maybe (FileHunk wWw wXx)
-> FileHunk wXx wY
-> Maybe (FileHunk wY wY)
-> ApplyState p (ApplyMonadBase m)
-> ApplyMonadBase m Doc
forall wA wB wC wD.
Maybe (FileHunk wA wB)
-> FileHunk wB wC
-> Maybe (FileHunk wC wD)
-> ApplyState p (ApplyMonadBase m)
-> ApplyMonadBase m Doc
cool Maybe (FileHunk wWw wXx)
pold FileHunk wXx wY
fh (p wY wY -> Maybe (FileHunk wY wY)
forall (p :: * -> * -> *) wX wY.
IsHunk p =>
p wX wY -> Maybe (FileHunk wX wY)
isHunk p wY wY
p2)) ApplyState p (ApplyMonadBase m)
s'
                    (Doc, ApplyState p (ApplyMonadBase m))
b <- m Doc
-> ApplyState p (ApplyMonadBase m)
-> m (Doc, ApplyState p (ApplyMonadBase m))
forall (state :: (* -> *) -> *) (m :: * -> *) x.
ApplyMonad state m =>
m x -> state (ApplyMonadBase m) -> m (x, state (ApplyMonadBase m))
nestedApply (Maybe (FileHunk wXx wY) -> FL p wY wYy -> m Doc
forall wWw wXx wYy.
Maybe (FileHunk wWw wXx) -> FL p wXx wYy -> m Doc
scs (FileHunk wXx wY -> Maybe (FileHunk wXx wY)
forall a. a -> Maybe a
Just FileHunk wXx wY
fh) FL p wY wYy
ps) ApplyState p (ApplyMonadBase m)
s'
                    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
$ Doc
a Doc -> Doc -> Doc
$$ (Doc, ApplyState p (ApplyMonadBase m)) -> Doc
forall a b. (a, b) -> a
fst (Doc, ApplyState p (ApplyMonadBase m))
b
    scs Maybe (FileHunk wWw wXx)
_ FL p wXx wYy
NilFL = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
empty

    cool :: Maybe (FileHunk wA wB) -> FileHunk wB wC -> Maybe (FileHunk wC wD)
         -> (ApplyState p) (ApplyMonadBase m) -> (ApplyMonadBase m) Doc
    cool :: Maybe (FileHunk wA wB)
-> FileHunk wB wC
-> Maybe (FileHunk wC wD)
-> ApplyState p (ApplyMonadBase m)
-> ApplyMonadBase m Doc
cool Maybe (FileHunk wA wB)
pold FileHunk wB wC
fh Maybe (FileHunk wC wD)
ps ApplyState p (ApplyMonadBase m)
s =
        (Doc, Tree (ApplyMonadBase m)) -> Doc
forall a b. (a, b) -> a
fst ((Doc, Tree (ApplyMonadBase m)) -> Doc)
-> ApplyMonadBase m (Doc, Tree (ApplyMonadBase m))
-> ApplyMonadBase m Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeMonad (ApplyMonadBase m) Doc
-> Tree (ApplyMonadBase m)
-> ApplyMonadBase m (Doc, Tree (ApplyMonadBase m))
forall (m :: * -> *) a.
Monad m =>
TreeMonad m a -> Tree m -> m (a, Tree m)
virtualTreeMonad (FileNameFormat
-> Maybe (FileHunk wA wB)
-> FileHunk wB wC
-> Maybe (FileHunk wC wD)
-> TreeMonad (ApplyMonadBase m) Doc
forall (m :: * -> *) wA wB wC wD.
ApplyMonad Tree m =>
FileNameFormat
-> Maybe (FileHunk wA wB)
-> FileHunk wB wC
-> Maybe (FileHunk wC wD)
-> m Doc
coolContextHunk FileNameFormat
fmt Maybe (FileHunk wA wB)
pold FileHunk wB wC
fh Maybe (FileHunk wC wD)
ps) (ApplyState p (ApplyMonadBase m) -> Tree (ApplyMonadBase m)
forall (s :: (* -> *) -> *) (m :: * -> *).
ToTree s =>
s m -> Tree m
toTree ApplyState p (ApplyMonadBase m)
s)

showContextHunk :: (ApplyMonad Tree m) => FileNameFormat -> FileHunk wX wY -> m Doc
showContextHunk :: FileNameFormat -> FileHunk wX wY -> m Doc
showContextHunk FileNameFormat
fmt FileHunk wX wY
h = FileNameFormat
-> Maybe (FileHunk Any wX)
-> FileHunk wX wY
-> Maybe (FileHunk wY Any)
-> m Doc
forall (m :: * -> *) wA wB wC wD.
ApplyMonad Tree m =>
FileNameFormat
-> Maybe (FileHunk wA wB)
-> FileHunk wB wC
-> Maybe (FileHunk wC wD)
-> m Doc
coolContextHunk FileNameFormat
fmt Maybe (FileHunk Any wX)
forall a. Maybe a
Nothing FileHunk wX wY
h Maybe (FileHunk wY Any)
forall a. Maybe a
Nothing

coolContextHunk :: (ApplyMonad Tree m)
                => FileNameFormat
                -> Maybe (FileHunk wA wB) -> FileHunk wB wC
                -> Maybe (FileHunk wC wD) -> m Doc
coolContextHunk :: FileNameFormat
-> Maybe (FileHunk wA wB)
-> FileHunk wB wC
-> Maybe (FileHunk wC wD)
-> m Doc
coolContextHunk FileNameFormat
fmt Maybe (FileHunk wA wB)
prev fh :: FileHunk wB wC
fh@(FileHunk AnchoredPath
f Int
l [ByteString]
o [ByteString]
n) Maybe (FileHunk wC wD)
next = do
    Bool
have <- AnchoredPath -> m Bool
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m Bool
mDoesFileExist AnchoredPath
f
    Maybe ByteString
f_content <- if Bool
have then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> m ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` AnchoredPath -> m ByteString
forall (m :: * -> *).
ApplyMonadTree m =>
AnchoredPath -> m ByteString
mReadFilePS AnchoredPath
f else Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
    case ByteString -> [ByteString]
linesPS (ByteString -> [ByteString])
-> Maybe ByteString -> Maybe [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ByteString
f_content of
        -- FIXME This is a weird error...
        Maybe [ByteString]
Nothing -> 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
$ FileNameFormat -> FileHunk wB wC -> Doc
forall wX wY. FileNameFormat -> FileHunk wX wY -> Doc
showFileHunk FileNameFormat
fmt FileHunk wB wC
fh
        Just [ByteString]
ls ->
            let pre :: [ByteString]
pre = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
numpre ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numpre Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [ByteString]
ls
                cleanedls :: [ByteString]
cleanedls = case [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
ls of
                    (ByteString
x : [ByteString]
xs)
                        | ByteString -> Bool
B.null ByteString
x -> [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
xs
                    [ByteString]
_ -> [ByteString]
ls
                post :: [ByteString]
post = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
numpost ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+[ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
oInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [ByteString]
cleanedls in
            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
$
                String -> Doc
blueText String
"hunk" Doc -> Doc -> Doc
<+> FileNameFormat -> AnchoredPath -> Doc
formatFileName FileNameFormat
fmt AnchoredPath
f
                    Doc -> Doc -> Doc
<+> String -> Doc
text (Int -> String
forall a. Show a => a -> String
show Int
l)
                Doc -> Doc -> Doc
$$ String -> Doc -> Doc
prefix String
" " ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ByteString -> Doc) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Doc
userchunkPS [ByteString]
pre)
                Doc -> Doc -> Doc
$$ Color -> Doc -> Doc
lineColor Color
Magenta (String -> Doc -> Doc
prefix String
"-" ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ByteString -> Doc) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Doc
userchunkPS [ByteString]
o))
                Doc -> Doc -> Doc
$$ Color -> Doc -> Doc
lineColor Color
Cyan    (String -> Doc -> Doc
prefix String
"+" ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ByteString -> Doc) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Doc
userchunkPS [ByteString]
n))
                Doc -> Doc -> Doc
$$ String -> Doc -> Doc
prefix String
" " ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ByteString -> Doc) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Doc
userchunkPS [ByteString]
post)
  where
    numpre :: Int
numpre = case Maybe (FileHunk wA wB)
prev of
        Just (FileHunk AnchoredPath
f' Int
lprev [ByteString]
_ [ByteString]
nprev)
            | AnchoredPath
f' AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
f Bool -> Bool -> Bool
&& Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
lprev Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
nprev Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 Bool -> Bool -> Bool
&& Int
lprev Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l
            -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
lprev Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
nprev Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
        Maybe (FileHunk wA wB)
_ -> if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 then Int
3 else Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

    numpost :: Int
numpost = case Maybe (FileHunk wC wD)
next of
        Just (FileHunk AnchoredPath
f' Int
lnext [ByteString]
_ [ByteString]
_)
            | AnchoredPath
f' AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
f Bool -> Bool -> Bool
&& Int
lnext Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Bool -> Bool -> Bool
&& Int
lnext Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l
            -> Int
lnext Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
n)
        Maybe (FileHunk wC wD)
_ -> Int
3

instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (FL p) where
    showPatch :: ShowPatchFor -> FL p wX wY -> Doc
showPatch ShowPatchFor
ForDisplay = [Doc] -> Doc
vcat ([Doc] -> Doc) -> (FL p wX wY -> [Doc]) -> FL p wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. p wW wZ -> Doc) -> FL p wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ShowPatchFor -> p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForDisplay)
    showPatch ShowPatchFor
ForStorage = ListFormat p -> FL p wX wY -> Doc
forall wX wY. ListFormat p -> FL p wX wY -> Doc
showPatchInternal ListFormat p
forall (p :: * -> * -> *). PatchListFormat p => ListFormat p
patchListFormat
      where
        showPatchInternal :: ListFormat p -> FL p wX wY -> Doc
        showPatchInternal :: ListFormat p -> FL p wX wY -> Doc
showPatchInternal ListFormat p
ListFormatV1 (p wX wY
p :>: FL p wY wY
NilFL) = (ShowPatchFor -> p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage) p wX wY
p
        showPatchInternal ListFormat p
ListFormatV1 FL p wX wY
NilFL = String -> Doc
blueText String
"{" Doc -> Doc -> Doc
$$ String -> Doc
blueText String
"}"
        showPatchInternal ListFormat p
ListFormatV1 FL p wX wY
ps = String -> Doc
blueText String
"{"
                                            Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((forall wW wZ. p wW wZ -> Doc) -> FL p wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ShowPatchFor -> p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage) FL p wX wY
ps)
                                            Doc -> Doc -> Doc
$$ String -> Doc
blueText String
"}"
        showPatchInternal ListFormat p
ListFormatV2 FL p wX wY
ps = [Doc] -> Doc
vcat ((forall wW wZ. p wW wZ -> Doc) -> FL p wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ShowPatchFor -> p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage) FL p wX wY
ps)
        showPatchInternal ListFormat p
ListFormatDefault FL p wX wY
ps = [Doc] -> Doc
vcat ((forall wW wZ. p wW wZ -> Doc) -> FL p wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ShowPatchFor -> p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage) FL p wX wY
ps)
        showPatchInternal ListFormat p
ListFormatV3 FL p wX wY
ps = [Doc] -> Doc
vcat ((forall wW wZ. p wW wZ -> Doc) -> FL p wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ShowPatchFor -> p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage) FL p wX wY
ps)

instance (Apply p, IsHunk p, PatchListFormat p, ShowContextPatch p)
        => ShowContextPatch (FL p) where
    showContextPatch :: ShowPatchFor -> FL p wX wY -> m Doc
showContextPatch ShowPatchFor
ForDisplay = ShowPatchFor -> FileNameFormat -> FL p wX wY -> m Doc
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ShowContextPatch p, IsHunk p,
 ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> FileNameFormat -> FL p wX wY -> m Doc
showContextSeries ShowPatchFor
ForDisplay FileNameFormat
FileNameFormatDisplay
    showContextPatch ShowPatchFor
ForStorage = ListFormat p -> FL p wX wY -> m Doc
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (FL p)) m =>
ListFormat p -> FL p wX wY -> m Doc
showContextPatchInternal ListFormat p
forall (p :: * -> * -> *). PatchListFormat p => ListFormat p
patchListFormat
      where
        showContextPatchInternal :: (ApplyMonad (ApplyState (FL p)) m)
                                 => ListFormat p -> FL p wX wY -> m Doc
        showContextPatchInternal :: ListFormat p -> FL p wX wY -> m Doc
showContextPatchInternal ListFormat p
ListFormatV1 (p wX wY
p :>: FL p wY wY
NilFL) =
            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
ForStorage p wX wY
p
        showContextPatchInternal ListFormat p
ListFormatV1 FL p wX wY
NilFL =
            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
$ String -> Doc
blueText String
"{" Doc -> Doc -> Doc
$$ String -> Doc
blueText String
"}"
        showContextPatchInternal ListFormat p
ListFormatV1 FL p wX wY
ps = do
            Doc
x <- ShowPatchFor -> FileNameFormat -> FL p wX wY -> m Doc
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ShowContextPatch p, IsHunk p,
 ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> FileNameFormat -> FL p wX wY -> m Doc
showContextSeries ShowPatchFor
ForStorage FileNameFormat
FileNameFormatV1 FL p wX wY
ps
            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
$ String -> Doc
blueText String
"{" Doc -> Doc -> Doc
$$ Doc
x Doc -> Doc -> Doc
$$ String -> Doc
blueText String
"}"
        showContextPatchInternal ListFormat p
ListFormatV2 FL p wX wY
ps = ShowPatchFor -> FileNameFormat -> FL p wX wY -> m Doc
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ShowContextPatch p, IsHunk p,
 ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> FileNameFormat -> FL p wX wY -> m Doc
showContextSeries ShowPatchFor
ForStorage FileNameFormat
FileNameFormatV2 FL p wX wY
ps
        showContextPatchInternal ListFormat p
ListFormatDefault FL p wX wY
ps = ShowPatchFor -> FileNameFormat -> FL p wX wY -> m Doc
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ShowContextPatch p, IsHunk p,
 ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> FileNameFormat -> FL p wX wY -> m Doc
showContextSeries ShowPatchFor
ForStorage FileNameFormat
FileNameFormatV2 FL p wX wY
ps
        showContextPatchInternal ListFormat p
ListFormatV3 FL p wX wY
ps = 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 -> FL p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage FL p wX wY
ps

instance (PatchListFormat p, ShowPatch p) => ShowPatch (FL p) where
    content :: FL p wX wY -> Doc
content = [Doc] -> Doc
vcat ([Doc] -> Doc) -> (FL p wX wY -> [Doc]) -> FL p wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. p wW wZ -> Doc) -> FL p wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
content

    description :: FL p wX wY -> Doc
description = [Doc] -> Doc
vcat ([Doc] -> Doc) -> (FL p wX wY -> [Doc]) -> FL p wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. p wW wZ -> Doc) -> FL p wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description

    summary :: FL p wX wY -> Doc
summary = FL p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => FL p wX wY -> Doc
summaryFL

    summaryFL :: FL (FL p) wX wY -> Doc
summaryFL = FL p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => FL p wX wY -> Doc
summaryFL (FL p wX wY -> Doc)
-> (FL (FL p) wX wY -> FL p wX wY) -> FL (FL p) wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL (FL p) wX wY -> FL p wX wY
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL

    thing :: FL p wX wY -> String
thing FL p wX wY
x = p wX wY -> String
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> String
thing (FL p wX wY -> p wX wY
forall (a :: * -> * -> *) wX wY. FL a wX wY -> a wX wY
helperx FL p wX wY
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"
      where
        helperx :: FL a wX wY -> a wX wY
        helperx :: FL a wX wY -> a wX wY
helperx FL a wX wY
_ = a wX wY
forall a. HasCallStack => a
undefined

    things :: FL p wX wY -> String
things = FL p wX wY -> String
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> String
thing

instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (RL p) where
    showPatch :: ShowPatchFor -> RL p wX wY -> Doc
showPatch ShowPatchFor
f = ShowPatchFor -> FL p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f (FL p wX wY -> Doc)
-> (RL p wX wY -> FL p wX wY) -> RL p wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL p wX wY -> FL p wX wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL

instance (ShowContextPatch p, Apply p, IsHunk p, PatchListFormat p)
        => ShowContextPatch (RL p) where
    showContextPatch :: ShowPatchFor -> RL p wX wY -> m Doc
showContextPatch ShowPatchFor
use = 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
use (FL p wX wY -> m Doc)
-> (RL p wX wY -> FL p wX wY) -> RL p wX wY -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL p wX wY -> FL p wX wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL

instance (PatchListFormat p, ShowPatch p) => ShowPatch (RL p) where
    content :: RL p wX wY -> Doc
content = FL p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
content (FL p wX wY -> Doc)
-> (RL p wX wY -> FL p wX wY) -> RL p wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL p wX wY -> FL p wX wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL

    description :: RL p wX wY -> Doc
description = FL p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description (FL p wX wY -> Doc)
-> (RL p wX wY -> FL p wX wY) -> RL p wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL p wX wY -> FL p wX wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL

    summary :: RL p wX wY -> Doc
summary = FL p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
summary (FL p wX wY -> Doc)
-> (RL p wX wY -> FL p wX wY) -> RL p wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL p wX wY -> FL p wX wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL

    summaryFL :: FL (RL p) wX wY -> Doc
summaryFL = FL (FL p) wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => FL p wX wY -> Doc
summaryFL (FL (FL p) wX wY -> Doc)
-> (FL (RL p) wX wY -> FL (FL p) wX wY) -> FL (RL p) wX wY -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wY. RL p wW wY -> FL p wW wY)
-> FL (RL p) wX wY -> FL (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. RL p wW wY -> FL p wW wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL

    thing :: RL p wX wY -> String
thing = FL p wX wY -> String
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> String
thing (FL p wX wY -> String)
-> (RL p wX wY -> FL p wX wY) -> RL p wX wY -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL p wX wY -> FL p wX wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL

    things :: RL p wX wY -> String
things = FL p wX wY -> String
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> String
things (FL p wX wY -> String)
-> (RL p wX wY -> FL p wX wY) -> RL p wX wY -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL p wX wY -> FL p wX wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL