git-annex/Assistant/WebApp/Configurators.hs

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

{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings, 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 Html
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 Html
getAddRepositoryR = page "Add Repository" (Just Configuration) $ do
	let repolist = repoListDisplay mainRepoSelector
	$(widgetFile "configurators/addrepository")

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

makeCloudRepositories :: Widget
makeCloudRepositories = $(widgetFile "configurators/addrepository/cloud")

makeXMPPConnection :: Widget
makeXMPPConnection = $(widgetFile "configurators/addrepository/xmppconnection")

makeSshRepository :: Widget
makeSshRepository = $(widgetFile "configurators/addrepository/ssh")

makeConnectionRepositories :: Widget
makeConnectionRepositories = $(widgetFile "configurators/addrepository/connection")

makeArchiveRepositories :: Widget
makeArchiveRepositories = $(widgetFile "configurators/addrepository/archive")
split up webapp files 2012-07-31 05:11:32 +00:00			`{- git-annex assistant webapp configurators`
			`-`
update my email address and homepage url 2015-01-21 16:50:09 +00:00			`- Copyright 2012 Joey Hess <id@joeyh.name>`
split up webapp files 2012-07-31 05:11:32 +00:00			`-`
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			`-}`

remove unnecessary haskell extensions 2013-06-05 01:02:09 +00:00			`{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings, 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. -}`
clean up build warnings with yesod 1.2, while still building with 1.1 2013-06-27 05:15:28 +00:00			`getConfigurationR :: Handler Html`
hlint 2013-10-02 05:06:59 +00:00			`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
clean up build warnings with yesod 1.2, while still building with 1.1 2013-06-27 05:15:28 +00:00			`getAddRepositoryR :: Handler Html`
webapp: Repository list is now included in the dashboard, and other UI tweaks. 2013-03-15 04:34:42 +00:00			`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
Internet Archive! * Add public repository group. * webapp: Can now set up Internet Archive repositories. TODO: Enabling IA repositories. 2013-04-25 16:23:36 +00:00			`makeCloudRepositories :: Widget`
			`makeCloudRepositories = $(widgetFile "configurators/addrepository/cloud")`

webapp: Rework xmpp nudge to prompt for either xmpp or a ssh remote be set up. This commit was sponsored by Nathan Howell. 2014-04-09 20:27:24 +00:00			`makeXMPPConnection :: Widget`
			`makeXMPPConnection = $(widgetFile "configurators/addrepository/xmppconnection")`

			`makeSshRepository :: Widget`
			`makeSshRepository = $(widgetFile "configurators/addrepository/ssh")`

			`makeConnectionRepositories :: Widget`
			`makeConnectionRepositories = $(widgetFile "configurators/addrepository/connection")`

Internet Archive! * Add public repository group. * webapp: Can now set up Internet Archive repositories. TODO: Enabling IA repositories. 2013-04-25 16:23:36 +00:00			`makeArchiveRepositories :: Widget`
			`makeArchiveRepositories = $(widgetFile "configurators/addrepository/archive")`