module Darcs.Patch.Info
( PatchInfo(..)
, rawPatchInfo
, patchinfo
, addJunk
, replaceJunk
, makePatchname
, readPatchInfo
, justName
, justAuthor
, justLog
, displayPatchInfo
, toXml
, toXmlShort
, piDate
, piDateString
, piName
, piRename
, piAuthor
, piTag
, piLog
, showPatchInfo
, isTag
, escapeXML
, validDate
, validLog
, validAuthor
, validDatePS
, validLogPS
, validAuthorPS
) where
import Darcs.Prelude
import Data.Char ( isAscii )
import Crypto.Random ( seedNew, seedToInteger )
import Numeric ( showHex )
import Control.Monad ( when, unless, void )
import Darcs.Util.ByteString
( decodeLocale
, packStringToUTF8
, unlinesPS
, unpackPSFromUTF8
)
import qualified Darcs.Util.Parser as RM ( take )
import Darcs.Util.Parser as RM ( skipSpace, char,
takeTill, anyChar, Parser,
option,
takeTillChar,
linesStartingWithEndingWith)
import Darcs.Patch.Show ( ShowPatchFor(..) )
import qualified Data.ByteString as B (length, splitAt, null
,isPrefixOf, tail, concat
,empty, head, cons, append
,ByteString )
import qualified Data.ByteString.Char8 as BC
( index, head, notElem, all, unpack, pack )
import Data.List( isPrefixOf )
import Data.List.NonEmpty ( NonEmpty(..) )
import qualified Data.List.NonEmpty as NE
import Darcs.Util.Printer ( Doc, packedString,
empty, ($$), (<+>), vcat, text, cyanText, blueText, prefix )
import Darcs.Util.IsoDate ( readUTCDate )
import System.Time ( CalendarTime, calendarTimeToString, toClockTime,
toCalendarTime )
import System.IO.Unsafe ( unsafePerformIO )
import Darcs.Util.Hash ( sha1PS, SHA1 )
import Darcs.Util.Prompt ( promptYorn )
import Darcs.Test.TestOnly ( TestOnly )
data PatchInfo =
PatchInfo { PatchInfo -> ByteString
_piDate :: !B.ByteString
, PatchInfo -> ByteString
_piName :: !B.ByteString
, PatchInfo -> ByteString
_piAuthor :: !B.ByteString
, PatchInfo -> [ByteString]
_piLog :: ![B.ByteString]
, PatchInfo -> Bool
_piLegacyIsInverted :: !Bool
}
deriving (PatchInfo -> PatchInfo -> Bool
(PatchInfo -> PatchInfo -> Bool)
-> (PatchInfo -> PatchInfo -> Bool) -> Eq PatchInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PatchInfo -> PatchInfo -> Bool
== :: PatchInfo -> PatchInfo -> Bool
$c/= :: PatchInfo -> PatchInfo -> Bool
/= :: PatchInfo -> PatchInfo -> Bool
Eq,Eq PatchInfo
Eq PatchInfo =>
(PatchInfo -> PatchInfo -> Ordering)
-> (PatchInfo -> PatchInfo -> Bool)
-> (PatchInfo -> PatchInfo -> Bool)
-> (PatchInfo -> PatchInfo -> Bool)
-> (PatchInfo -> PatchInfo -> Bool)
-> (PatchInfo -> PatchInfo -> PatchInfo)
-> (PatchInfo -> PatchInfo -> PatchInfo)
-> Ord PatchInfo
PatchInfo -> PatchInfo -> Bool
PatchInfo -> PatchInfo -> Ordering
PatchInfo -> PatchInfo -> PatchInfo
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
$ccompare :: PatchInfo -> PatchInfo -> Ordering
compare :: PatchInfo -> PatchInfo -> Ordering
$c< :: PatchInfo -> PatchInfo -> Bool
< :: PatchInfo -> PatchInfo -> Bool
$c<= :: PatchInfo -> PatchInfo -> Bool
<= :: PatchInfo -> PatchInfo -> Bool
$c> :: PatchInfo -> PatchInfo -> Bool
> :: PatchInfo -> PatchInfo -> Bool
$c>= :: PatchInfo -> PatchInfo -> Bool
>= :: PatchInfo -> PatchInfo -> Bool
$cmax :: PatchInfo -> PatchInfo -> PatchInfo
max :: PatchInfo -> PatchInfo -> PatchInfo
$cmin :: PatchInfo -> PatchInfo -> PatchInfo
min :: PatchInfo -> PatchInfo -> PatchInfo
Ord,Int -> PatchInfo -> ShowS
[PatchInfo] -> ShowS
PatchInfo -> String
(Int -> PatchInfo -> ShowS)
-> (PatchInfo -> String)
-> ([PatchInfo] -> ShowS)
-> Show PatchInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatchInfo -> ShowS
showsPrec :: Int -> PatchInfo -> ShowS
$cshow :: PatchInfo -> String
show :: PatchInfo -> String
$cshowList :: [PatchInfo] -> ShowS
showList :: [PatchInfo] -> ShowS
Show)
validDate :: String -> Bool
validDate :: String -> Bool
validDate = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validCharForDate
validDatePS :: B.ByteString -> Bool
validDatePS :: ByteString -> Bool
validDatePS = (Char -> Bool) -> ByteString -> Bool
BC.all Char -> Bool
validCharForDate
validCharForDate :: Char -> Bool
validCharForDate :: Char -> Bool
validCharForDate Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']'
validLog :: String -> Bool
validLog :: String -> Bool
validLog = Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Char
'\n'
validLogPS :: B.ByteString -> Bool
validLogPS :: ByteString -> Bool
validLogPS = Char -> ByteString -> Bool
BC.notElem Char
'\n'
validAuthor :: String -> Bool
validAuthor :: String -> Bool
validAuthor = Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Char
'*'
validAuthorPS :: B.ByteString -> Bool
validAuthorPS :: ByteString -> Bool
validAuthorPS = Char -> ByteString -> Bool
BC.notElem Char
'*'
rawPatchInfo
:: TestOnly
=> String -> String -> String -> [String] -> Bool -> PatchInfo
rawPatchInfo :: TestOnly =>
String -> String -> String -> [String] -> Bool -> PatchInfo
rawPatchInfo = String -> String -> String -> [String] -> Bool -> PatchInfo
rawPatchInfoInternal
rawPatchInfoInternal :: String -> String -> String -> [String] -> Bool -> PatchInfo
rawPatchInfoInternal :: String -> String -> String -> [String] -> Bool -> PatchInfo
rawPatchInfoInternal String
date String
name String
author [String]
log Bool
inverted =
PatchInfo { _piDate :: ByteString
_piDate = String -> ByteString
BC.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
validateDate String
date
, _piName :: ByteString
_piName = String -> ByteString
packStringToUTF8 (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
validateName String
name
, _piAuthor :: ByteString
_piAuthor = String -> ByteString
packStringToUTF8 (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
validateAuthor String
author
, _piLog :: [ByteString]
_piLog = (String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ByteString
packStringToUTF8 (String -> ByteString) -> ShowS -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
validateLog) [String]
log
, _piLegacyIsInverted :: Bool
_piLegacyIsInverted = Bool
inverted
}
where
validateAuthor :: ShowS
validateAuthor = (String -> Bool) -> String -> ShowS
forall {a}. Show a => (a -> Bool) -> String -> a -> a
validate String -> Bool
validAuthor String
"author"
validateName :: ShowS
validateName = (String -> Bool) -> String -> ShowS
forall {a}. Show a => (a -> Bool) -> String -> a -> a
validate String -> Bool
validLog String
"patch name"
validateLog :: ShowS
validateLog = (String -> Bool) -> String -> ShowS
forall {a}. Show a => (a -> Bool) -> String -> a -> a
validate String -> Bool
validLog String
"log line"
validateDate :: ShowS
validateDate = (String -> Bool) -> String -> ShowS
forall {a}. Show a => (a -> Bool) -> String -> a -> a
validate String -> Bool
validDate String
"date"
validate :: (a -> Bool) -> String -> a -> a
validate a -> Bool
test String
meta a
x =
if a -> Bool
test a
x then a
x else String -> a
forall a. HasCallStack => String -> a
error ([String] -> String
unwords [String
"invalid",String
meta,a -> String
forall a. Show a => a -> String
show a
x])
patchinfo :: String -> String -> String -> [String] -> IO PatchInfo
patchinfo :: String -> String -> String -> [String] -> IO PatchInfo
patchinfo String
date String
name String
author [String]
log =
PatchInfo -> IO PatchInfo
addJunk (PatchInfo -> IO PatchInfo) -> PatchInfo -> IO PatchInfo
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> [String] -> Bool -> PatchInfo
rawPatchInfoInternal String
date String
name String
author [String]
log Bool
False
addJunk :: PatchInfo -> IO PatchInfo
addJunk :: PatchInfo -> IO PatchInfo
addJunk PatchInfo
pinf =
do Integer
x <- Seed -> Integer
seedToInteger (Seed -> Integer) -> IO Seed -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Seed
forall (randomly :: * -> *). MonadRandom randomly => randomly Seed
seedNew
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PatchInfo -> [ByteString]
_piLog PatchInfo
pinf [ByteString] -> [ByteString] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ByteString] -> [ByteString]
ignoreJunk (PatchInfo -> [ByteString]
_piLog PatchInfo
pinf)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Lines beginning with 'Ignore-this: ' " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"will not be shown when displaying a patch."
Bool
confirmed <- String -> IO Bool
promptYorn String
"Proceed? "
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
confirmed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"User cancelled because of Ignore-this."
PatchInfo -> IO PatchInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo -> IO PatchInfo) -> PatchInfo -> IO PatchInfo
forall a b. (a -> b) -> a -> b
$ PatchInfo
pinf { _piLog = BC.pack (NE.head ignored++showHex x ""):
_piLog pinf }
replaceJunk :: PatchInfo -> IO PatchInfo
replaceJunk :: PatchInfo -> IO PatchInfo
replaceJunk pi :: PatchInfo
pi@(PatchInfo {_piLog :: PatchInfo -> [ByteString]
_piLog=[ByteString]
log}) = PatchInfo -> IO PatchInfo
addJunk (PatchInfo -> IO PatchInfo) -> PatchInfo -> IO PatchInfo
forall a b. (a -> b) -> a -> b
$ PatchInfo
pi{_piLog = ignoreJunk log}
ignored :: NonEmpty String
ignored :: NonEmpty String
ignored = String
"Ignore-this: " String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| []
ignoreJunk :: [B.ByteString] -> [B.ByteString]
ignoreJunk :: [ByteString] -> [ByteString]
ignoreJunk = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter ByteString -> Bool
isnt_ignored
where isnt_ignored :: ByteString -> Bool
isnt_ignored ByteString
x = ByteString -> [ByteString] -> Bool
forall {t :: * -> *}.
Foldable t =>
ByteString -> t ByteString -> Bool
doesnt_start_with ByteString
x ((String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
BC.pack (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
ignored))
doesnt_start_with :: ByteString -> t ByteString -> Bool
doesnt_start_with ByteString
x t ByteString
ys = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> t ByteString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
x) t ByteString
ys
justName :: PatchInfo -> String
justName :: PatchInfo -> String
justName PatchInfo
pinf =
if PatchInfo -> Bool
_piLegacyIsInverted PatchInfo
pinf
then String
"UNDO: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nameString
else String
nameString
where nameString :: String
nameString = ByteString -> String
metadataToString (PatchInfo -> ByteString
_piName PatchInfo
pinf)
justAuthor :: PatchInfo -> String
justAuthor :: PatchInfo -> String
justAuthor = ByteString -> String
metadataToString (ByteString -> String)
-> (PatchInfo -> ByteString) -> PatchInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> ByteString
_piAuthor
justLog :: PatchInfo -> String
justLog :: PatchInfo -> String
justLog = [String] -> String
unlines ([String] -> String)
-> (PatchInfo -> [String]) -> PatchInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
BC.unpack ([ByteString] -> [String])
-> (PatchInfo -> [ByteString]) -> PatchInfo -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> [ByteString]
_piLog
displayPatchInfo :: PatchInfo -> Doc
displayPatchInfo :: PatchInfo -> Doc
displayPatchInfo PatchInfo
pi =
String -> Doc
cyanText String
"patch " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
cyanText (SHA1 -> String
forall a. Show a => a -> String
show (SHA1 -> String) -> SHA1 -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname PatchInfo
pi)
Doc -> Doc -> Doc
$$ String -> Doc
text String
"Author: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (PatchInfo -> String
piAuthor PatchInfo
pi)
Doc -> Doc -> Doc
$$ String -> Doc
text String
"Date: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (ByteString -> String
friendlyD (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> ByteString
_piDate PatchInfo
pi)
Doc -> Doc -> Doc
$$ String -> Doc
hfn (PatchInfo -> String
piName PatchInfo
pi)
Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Doc
text String
" " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>) (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text) (PatchInfo -> [String]
piLog PatchInfo
pi))
where hfn :: String -> Doc
hfn String
x = case PatchInfo -> Maybe String
piTag PatchInfo
pi of
Maybe String
Nothing -> Doc
inverted Doc -> Doc -> Doc
<+> String -> Doc
text String
x
Just String
t -> String -> Doc
text String
" tagged" Doc -> Doc -> Doc
<+> String -> Doc
text String
t
inverted :: Doc
inverted = if PatchInfo -> Bool
_piLegacyIsInverted PatchInfo
pi then String -> Doc
text String
" UNDO:" else String -> Doc
text String
" *"
piName :: PatchInfo -> String
piName :: PatchInfo -> String
piName = ByteString -> String
metadataToString (ByteString -> String)
-> (PatchInfo -> ByteString) -> PatchInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> ByteString
_piName
piRename :: PatchInfo -> String -> PatchInfo
piRename :: PatchInfo -> String -> PatchInfo
piRename PatchInfo
x String
n = PatchInfo
x { _piName = packStringToUTF8 n }
piAuthor :: PatchInfo -> String
piAuthor :: PatchInfo -> String
piAuthor = ByteString -> String
metadataToString (ByteString -> String)
-> (PatchInfo -> ByteString) -> PatchInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> ByteString
_piAuthor
isTag :: PatchInfo -> Bool
isTag :: PatchInfo -> Bool
isTag PatchInfo
pinfo = String
"TAG " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` PatchInfo -> String
justName PatchInfo
pinfo
readPatchDate :: B.ByteString -> CalendarTime
readPatchDate :: ByteString -> CalendarTime
readPatchDate = String -> CalendarTime
readUTCDate (String -> CalendarTime)
-> (ByteString -> String) -> ByteString -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BC.unpack
piDate :: PatchInfo -> CalendarTime
piDate :: PatchInfo -> CalendarTime
piDate = ByteString -> CalendarTime
readPatchDate (ByteString -> CalendarTime)
-> (PatchInfo -> ByteString) -> PatchInfo -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> ByteString
_piDate
piDateString :: PatchInfo -> String
piDateString :: PatchInfo -> String
piDateString = ByteString -> String
BC.unpack (ByteString -> String)
-> (PatchInfo -> ByteString) -> PatchInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> ByteString
_piDate
piLog :: PatchInfo -> [String]
piLog :: PatchInfo -> [String]
piLog = (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
metadataToString ([ByteString] -> [String])
-> (PatchInfo -> [ByteString]) -> PatchInfo -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
ignoreJunk ([ByteString] -> [ByteString])
-> (PatchInfo -> [ByteString]) -> PatchInfo -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> [ByteString]
_piLog
piTag :: PatchInfo -> Maybe String
piTag :: PatchInfo -> Maybe String
piTag PatchInfo
pinf =
if ByteString
l ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
t
then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
metadataToString ByteString
r
else Maybe String
forall a. Maybe a
Nothing
where (ByteString
l, ByteString
r) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (ByteString -> Int
B.length ByteString
t) (PatchInfo -> ByteString
_piName PatchInfo
pinf)
t :: ByteString
t = String -> ByteString
BC.pack String
"TAG "
metadataToString :: B.ByteString -> String
metadataToString :: ByteString -> String
metadataToString ByteString
bs | Char
'\xfffd' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
bsUtf8 = String
bsUtf8
| Bool
otherwise = ByteString -> String
decodeLocale ByteString
bs
where bsUtf8 :: String
bsUtf8 = ByteString -> String
unpackPSFromUTF8 ByteString
bs
friendlyD :: B.ByteString -> String
friendlyD :: ByteString -> String
friendlyD ByteString
d = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ do
CalendarTime
ct <- ClockTime -> IO CalendarTime
toCalendarTime (ClockTime -> IO CalendarTime) -> ClockTime -> IO CalendarTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> ClockTime
toClockTime (CalendarTime -> ClockTime) -> CalendarTime -> ClockTime
forall a b. (a -> b) -> a -> b
$ ByteString -> CalendarTime
readPatchDate ByteString
d
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> String
calendarTimeToString CalendarTime
ct
toXml :: PatchInfo -> Doc
toXml :: PatchInfo -> Doc
toXml = Bool -> PatchInfo -> Doc
toXml' Bool
True
toXmlShort :: PatchInfo -> Doc
toXmlShort :: PatchInfo -> Doc
toXmlShort = Bool -> PatchInfo -> Doc
toXml' Bool
False
toXml' :: Bool -> PatchInfo -> Doc
toXml' :: Bool -> PatchInfo -> Doc
toXml' Bool
includeComments PatchInfo
pi =
String -> Doc
text String
"<patch"
Doc -> Doc -> Doc
<+> String -> Doc
text String
"author='" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ByteString -> Doc
escapeXMLByteString (PatchInfo -> ByteString
_piAuthor PatchInfo
pi) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"'"
Doc -> Doc -> Doc
<+> String -> Doc
text String
"date='" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ByteString -> Doc
escapeXMLByteString (PatchInfo -> ByteString
_piDate PatchInfo
pi) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"'"
Doc -> Doc -> Doc
<+> String -> Doc
text String
"local_date='" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
escapeXML (ByteString -> String
friendlyD (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> ByteString
_piDate PatchInfo
pi) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"'"
Doc -> Doc -> Doc
<+> String -> Doc
text String
"inverted='" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (Bool -> String
forall a. Show a => a -> String
show (Bool -> String) -> Bool -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> Bool
_piLegacyIsInverted PatchInfo
pi) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"'"
Doc -> Doc -> Doc
<+> String -> Doc
text String
"hash='" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (SHA1 -> String
forall a. Show a => a -> String
show (SHA1 -> String) -> SHA1 -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname PatchInfo
pi) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"'>"
Doc -> Doc -> Doc
$$ Doc -> Doc
indent Doc
abstract
Doc -> Doc -> Doc
$$ String -> Doc
text String
"</patch>"
where
indent :: Doc -> Doc
indent = String -> Doc -> Doc
prefix String
" "
name :: Doc
name = String -> Doc
text String
"<name>" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ByteString -> Doc
escapeXMLByteString (PatchInfo -> ByteString
_piName PatchInfo
pi) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"</name>"
abstract :: Doc
abstract | Bool
includeComments = Doc
name Doc -> Doc -> Doc
$$ [ByteString] -> Doc
commentsAsXml (PatchInfo -> [ByteString]
_piLog PatchInfo
pi)
| Bool
otherwise = Doc
name
commentsAsXml :: [B.ByteString] -> Doc
[ByteString]
comments
| ByteString -> Int
B.length ByteString
comments' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = String -> Doc
text String
"<comment>"
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ByteString -> Doc
escapeXMLByteString ByteString
comments'
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"</comment>"
| Bool
otherwise = Doc
empty
where comments' :: ByteString
comments' = [ByteString] -> ByteString
unlinesPS [ByteString]
comments
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
"'" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> ShowS
strReplace Char
'"' String
""" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Char -> String -> ShowS
strReplace Char
'>' String
">" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> ShowS
strReplace Char
'<' String
"<" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> ShowS
strReplace Char
'&' String
"&"
escapeXMLByteString :: B.ByteString -> Doc
escapeXMLByteString :: ByteString -> Doc
escapeXMLByteString = ByteString -> Doc
packedString (ByteString -> Doc)
-> (ByteString -> ByteString) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> ByteString -> ByteString
bstrReplace Char
'\'' String
"'"
(ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> ByteString -> ByteString
bstrReplace Char
'"' String
"""
(ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> ByteString -> ByteString
bstrReplace Char
'>' String
">"
(ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> ByteString -> ByteString
bstrReplace Char
'<' String
"<"
(ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> ByteString -> ByteString
bstrReplace Char
'&' String
"&"
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
bstrReplace :: Char -> String -> B.ByteString -> B.ByteString
bstrReplace :: Char -> String -> ByteString -> ByteString
bstrReplace Char
c String
s ByteString
bs | ByteString -> Bool
B.null ByteString
bs = ByteString
B.empty
| Bool
otherwise = if ByteString -> Char
BC.head ByteString
bs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c
then ByteString -> ByteString -> ByteString
B.append (String -> ByteString
BC.pack String
s)
(Char -> String -> ByteString -> ByteString
bstrReplace Char
c String
s (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
bs))
else Word8 -> ByteString -> ByteString
B.cons (HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
bs)
(Char -> String -> ByteString -> ByteString
bstrReplace Char
c String
s (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
bs))
makePatchname :: PatchInfo -> SHA1
makePatchname :: PatchInfo -> SHA1
makePatchname PatchInfo
pi = ByteString -> SHA1
sha1PS ByteString
sha1_me
where b2ps :: Bool -> ByteString
b2ps Bool
True = String -> ByteString
BC.pack String
"t"
b2ps Bool
False = String -> ByteString
BC.pack String
"f"
sha1_me :: ByteString
sha1_me = [ByteString] -> ByteString
B.concat [PatchInfo -> ByteString
_piName PatchInfo
pi,
PatchInfo -> ByteString
_piAuthor PatchInfo
pi,
PatchInfo -> ByteString
_piDate PatchInfo
pi,
[ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ PatchInfo -> [ByteString]
_piLog PatchInfo
pi,
Bool -> ByteString
b2ps (Bool -> ByteString) -> Bool -> ByteString
forall a b. (a -> b) -> a -> b
$ PatchInfo -> Bool
_piLegacyIsInverted PatchInfo
pi]
showPatchInfo :: ShowPatchFor -> PatchInfo -> Doc
showPatchInfo :: ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
ForDisplay = PatchInfo -> Doc
displayPatchInfo
showPatchInfo ShowPatchFor
ForStorage = PatchInfo -> Doc
storePatchInfo
storePatchInfo :: PatchInfo -> Doc
storePatchInfo :: PatchInfo -> Doc
storePatchInfo PatchInfo
pi =
String -> Doc
blueText String
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ByteString -> Doc
packedString (PatchInfo -> ByteString
_piName PatchInfo
pi)
Doc -> Doc -> Doc
$$ ByteString -> Doc
packedString (PatchInfo -> ByteString
_piAuthor PatchInfo
pi) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
inverted Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ByteString -> Doc
packedString (PatchInfo -> ByteString
_piDate PatchInfo
pi)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> Doc
myunlines (PatchInfo -> [ByteString]
_piLog PatchInfo
pi) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
blueText String
"] "
where inverted :: String
inverted = if PatchInfo -> Bool
_piLegacyIsInverted PatchInfo
pi then String
"*-" else String
"**"
myunlines :: [ByteString] -> Doc
myunlines [] = Doc
empty
myunlines [ByteString]
xs =
(ByteString -> Doc -> Doc) -> Doc -> [ByteString] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ByteString
s -> ((String -> Doc
text String
"\n " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ByteString -> Doc
packedString ByteString
s) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>)) (String -> Doc
text String
"\n") [ByteString]
xs
readPatchInfo :: Parser PatchInfo
readPatchInfo :: Parser PatchInfo
readPatchInfo = do
Parser ()
skipSpace
Char -> Parser ()
char Char
'['
ByteString
name <- Char -> Parser ByteString
takeTillChar Char
'\n'
Char
_ <- Parser Char
anyChar
ByteString
author <- Char -> Parser ByteString
takeTillChar Char
'*'
ByteString
s2 <- Int -> Parser ByteString
RM.take Int
2
ByteString
ct <- (Char -> Bool) -> Parser ByteString
takeTill (\Char
c->Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
']'Bool -> Bool -> Bool
||Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n')
() -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () (Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser ()
char Char
'\n'))
[ByteString]
log <- Char -> Char -> Parser [ByteString]
linesStartingWithEndingWith Char
' ' Char
']'
PatchInfo -> Parser PatchInfo
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return PatchInfo { _piDate :: ByteString
_piDate = ByteString
ct
, _piName :: ByteString
_piName = ByteString
name
, _piAuthor :: ByteString
_piAuthor = ByteString
author
, _piLog :: [ByteString]
_piLog = [ByteString]
log
, _piLegacyIsInverted :: Bool
_piLegacyIsInverted = ByteString -> Int -> Char
BC.index ByteString
s2 Int
1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'*'
}