Support building with feed-1.0, while still supporting older versions.

This commit was sponsored by Jeff Goeke-Smith on Patreon.
This commit is contained in:
Joey Hess 2017-08-28 12:29:00 -04:00
parent 86ea64d70e
commit ee2f096e3b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 45 additions and 14 deletions

View file

@ -1,3 +1,9 @@
git-annex (6.20170819) UNRELEASED; urgency=medium
* Support building with feed-1.0, while still supporting older versions.
-- Joey Hess <id@joeyh.name> Mon, 28 Aug 2017 12:20:59 -0400
git-annex (6.20170818) unstable; urgency=high git-annex (6.20170818) unstable; urgency=high
* Security fix: Disallow hostname starting with a dash, which * Security fix: Disallow hostname starting with a dash, which

View file

@ -19,6 +19,9 @@ import Data.Time.Format
#if ! MIN_VERSION_time(1,5,0) #if ! MIN_VERSION_time(1,5,0)
import System.Locale import System.Locale
#endif #endif
#if MIN_VERSION_feed(1,0,0)
import qualified Data.Text as T
#endif
import Command import Command
import qualified Annex import qualified Annex
@ -136,11 +139,13 @@ findDownloads u = go =<< downloadFeed u
mk f i = case getItemEnclosure i of mk f i = case getItemEnclosure i of
Just (enclosureurl, _, _) -> return $ Just (enclosureurl, _, _) -> return $
Just $ ToDownload f u i $ Enclosure enclosureurl Just $ ToDownload f u i $ Enclosure $
fromFeed enclosureurl
Nothing -> mkquvi f i Nothing -> mkquvi f i
mkquvi f i = case getItemLink i of mkquvi f i = case getItemLink i of
Just link -> ifM (quviSupported link) Just link -> ifM (quviSupported $ fromFeed link)
( return $ Just $ ToDownload f u i $ QuviLink link ( return $ Just $ ToDownload f u i $ QuviLink $
fromFeed link
, return Nothing , return Nothing
) )
Nothing -> return Nothing Nothing -> return Nothing
@ -211,7 +216,8 @@ performDownload opts cache todownload = case location todownload of
| otherwise = a | otherwise = a
knownitemid = case getItemId (item todownload) of knownitemid = case getItemId (item todownload) of
Just (_, itemid) -> S.member itemid (knownitems cache) Just (_, itemid) ->
S.member (fromFeed itemid) (knownitems cache)
_ -> False _ -> False
rundownload url extension getter = do rundownload url extension getter = do
@ -276,7 +282,8 @@ feedFile tmpl i extension = Utility.Format.format tmpl $
Just (Just d) -> Just $ Just (Just d) -> Just $
formatTime defaultTimeLocale "%F" d formatTime defaultTimeLocale "%F" d
-- if date cannot be parsed, use the raw string -- if date cannot be parsed, use the raw string
_ -> replace "/" "-" <$> getItemPublishDateString itm _ -> replace "/" "-" . fromFeed
<$> getItemPublishDateString itm
extractMetaData :: ToDownload -> MetaData extractMetaData :: ToDownload -> MetaData
extractMetaData i = case getItemPublishDate (item i) :: Maybe (Maybe UTCTime) of extractMetaData i = case getItemPublishDate (item i) :: Maybe (Maybe UTCTime) of
@ -290,7 +297,7 @@ minimalMetaData :: ToDownload -> MetaData
minimalMetaData i = case getItemId (item i) of minimalMetaData i = case getItemId (item i) of
(Nothing) -> emptyMetaData (Nothing) -> emptyMetaData
(Just (_, itemid)) -> MetaData $ M.singleton itemIdField (Just (_, itemid)) -> MetaData $ M.singleton itemIdField
(S.singleton $ toMetaValue itemid) (S.singleton $ toMetaValue $ fromFeed itemid)
{- Extract fields from the feed and item, that are both used as metadata, {- Extract fields from the feed and item, that are both used as metadata,
- and to generate the filename. -} - and to generate the filename. -}
@ -300,18 +307,18 @@ extractFields i = map (uncurry extractField)
, ("itemtitle", [itemtitle]) , ("itemtitle", [itemtitle])
, ("feedauthor", [feedauthor]) , ("feedauthor", [feedauthor])
, ("itemauthor", [itemauthor]) , ("itemauthor", [itemauthor])
, ("itemsummary", [getItemSummary $ item i]) , ("itemsummary", [fromFeed <$> getItemSummary (item i)])
, ("itemdescription", [getItemDescription $ item i]) , ("itemdescription", [fromFeed <$> getItemDescription (item i)])
, ("itemrights", [getItemRights $ item i]) , ("itemrights", [fromFeed <$> getItemRights (item i)])
, ("itemid", [snd <$> getItemId (item i)]) , ("itemid", [fromFeed . snd <$> getItemId (item i)])
, ("title", [itemtitle, feedtitle]) , ("title", [itemtitle, feedtitle])
, ("author", [itemauthor, feedauthor]) , ("author", [itemauthor, feedauthor])
] ]
where where
feedtitle = Just $ getFeedTitle $ feed i feedtitle = Just $ fromFeed $ getFeedTitle $ feed i
itemtitle = getItemTitle $ item i itemtitle = fromFeed <$> getItemTitle (item i)
feedauthor = getFeedAuthor $ feed i feedauthor = fromFeed <$> getFeedAuthor (feed i)
itemauthor = getItemAuthor $ item i itemauthor = fromFeed <$> getItemAuthor (item i)
itemIdField :: MetaField itemIdField :: MetaField
itemIdField = mkMetaFieldUnchecked "itemid" itemIdField = mkMetaFieldUnchecked "itemid"
@ -359,3 +366,19 @@ clearFeedProblem url = void $ liftIO . tryIO . removeFile =<< feedState url
feedState :: URLString -> Annex FilePath feedState :: URLString -> Annex FilePath
feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing
#if MIN_VERSION_feed(1,0,0)
fromFeed :: T.Text -> String
fromFeed = T.unpack
#else
fromFeed :: String -> String
fromFeed = id
#endif
#if MIN_VERSION_feed(1,0,0)
toFeed :: String -> T.Text
toFeed = T.pack
#else
toFeed :: String -> String
toFeed = id
#endif

View file

@ -27,3 +27,5 @@ Please report any feedback / issues to the aforementioned PR thread
or here if that works for you. or here if that works for you.
-- Dmitry Dzhus -- Dmitry Dzhus
> [[fixed|done]] --[[Joey]]