module Darcs.Patch.Show
( ShowPatchBasic(..), ShowPatch(..)
, showNamedPrefix
, writePatch, gzWritePatch
, formatFileName
)
where
import Prelude hiding ( pi )
import Darcs.Lock ( writeDocBinFile, gzWriteDocFile )
import Darcs.Patch.FileName ( FileName, fn2ps, encodeWhite, fn2fp )
import Darcs.Patch.Format ( FileNameFormat(..) )
import Darcs.Patch.Info ( PatchInfo, showPatchInfo )
import Darcs.Witnesses.Ordered ( FL )
import English ( plural, Noun(Noun) )
import Printer ( Doc, vcat, blueText, ($$), (<>), text, packedString )
import Darcs.Patch.ApplyMonad ( ApplyMonadTrans, ApplyMonad )
import Darcs.Patch.Apply ( ApplyState )
#include "gadts.h"
showNamedPrefix :: PatchInfo -> [PatchInfo] -> Doc
showNamedPrefix n d = showPatchInfo n
$$ blueText "<"
$$ vcat (map showPatchInfo d)
$$ blueText ">"
class ShowPatchBasic p where
showPatch :: p C(x y) -> Doc
class ShowPatchBasic p => ShowPatch p where
showNicely :: p C(x y) -> Doc
showNicely = showPatch
showContextPatch :: (Monad m, ApplyMonadTrans m (ApplyState p),
ApplyMonad m (ApplyState p))
=> p C(x y) -> m Doc
showContextPatch p = return $ showPatch p
description :: p C(x y) -> Doc
description = showPatch
summary :: p C(x y) -> Doc
summaryFL :: FL p C(x y) -> Doc
thing :: p C(x y) -> String
thing _ = "patch"
things :: p C(x y) -> String
things x = plural (Noun $ thing x) ""
writePatch :: ShowPatchBasic p => FilePath -> p C(x y) -> IO ()
writePatch f p = writeDocBinFile f $ showPatch p <> text "\n"
gzWritePatch :: ShowPatchBasic p => FilePath -> p C(x y) -> IO ()
gzWritePatch f p = gzWriteDocFile f $ showPatch p <> text "\n"
formatFileName :: FileNameFormat -> FileName -> Doc
formatFileName OldFormat = packedString . fn2ps
formatFileName NewFormat = text . encodeWhite . fn2fp