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.

Assistant/WebApp/Configurators.hs

@@ -28,10 +28,10 @@ import Assistant.XMPP.Client
 import qualified Data.Map as M
 
 {- The main configuration screen. -}
-getConfigR :: Handler RepHtml
-getConfigR = ifM (inFirstRun)
+getConfigurationR :: Handler RepHtml
+getConfigurationR = ifM (inFirstRun)
 	( getFirstRepositoryR
-	, page "Configuration" (Just Config) $ do
+	, page "Configuration" (Just Configuration) $ do
 #ifdef WITH_XMPP
 		xmppconfigured <- lift $ runAnnex False $ isJust <$> getXMPPCreds
 #else
@@ -62,7 +62,7 @@ makeCloudRepositories = $(widgetFile "configurators/repositories/cloud")
 
 {- Lists known repositories, followed by options to add more. -}
 getRepositoriesR :: Handler RepHtml
-getRepositoriesR = page "Repositories" (Just Config) $ do
+getRepositoriesR = page "Repositories" (Just Configuration) $ do
 	let repolist = repoListDisplay $ RepoSelector
 		{ onlyCloud = False
 		, onlyConfigured = False

Assistant/WebApp/Configurators/AWS.hs

@@ -27,7 +27,7 @@ import qualified Data.Text as T
 import qualified Data.Map as M
 
 awsConfigurator :: Widget -> Handler RepHtml
-awsConfigurator = page "Add an Amazon repository" (Just Config)
+awsConfigurator = page "Add an Amazon repository" (Just Configuration)
 
 glacierConfigurator :: Widget -> Handler RepHtml
 glacierConfigurator a = do

Assistant/WebApp/Configurators/Edit.hs

@@ -112,7 +112,7 @@ getEditNewCloudRepositoryR :: UUID -> Handler RepHtml
 getEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid
 
 editForm :: Bool -> UUID -> Handler RepHtml
-editForm new uuid = page "Configure repository" (Just Config) $ do
+editForm new uuid = page "Configure repository" (Just Configuration) $ do
 	(repo, mremote) <- lift $ runAnnex undefined $ Remote.repoFromUUID uuid
 	curr <- lift $ runAnnex undefined $ getRepoConfig uuid repo mremote
 	lift $ checkarchivedirectory curr

Assistant/WebApp/Configurators/Local.hs

@@ -29,7 +29,6 @@ import Annex.UUID
 import Types.StandardGroups
 import Logs.PreferredContent
 import Utility.UserInfo
-import Config
 
 import qualified Data.Text as T
 import Data.Char
@@ -128,7 +127,7 @@ newRepositoryForm defpath msg = do
 
 {- Making the first repository, when starting the webapp for the first time. -}
 getFirstRepositoryR :: Handler RepHtml
-getFirstRepositoryR = page "Getting started" (Just Config) $ do
+getFirstRepositoryR = page "Getting started" (Just Configuration) $ do
 	path <- liftIO . defaultRepositoryPath =<< lift inFirstRun
 	((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm path
 	case res of
@@ -138,7 +137,7 @@ getFirstRepositoryR = page "Getting started" (Just Config) $ do
 
 {- Adding a new, separate repository. -}
 getNewRepositoryR :: Handler RepHtml
-getNewRepositoryR = page "Add another repository" (Just Config) $ do
+getNewRepositoryR = page "Add another repository" (Just Configuration) $ do
 	home <- liftIO myHomeDir
 	((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm home
 	case res of
@@ -175,7 +174,7 @@ selectDriveForm drives def = renderBootstrap $ RemovableDrive
 
 {- Adding a removable drive. -}
 getAddDriveR :: Handler RepHtml
-getAddDriveR = page "Add a removable drive" (Just Config) $ do
+getAddDriveR = page "Add a removable drive" (Just Configuration) $ do
 	removabledrives <- liftIO $ driveList
 	writabledrives <- liftIO $
 		filterM (canWrite . T.unpack . mountPoint) removabledrives
@@ -213,7 +212,7 @@ getAddDriveR = page "Add a removable drive" (Just Config) $ do
 		addRemote $ makeGitRemote name dir
 
 getEnableDirectoryR :: UUID -> Handler RepHtml
-getEnableDirectoryR uuid = page "Enable a repository" (Just Config) $ do
+getEnableDirectoryR uuid = page "Enable a repository" (Just Configuration) $ do
 	description <- lift $ runAnnex "" $
 		T.pack . concat <$> prettyListUUIDs [uuid]
 	$(widgetFile "configurators/enabledirectory")

Assistant/WebApp/Configurators/Pairing.hs

@@ -286,7 +286,7 @@ sampleQuote = T.unwords
 #endif
 
 pairPage :: Widget -> Handler RepHtml
-pairPage = page "Pairing" (Just Config)
+pairPage = page "Pairing" (Just Configuration)
 
 noPairing :: Text -> Handler RepHtml
 noPairing pairingtype = pairPage $

Assistant/WebApp/Configurators/Ssh.hs

@@ -24,7 +24,7 @@ import qualified Data.Map as M
 import Network.Socket
 
 sshConfigurator :: Widget -> Handler RepHtml
-sshConfigurator = page "Add a remote server" (Just Config)
+sshConfigurator = page "Add a remote server" (Just Configuration)
 
 data SshInput = SshInput
 	{ inputHostname :: Maybe Text
@@ -288,7 +288,7 @@ getAddRsyncNetR = do
 	((result, form), enctype) <- runFormGet $
 		renderBootstrap $ sshInputAForm hostnamefield $
 			SshInput Nothing Nothing Nothing 22
-	let showform status = page "Add a Rsync.net repository" (Just Config) $
+	let showform status = page "Add a Rsync.net repository" (Just Configuration) $
 		$(widgetFile "configurators/addrsync.net")
 	case result of
 		FormSuccess sshinput

Assistant/WebApp/Configurators/WebDAV.hs

@@ -26,10 +26,10 @@ import qualified Data.Text as T
 import qualified Data.Map as M
 
 webDAVConfigurator :: Widget -> Handler RepHtml
-webDAVConfigurator = page "Add a WebDAV repository" (Just Config)
+webDAVConfigurator = page "Add a WebDAV repository" (Just Configuration)
 
 boxConfigurator :: Widget -> Handler RepHtml
-boxConfigurator = page "Add a Box.com repository" (Just Config)
+boxConfigurator = page "Add a Box.com repository" (Just Configuration)
 
 data WebDAVInput = WebDAVInput
 	{ user :: Text

Assistant/WebApp/Configurators/XMPP.hs

@@ -48,7 +48,7 @@ xmppNeeded = return ()
 
 getXMPPR :: Handler RepHtml
 #ifdef WITH_XMPP
-getXMPPR = getXMPPR' ConfigR
+getXMPPR = getXMPPR' ConfigurationR
 #else
 getXMPPR = xmppPage $
 	$(widgetFile "configurators/xmpp/disabled")
@@ -155,4 +155,4 @@ testXMPP creds = either Left (const $ Right creds)
 #endif
 
 xmppPage :: Widget -> Handler RepHtml
-xmppPage = page "Jabber" (Just Config)
+xmppPage = page "Jabber" (Just Configuration)

Assistant/WebApp/DashBoard.hs

@@ -79,7 +79,7 @@ dashboard warnNoScript = do
 
 getHomeR :: Handler RepHtml
 getHomeR = ifM (inFirstRun)
-	( redirect ConfigR
+	( redirect ConfigurationR
 	, page "" (Just DashBoard) $ dashboard True
 	)
 

Assistant/WebApp/Page.hs

@@ -19,24 +19,24 @@ import Yesod
 import Text.Hamlet
 import Data.Text (Text)
 
-data NavBarItem = DashBoard | Config | About
+data NavBarItem = DashBoard | Configuration | About
 	deriving (Eq)
 
 navBarName :: NavBarItem -> Text
 navBarName DashBoard = "Dashboard"
-navBarName Config = "Configuration"
+navBarName Configuration = "Configuration"
 navBarName About = "About"
 
 navBarRoute :: NavBarItem -> Route WebApp
 navBarRoute DashBoard = HomeR
-navBarRoute Config = ConfigR
+navBarRoute Configuration = ConfigurationR
 navBarRoute About = AboutR
 
 defaultNavBar :: [NavBarItem]
-defaultNavBar = [DashBoard, Config, About]
+defaultNavBar = [DashBoard, Configuration, About]
 
 firstRunNavBar :: [NavBarItem]
-firstRunNavBar = [Config, About]
+firstRunNavBar = [Configuration, About]
 
 selectNavBar :: Handler [NavBarItem]
 selectNavBar = ifM (inFirstRun) (return firstRunNavBar, return defaultNavBar)

Assistant/WebApp/routes

@@ -5,7 +5,7 @@
 /about/license LicenseR GET
 /about/repogroups RepoGroupR GET
 
-/config ConfigR GET
+/config ConfigurationR GET
 /config/repository RepositoriesR GET
 /config/xmpp XMPPR GET
 /config/xmpp/for/pairing XMPPForPairingR GET