mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

refactoring

Browse source
This commit is contained in:
Joey Hess 2021-04-23 11:44:10 -04:00
parent 657d55c401
commit b689f17062
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 25 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

15
Command/ImportFeed.hs
View file

@ -1,6 +1,6 @@
{- git-annex command {- git-annex command
- -
- Copyright 2013-2020 Joey Hess <id@joeyh.name> - Copyright 2013-2021 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -139,7 +139,7 @@ knownItems = do
config <- Annex.getGitConfig config <- Annex.getGitConfig
catObjectStream g $ \catfeeder catcloser catreader -> do catObjectStream g $ \catfeeder catcloser catreader -> do
rt <- liftIO $ async $ reader catreader [] rt <- liftIO $ async $ reader catreader []
withKnownUrls (feeder config catfeeder catcloser) overKnownUrls (feeder config catfeeder catcloser)
liftIO (wait rt) liftIO (wait rt)
where where
feeder config catfeeder catcloser urlreader = urlreader >>= \case feeder config catfeeder catcloser urlreader = urlreader >>= \case
@ -161,6 +161,17 @@ knownItems = do
Just (u, Nothing) -> reader catreader (([],u):c) Just (u, Nothing) -> reader catreader (([],u):c)
Nothing -> return c Nothing -> return c
overKnownUrls :: (Annex (Maybe (Key, [URLString])) -> Annex a) -> Annex a
overKnownUrls a = Annex.Branch.overBranchFileContents urlLogFileKey (a . go)
where
go reader = reader >>= \case
Just (k, _, Just content) ->
case parseUrlLog content of
[] -> go reader
us -> return (Just (k, us))
Just (_, _, Nothing) -> go reader
Nothing -> return Nothing
findDownloads :: URLString -> Feed -> [ToDownload] findDownloads :: URLString -> Feed -> [ToDownload]
findDownloads u f = catMaybes $ map mk (feedItems f) findDownloads u f = catMaybes $ map mk (feedItems f)
where where

30
Logs/Web.hs
View file

@ -1,6 +1,6 @@
{- Web url logs. {- Web url logs.
- -
- Copyright 2011-2020 Joey Hess <id@joeyh.name> - Copyright 2011-2021 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -13,23 +13,23 @@ module Logs.Web (
getUrlsWithPrefix, getUrlsWithPrefix,
setUrlPresent, setUrlPresent,
setUrlMissing, setUrlMissing,
withKnownUrls,
Downloader(..), Downloader(..),
getDownloader, getDownloader,
setDownloader, setDownloader,
setDownloader', setDownloader',
setTempUrl, setTempUrl,
removeTempUrl, removeTempUrl,
parseUrlLog,
) where ) where
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.ByteString.Lazy as L
import Annex.Common import Annex.Common
import qualified Annex import qualified Annex
import Logs import Logs
import Logs.Presence import Logs.Presence
import Logs.Location import Logs.Location
import qualified Annex.Branch
import Utility.Url import Utility.Url
import Annex.UUID import Annex.UUID
import qualified Types.Remote as Remote import qualified Types.Remote as Remote
@ -47,7 +47,7 @@ getUrls key = do
us <- currentLogInfo l us <- currentLogInfo l
if null us if null us
then go ls then go ls
else return $ map (decodeBS . fromLogInfo) us else return $ map decodeUrlLogInfo us
getUrlsWithPrefix :: Key -> String -> Annex [URLString] getUrlsWithPrefix :: Key -> String -> Annex [URLString]
getUrlsWithPrefix key prefix = filter (prefix `isPrefixOf`) getUrlsWithPrefix key prefix = filter (prefix `isPrefixOf`)
@ -85,20 +85,6 @@ setUrlMissing key url = do
OtherDownloader -> False OtherDownloader -> False
_ -> True _ -> True
{- Finds all known urls. -}
withKnownUrls :: (Annex (Maybe (Key, [URLString])) -> Annex a) -> Annex a
withKnownUrls a = Annex.Branch.overBranchFileContents urlLogFileKey (a . go)
where
go reader = reader >>= \case
Just (k, _, Just content) ->
case geturls content of
[] -> go reader
us -> return (Just (k, us))
Just (_, _, Nothing) -> go reader
Nothing -> return Nothing
geturls = map (decodeBS . fromLogInfo) . getLog
setTempUrl :: Key -> URLString -> Annex () setTempUrl :: Key -> URLString -> Annex ()
setTempUrl key url = Annex.changeState $ \s -> setTempUrl key url = Annex.changeState $ \s ->
s { Annex.tempurls = M.insert key url (Annex.tempurls s) } s { Annex.tempurls = M.insert key url (Annex.tempurls s) }
@ -131,3 +117,11 @@ getDownloader u = case separate (== ':') u of
("quvi", u') -> (u', YoutubeDownloader) ("quvi", u') -> (u', YoutubeDownloader)
("", u') -> (u', OtherDownloader) ("", u') -> (u', OtherDownloader)
_ -> (u, WebDownloader) _ -> (u, WebDownloader)
decodeUrlLogInfo :: LogInfo -> URLString
decodeUrlLogInfo = decodeBS . fromLogInfo
{- Parses the content of an url log file, returning the urls that are
- currently recorded. -}
parseUrlLog :: L.ByteString -> [URLString]
parseUrlLog = map decodeUrlLogInfo . getLog