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 <- 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 forall a. Eq a => a -> a -> Bool
== String
"patch") Element
changelog
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ Element -> [Maybe Change]
changesXML Element
a }
where
date :: Element -> UTCTime
date = forall a. a -> Maybe a -> a
fromMaybe (POSIXTime -> UTCTime
posixSecondsToUTCTime forall a b. (a -> b) -> a -> b
$ forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int
0::Int)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%c" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
dateXML
authorXML, dateXML, descriptionXML, emailXML, hashXML :: Element -> String
authorXML :: Element -> String
authorXML = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Maybe String, String)
splitEmailAuthor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe 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" forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
emailXML :: Element -> String
emailXML = forall a. a -> Maybe a -> a
fromMaybe String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Maybe String, String)
splitEmailAuthor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe 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" forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
dateXML :: Element -> String
dateXML = forall a. a -> Maybe a -> a
fromMaybe 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" forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
hashXML :: Element -> String
hashXML = forall a. a -> Maybe a -> a
fromMaybe 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" forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
descriptionXML :: Element -> String
descriptionXML = forall a. a -> Maybe a -> a
fromMaybe String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> String
strContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Element -> Maybe Element
findChild (String -> Maybe String -> Maybe String -> QName
QName String
"name" forall a. Maybe a
Nothing 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 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" forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
analyze :: [Element] -> [Maybe Change]
analyze :: [Element] -> [Maybe Change]
analyze [Element]
s = forall a b. (a -> b) -> [a] -> [b]
map Element -> Maybe Change
convert [Element]
s
where convert :: Element -> Maybe Change
convert Element
a
| String
x forall a. Eq a => a -> a -> Bool
== String
"add_directory" Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"add_file" = forall a. a -> Maybe a
Just (String -> Change
Added String
b)
| String
x forall a. Eq a => a -> a -> Bool
== String
"remove_file" Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"remove_directory" = forall a. a -> Maybe a
Just (String -> Change
Deleted String
b)
| String
x forall a. Eq a => a -> a -> Bool
== String
"added_lines"
Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"modify_file"
Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"removed_lines"
Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"replaced_tokens"
Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"move" = forall a. a -> Maybe a
Just (String -> Change
Modified String
b)
| Bool
otherwise = forall a. Maybe a
Nothing
where x :: String
x = QName -> String
qName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
elName forall a b. (a -> b) -> a -> b
$ Element
a
b :: String
b = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'\n') forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace 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 forall a. Eq a => a -> a -> Bool
== String
"add_file"
Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"add_directory"
Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"remove_file"
Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"remove_directory"
Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"modify_file"
Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"added_lines"
Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"removed_lines"
Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"replaced_tokens"
Bool -> Bool -> Bool
|| String
x forall a. Eq a => a -> a -> Bool
== String
"move")