git-annex/Assistant/WebApp/Configurators.hs

{- git-annex assistant webapp configurators
 -
 - Copyright 2012 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes, CPP #-}

module Assistant.WebApp.Configurators where

import Assistant.WebApp.Common
import Assistant.WebApp.RepoList
#ifdef WITH_XMPP
import Assistant.XMPP.Client
#endif

{- The main configuration screen. -}
getConfigurationR :: Handler RepHtml
getConfigurationR = ifM (inFirstRun)
	( redirect FirstRepositoryR
	, page "Configuration" (Just Configuration) $ do
#ifdef WITH_XMPP
		xmppconfigured <- liftAnnex $ isJust <$> getXMPPCreds
#else
		let xmppconfigured = False
#endif
		$(widgetFile "configurators/main")
	)

getAddRepositoryR :: Handler RepHtml
getAddRepositoryR = page "Add Repository" (Just Configuration) $ do
	let repolist = repoListDisplay mainRepoSelector
	$(widgetFile "configurators/addrepository")

makeMiscRepositories :: Widget
makeMiscRepositories = $(widgetFile "configurators/addrepository/misc")

makeCloudRepositories :: Bool -> Widget
makeCloudRepositories onlyTransfer = $(widgetFile "configurators/addrepository/cloud")
split up webapp files 2012-07-31 05:11:32 +00:00			`{- git-annex assistant webapp configurators`
			`-`
			`- Copyright 2012 Joey Hess <joey@kitenet.net>`
			`-`
license the webapp under the AGPL 3+ This means that anyone serving up the webapp to users as a service (ie, without providing any git-annex binary at all to the user) still needs to provide a link to the source code for it, including any modifications they may make. This may make git-annex be covered by the AGPL as a whole when it is built with the webapp. If in doubt, you should ask a lawyer. When git-annex is built with the webapp disabled, no AGPLed code is used. Even building in the assistant does not pull in AGPLed code. 2012-09-24 18:48:47 +00:00			`- Licensed under the GNU AGPL version 3 or higher.`
split up webapp files 2012-07-31 05:11:32 +00:00			`-}`

One more #ifdef WITH_S3 2012-10-18 14:14:49 +00:00			`{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes, CPP #-}`
split up webapp files 2012-07-31 05:11:32 +00:00
			`module Assistant.WebApp.Configurators where`

refactor 2012-11-25 04:26:46 +00:00			`import Assistant.WebApp.Common`
reorg repolist 2013-03-15 02:10:51 +00:00			`import Assistant.WebApp.RepoList`
xmpp buddy list tracking 2012-11-02 16:59:31 +00:00			`#ifdef WITH_XMPP`
			`import Assistant.XMPP.Client`
			`#endif`
split up webapp files 2012-07-31 05:11:32 +00:00
moving toward configuring new repos in the webapp 2012-08-03 18:36:16 +00:00			`{- The main configuration screen. -}`
type based git config handling Now there's a Config type, that's extracted from the git config at startup. Note that laziness means that individual config values are only looked up and parsed on demand, and so we get implicit memoization for all of them. So this is not only prettier and more type safe, it optimises several places that didn't have explicit memoization before. As well as getting rid of the ugly explicit memoization code. Not yet done for annex.<remote>.* configuration settings. 2012-12-30 03:10:18 +00:00			`getConfigurationR :: Handler RepHtml`
			`getConfigurationR = ifM (inFirstRun)`
redirect to FirstRepositoryR This makes the new POST form work, since otherwise it would try to POST ConfigurationR, which is not supported. 2013-03-18 16:47:44 +00:00			`( redirect FirstRepositoryR`
type based git config handling Now there's a Config type, that's extracted from the git config at startup. Note that laziness means that individual config values are only looked up and parsed on demand, and so we get implicit memoization for all of them. So this is not only prettier and more type safe, it optimises several places that didn't have explicit memoization before. As well as getting rid of the ugly explicit memoization code. Not yet done for annex.<remote>.* configuration settings. 2012-12-30 03:10:18 +00:00			`, page "Configuration" (Just Configuration) $ do`
xmpp buddy list tracking 2012-11-02 16:59:31 +00:00			`#ifdef WITH_XMPP`
make liftAnnex and liftAssistant polymorphic, like liftIO 2013-03-16 04:12:28 +00:00			`xmppconfigured <- liftAnnex $ isJust <$> getXMPPCreds`
xmpp buddy list tracking 2012-11-02 16:59:31 +00:00			`#else`
			`let xmppconfigured = False`
			`#endif`
moving toward configuring new repos in the webapp 2012-08-03 18:36:16 +00:00			`$(widgetFile "configurators/main")`
			`)`
reorg repolist 2013-03-15 02:10:51 +00:00
webapp: Repository list is now included in the dashboard, and other UI tweaks. 2013-03-15 04:34:42 +00:00			`getAddRepositoryR :: Handler RepHtml`
			`getAddRepositoryR = page "Add Repository" (Just Configuration) $ do`
			`let repolist = repoListDisplay mainRepoSelector`
reorg templates 2013-03-15 16:47:41 +00:00			`$(widgetFile "configurators/addrepository")`
reorg repolist 2013-03-15 02:10:51 +00:00
			`makeMiscRepositories :: Widget`
reorg templates 2013-03-15 16:47:41 +00:00			`makeMiscRepositories = $(widgetFile "configurators/addrepository/misc")`
reorg repolist 2013-03-15 02:10:51 +00:00
			`makeCloudRepositories :: Bool -> Widget`
reorg templates 2013-03-15 16:47:41 +00:00			`makeCloudRepositories onlyTransfer = $(widgetFile "configurators/addrepository/cloud")`