module Data.FileStore.DarcsXml (parseDarcsXML) where
import Data.Maybe (catMaybes, fromMaybe)
import Data.Char (isSpace)
import Data.Time.Format (parseTimeM)
import Data.FileStore.Compat.Locale (defaultTimeLocale)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Text.XML.Light
import Data.FileStore.Types (Change(..), Revision(..), Author(..))
import Data.FileStore.Utils (splitEmailAuthor)
parseDarcsXML :: String -> Maybe [Revision]
parseDarcsXML :: String -> Maybe [Revision]
parseDarcsXML String
str = do Element
changelog <- String -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc String
str
let patches :: [Element]
patches = (QName -> Bool) -> Element -> [Element]
filterChildrenName (\(QName String
n Maybe String
_ Maybe String
_) -> String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"patch") Element
changelog
[Revision] -> Maybe [Revision]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Revision] -> Maybe [Revision]) -> [Revision] -> Maybe [Revision]
forall a b. (a -> b) -> a -> b
$ (Element -> Revision) -> [Element] -> [Revision]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Revision
parseIntoRevision [Element]
patches
parseIntoRevision :: Element -> Revision
parseIntoRevision :: Element -> Revision
parseIntoRevision Element
a = Revision { revId :: String
revId = Element -> String
hashXML Element
a,
revDateTime :: UTCTime
revDateTime = Element -> UTCTime
date Element
a,
revAuthor :: Author
revAuthor = Author { authorName :: String
authorName=Element -> String
authorXML Element
a, authorEmail :: String
authorEmail=Element -> String
emailXML Element
a },
revDescription :: String
revDescription = Element -> String
descriptionXML Element
a,
revChanges :: [Change]
revChanges = [Maybe Change] -> [Change]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Change] -> [Change]) -> [Maybe Change] -> [Change]
forall a b. (a -> b) -> a -> b
$ Element -> [Maybe Change]
changesXML Element
a }
where
date :: Element -> UTCTime
date = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe (POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Int -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int
0::Int)) (Maybe UTCTime -> UTCTime)
-> (Element -> Maybe UTCTime) -> Element -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%c" (String -> Maybe UTCTime)
-> (Element -> String) -> Element -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
dateXML
authorXML, dateXML, descriptionXML, emailXML, hashXML :: Element -> String
authorXML :: Element -> String
authorXML = (Maybe String, String) -> String
forall a b. (a, b) -> b
snd ((Maybe String, String) -> String)
-> (Element -> (Maybe String, String)) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Maybe String, String)
splitEmailAuthor (String -> (Maybe String, String))
-> (Element -> String) -> Element -> (Maybe String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Element -> Maybe String) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"author" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
emailXML :: Element -> String
emailXML = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Element -> Maybe String) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String, String) -> Maybe String
forall a b. (a, b) -> a
fst ((Maybe String, String) -> Maybe String)
-> (Element -> (Maybe String, String)) -> Element -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Maybe String, String)
splitEmailAuthor (String -> (Maybe String, String))
-> (Element -> String) -> Element -> (Maybe String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Element -> Maybe String) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"author" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
dateXML :: Element -> String
dateXML = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Element -> Maybe String) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"local_date" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
hashXML :: Element -> String
hashXML = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Element -> Maybe String) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"hash" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
descriptionXML :: Element -> String
descriptionXML = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Element -> Maybe String) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> String) -> Maybe Element -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> String
strContent (Maybe Element -> Maybe String)
-> (Element -> Maybe Element) -> Element -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Element -> Maybe Element
findChild (String -> Maybe String -> Maybe String -> QName
QName String
"name" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
changesXML :: Element -> [Maybe Change]
changesXML :: Element -> [Maybe Change]
changesXML Element
a = case (Element -> Maybe Element
changes Element
a) of
Just Element
b -> [Element] -> [Maybe Change]
analyze ([Element] -> [Maybe Change]) -> [Element] -> [Maybe Change]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
filterSummary Element
b
Maybe Element
Nothing -> []
changes :: Element -> Maybe Element
changes :: Element -> Maybe Element
changes = QName -> Element -> Maybe Element
findElement (String -> Maybe String -> Maybe String -> QName
QName String
"summary" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
analyze :: [Element] -> [Maybe Change]
analyze :: [Element] -> [Maybe Change]
analyze [Element]
s = (Element -> Maybe Change) -> [Element] -> [Maybe Change]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Maybe Change
convert [Element]
s
where convert :: Element -> Maybe Change
convert Element
a
| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"add_directory" Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"add_file" = Change -> Maybe Change
forall a. a -> Maybe a
Just (String -> Change
Added String
b)
| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"remove_file" Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"remove_directory" = Change -> Maybe Change
forall a. a -> Maybe a
Just (String -> Change
Deleted String
b)
| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"added_lines"
Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"modify_file"
Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"removed_lines"
Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"replaced_tokens"
Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"move" = Change -> Maybe Change
forall a. a -> Maybe a
Just (String -> Change
Modified String
b)
| Bool
otherwise = Maybe Change
forall a. Maybe a
Nothing
where x :: String
x = QName -> String
qName (QName -> String) -> (Element -> QName) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
elName (Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$ Element
a
b :: String
b = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
a
filterSummary :: Element -> [Element]
filterSummary :: Element -> [Element]
filterSummary = (QName -> Bool) -> Element -> [Element]
filterElementsName (\(QName {qName :: QName -> String
qName = String
x}) -> String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"add_file"
Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"add_directory"
Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"remove_file"
Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"remove_directory"
Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"modify_file"
Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"added_lines"
Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"removed_lines"
Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"replaced_tokens"
Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"move")