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)

-- | Take a String presumed to be a Darcs-generated changelog in XML format;
--   discard all tags, initializations, etc, leaving only actual patches;
--   then convert each patch entry into FileStore's homebrew 'Revision' type.
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
        -- If we can't get a date from the XML, we default to the beginning of the POSIX era.
        -- This at least makes it easy for someone to filter out bad dates, as obviously no real DVCSs
        -- were in operation then. :)
        -- date :: Element -> UTCTime
        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)

-- Perhaps there was no '--summary' option used, in which case there is no 'Change' information we
-- can extract.
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 -> []

-- | Extract the file-modification fields
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")