    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 changelog <- String -> Maybe Element
    forall s. XmlSource s => s -> Maybe Element
    parseXMLDoc String
    str
                           let 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
                           return $ map parseIntoRevision 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")