summaryrefslogtreecommitdiff
path: root/Build/DistributionUpdate.hs
blob: 2c4d8249543341b2580ff39119c0aed84514399e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
{- Builds distributon info files for each git-annex release in a directory
 - tree, which must itself be part of a git-annex repository. Only files
 - that are present have their info file created. -}

import Common.Annex
import Types.Distribution
import Build.Version
import Utility.UserInfo
import Utility.Path
import qualified Git.Construct
import qualified Annex
import Annex.Content
import Backend
import Git.Command

import Data.Time.Clock

main = do
	state <- Annex.new =<< Git.Construct.fromPath =<< getRepoDir
	Annex.eval state makeinfos

makeinfos :: Annex ()
makeinfos = do
	basedir <- liftIO getRepoDir
	version <- liftIO getChangelogVersion
	now <- liftIO getCurrentTime
	liftIO $ putStrLn $ "building info files for version " ++ version ++ " in " ++ basedir
	fs <- liftIO $ dirContentsRecursiveSkipping (const False) True (basedir </> "git-annex")
	forM_ fs $ \f -> do
		v <- lookupFile f
		case v of
			Nothing -> noop
			Just (k, _b) -> whenM (inAnnex k) $ do
				liftIO $ putStrLn f
				let infofile = f ++ ".info"
				liftIO $ writeFile infofile $ show $ GitAnnexDistribution
					{ distributionUrl = mkUrl basedir f
					, distributionKey = k
					, distributionVersion = version
					, distributionReleasedate = now
					, distributionUrgentUpgrade = Nothing
					}
				void $ inRepo $ runBool [Param "add", Param infofile]
	void $ inRepo $ runBool 
		[ Param "commit"
		, Param "-m"
		, Param $ "publishing git-annex " ++ version
		]
	void $ inRepo $ runBool
		[ Param "annex"
		, Params "move --to website"
		]
	void $ inRepo $ runBool
		[ Param "annex"
		, Params "sync"
		]
	
	{- Check for out of date info files. -}
	infos <- liftIO $ filter (".info" `isSuffixOf`)
		<$> dirContentsRecursive (basedir </> "git-annex")
	ds <- liftIO $ forM infos (readish <$$> readFile)
	let dis = zip infos ds
	let ood = filter (outofdate version) dis
	unless (null ood) $
		error $ "Some info files are out of date: " ++ show (map fst ood)
  where
	outofdate version (_, md) = case md of
		Nothing -> True
		Just d -> distributionVersion d /= version

getRepoDir :: IO FilePath
getRepoDir = do
	home <- liftIO myHomeDir
	return $ home </> "lib" </> "downloads"

mkUrl :: FilePath -> FilePath -> String
mkUrl basedir f = "https://downloads.kitenet.net/" ++ relPathDirToFile basedir f