importfeed: git-annex becomes a podcatcher in 150 LOC

This commit is contained in:
Joey Hess 2013-07-28 15:27:36 -04:00
parent 55bd5a81ad
commit 7e66d260ea
15 changed files with 319 additions and 32 deletions

View file

@ -1,6 +1,6 @@
{- Web url logs.
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
- Copyright 2011, 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -11,12 +11,21 @@ module Logs.Web (
getUrls,
setUrlPresent,
setUrlMissing,
urlLog,
urlLogKey,
knownUrls
) where
import qualified Data.ByteString.Lazy.Char8 as L
import Common.Annex
import Logs.Presence
import Logs.Location
import Types.Key
import qualified Annex.Branch
import Annex.CatFile
import qualified Git
import qualified Git.LsFiles
type URLString = String
@ -24,8 +33,24 @@ type URLString = String
webUUID :: UUID
webUUID = UUID "00000000-0000-0000-0000-000000000001"
urlLogExt :: String
urlLogExt = ".log.web"
urlLog :: Key -> FilePath
urlLog key = hashDirLower key </> keyFile key ++ ".log.web"
urlLog key = hashDirLower key </> keyFile key ++ urlLogExt
{- Converts a url log file into a key.
- (Does not work on oldurlLogs.) -}
urlLogKey :: FilePath -> Maybe Key
urlLogKey file
| ext == urlLogExt = fileKey base
| otherwise = Nothing
where
(base, ext) = splitAt (length file - extlen) file
extlen = length urlLogExt
isUrlLog :: FilePath -> Bool
isUrlLog file = urlLogExt `isSuffixOf` file
{- Used to store the urls elsewhere. -}
oldurlLogs :: Key -> [FilePath]
@ -58,3 +83,21 @@ setUrlMissing key url = do
addLog (urlLog key) =<< logNow InfoMissing url
whenM (null <$> getUrls key) $
logChange key webUUID InfoMissing
{- Finds all known urls. -}
knownUrls :: Annex [URLString]
knownUrls = do
{- Ensure the git-annex branch's index file is up-to-date and
- any journaled changes are reflected in it, since we're going
- to query its index directly. -}
Annex.Branch.update
Annex.Branch.commit "update"
Annex.Branch.withIndex $ do
top <- fromRepo Git.repoPath
(l, cleanup) <- inRepo $ Git.LsFiles.stagedDetails [top]
r <- mapM (geturls . snd) $ filter (isUrlLog . fst) l
void $ liftIO cleanup
return $ concat r
where
geturls Nothing = return []
geturls (Just logsha) = getLog . L.unpack <$> catObject logsha