refactor

Assistant/WebApp/Configurators/AWS.hs

@@ -9,13 +9,9 @@
 
 module Assistant.WebApp.Configurators.AWS where
 
-import Assistant.Common
+import Assistant.WebApp.Common
 import Assistant.MakeRemote
 import Assistant.Sync
-import Assistant.WebApp
-import Assistant.WebApp.Types
-import Assistant.WebApp.SideBar
-import Utility.Yesod
 #ifdef WITH_S3
 import qualified Remote.S3 as S3
 #endif
@@ -28,15 +24,11 @@ import Types.StandardGroups
 import Logs.PreferredContent
 
 import Yesod
-import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Map as M
 
 awsConfigurator :: Widget -> Handler RepHtml
-awsConfigurator a = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Add an Amazon repository"
-	a
+awsConfigurator = page "Add an Amazon repository" (Just Config)
 
 glacierConfigurator :: Widget -> Handler RepHtml
 glacierConfigurator a = do

Assistant/WebApp/Configurators/Edit.hs

@@ -9,15 +9,11 @@
 
 module Assistant.WebApp.Configurators.Edit where
 
-import Assistant.Common
-import Assistant.WebApp
-import Assistant.WebApp.Types
-import Assistant.WebApp.SideBar
+import Assistant.WebApp.Common
 import Assistant.WebApp.Utility
 import Assistant.DaemonStatus
 import Assistant.MakeRemote (uniqueRemoteName)
 import Assistant.WebApp.Configurators.XMPP (xmppNeeded)
-import Utility.Yesod
 import qualified Remote
 import qualified Remote.List as Remote
 import Logs.UUID
@@ -30,7 +26,6 @@ import qualified Git.Command
 import qualified Git.Config
 
 import Yesod
-import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Map as M
 import qualified Data.Set as S
@@ -116,10 +111,7 @@ getEditNewCloudRepositoryR :: UUID -> Handler RepHtml
 getEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid
 
 editForm :: Bool -> UUID -> Handler RepHtml
-editForm new uuid = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Configure repository"
-
+editForm new uuid = page "Configure repository" (Just Config) $ 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

@@ -9,13 +9,9 @@
 
 module Assistant.WebApp.Configurators.Local where
 
-import Assistant.Common
-import Assistant.WebApp
-import Assistant.WebApp.Types
-import Assistant.WebApp.SideBar
+import Assistant.WebApp.Common
 import Assistant.WebApp.Utility
 import Assistant.MakeRemote
-import Utility.Yesod
 import Init
 import qualified Git
 import qualified Git.Construct
@@ -35,7 +31,6 @@ import Logs.PreferredContent
 import Utility.UserInfo
 
 import Yesod
-import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Char
 import System.Posix.Directory
@@ -133,9 +128,7 @@ newRepositoryForm defpath msg = do
 
 {- Making the first repository, when starting the webapp for the first time. -}
 getFirstRepositoryR :: Handler RepHtml
-getFirstRepositoryR = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Getting started"	
+getFirstRepositoryR = page "Getting started" (Just Config) $ do
 	path <- liftIO . defaultRepositoryPath =<< lift inFirstRun
 	((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm path
 	case res of
@@ -145,9 +138,7 @@ getFirstRepositoryR = bootstrap (Just Config) $ do
 
 {- Adding a new, separate repository. -}
 getNewRepositoryR :: Handler RepHtml
-getNewRepositoryR = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Add another repository"
+getNewRepositoryR = page "Add another repository" (Just Config) $ do
 	home <- liftIO myHomeDir
 	((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm home
 	case res of
@@ -184,9 +175,7 @@ selectDriveForm drives def = renderBootstrap $ RemovableDrive
 
 {- Adding a removable drive. -}
 getAddDriveR :: Handler RepHtml
-getAddDriveR = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Add a removable drive"
+getAddDriveR = page "AAdd a removable drive" (Just Config) $ do
 	removabledrives <- liftIO $ driveList
 	writabledrives <- liftIO $
 		filterM (canWrite . T.unpack . mountPoint) removabledrives
@@ -226,9 +215,7 @@ getAddDriveR = bootstrap (Just Config) $ do
 		addRemote $ makeGitRemote name dir
 
 getEnableDirectoryR :: UUID -> Handler RepHtml
-getEnableDirectoryR uuid = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Enable a repository"
+getEnableDirectoryR uuid = page "Enable a repository" (Just Config) $ do
 	description <- lift $ runAnnex "" $
 		T.pack . concat <$> prettyListUUIDs [uuid]
 	$(widgetFile "configurators/enabledirectory")

Assistant/WebApp/Configurators/Pairing.hs

@@ -11,13 +11,9 @@
 module Assistant.WebApp.Configurators.Pairing where
 
 import Assistant.Pairing
-import Assistant.WebApp
-import Assistant.WebApp.Types
-import Assistant.WebApp.SideBar
+import Assistant.WebApp.Common
 import Assistant.Types.Buddies
-import Utility.Yesod
 #ifdef WITH_PAIRING
-import Assistant.Common
 import Assistant.Pairing.Network
 import Assistant.Pairing.MakeRemote
 import Assistant.Ssh
@@ -42,7 +38,6 @@ import Utility.UserInfo
 import Git
 
 import Yesod
-import Data.Text (Text)
 #ifdef WITH_PAIRING
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
@@ -293,10 +288,7 @@ sampleQuote = T.unwords
 #endif
 
 pairPage :: Widget -> Handler RepHtml
-pairPage w = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Pairing"
-	w
+pairPage = page "Pairing" (Just Config)
 
 noPairing :: Text -> Handler RepHtml
 noPairing pairingtype = pairPage $

Assistant/WebApp/Configurators/Ssh.hs

@@ -9,13 +9,9 @@
 
 module Assistant.WebApp.Configurators.Ssh where
 
-import Assistant.Common
+import Assistant.WebApp.Common
 import Assistant.Ssh
 import Assistant.MakeRemote
-import Assistant.WebApp
-import Assistant.WebApp.Types
-import Assistant.WebApp.SideBar
-import Utility.Yesod
 import Utility.Rsync (rsyncUrlIsShell)
 import Logs.Remote
 import Remote
@@ -24,16 +20,12 @@ import Types.StandardGroups
 import Utility.UserInfo
 
 import Yesod
-import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Map as M
 import Network.Socket
 
 sshConfigurator :: Widget -> Handler RepHtml
-sshConfigurator a = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Add a remote server"
-	a
+sshConfigurator = page "Add a remote server" (Just Config)
 
 data SshInput = SshInput
 	{ hostname :: Maybe Text
@@ -291,10 +283,7 @@ getAddRsyncNetR = do
 	((result, form), enctype) <- runFormGet $
 		renderBootstrap $ sshInputAForm $
 			SshInput Nothing Nothing Nothing
-	let showform status = bootstrap (Just Config) $ do
-		sideBarDisplay
-		setTitle "Add a Rsync.net repository"	
-		let authtoken = webAppFormAuthToken
+	let showform status = page "Add a Rsync.net repository" (Just Config) $
 		$(widgetFile "configurators/addrsync.net")
 	case result of
 		FormSuccess sshinput

Assistant/WebApp/Configurators/WebDAV.hs

@@ -9,13 +9,9 @@
 
 module Assistant.WebApp.Configurators.WebDAV where
 
-import Assistant.Common
+import Assistant.WebApp.Common
 import Assistant.MakeRemote
 import Assistant.Sync
-import Assistant.WebApp
-import Assistant.WebApp.Types
-import Assistant.WebApp.SideBar
-import Utility.Yesod
 import qualified Remote.WebDAV as WebDAV
 import qualified Remote
 import Types.Remote (RemoteConfig)
@@ -24,21 +20,14 @@ import Logs.PreferredContent
 import Logs.Remote
 
 import Yesod
-import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Map as M
 
 webDAVConfigurator :: Widget -> Handler RepHtml
-webDAVConfigurator a = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Add a WebDAV repository"
-	a
+webDAVConfigurator = page "Add a WebDAV repository" (Just Config)
 
 boxConfigurator :: Widget -> Handler RepHtml
-boxConfigurator a = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Add a Box.com repository"
-	a
+boxConfigurator = page "Add a Box.com repository" (Just Config)
 
 data WebDAVInput = WebDAVInput
 	{ user :: Text

Assistant/WebApp/Configurators/XMPP.hs

@@ -10,14 +10,10 @@
 
 module Assistant.WebApp.Configurators.XMPP where
 
-import Assistant.WebApp
-import Assistant.WebApp.Types
+import Assistant.WebApp.Common
 import Assistant.WebApp.Notifications
-import Assistant.WebApp.SideBar
-import Utility.Yesod
 import Utility.NotificationBroadcaster
 #ifdef WITH_XMPP
-import Assistant.Common
 import Assistant.XMPP.Client
 import Assistant.XMPP.Buddies
 import Assistant.Types.Buddies
@@ -31,7 +27,6 @@ import Yesod
 #ifdef WITH_XMPP
 import Network
 import Network.Protocol.XMPP
-import Data.Text (Text)
 import qualified Data.Text as T
 import Control.Exception (SomeException)
 #endif
@@ -97,8 +92,8 @@ getBuddyListR :: NotificationId -> Handler RepHtml
 getBuddyListR nid = do
 	waitNotifier getBuddyListBroadcaster nid
 
-	page <- widgetToPageContent buddyListDisplay
-	hamletToRepHtml $ [hamlet|^{pageBody page}|]
+	p <- widgetToPageContent buddyListDisplay
+	hamletToRepHtml $ [hamlet|^{pageBody p}|]
 
 buddyListDisplay :: Widget
 buddyListDisplay = do
@@ -163,7 +158,4 @@ testXMPP creds = either Left (const $ Right creds)
 #endif
 
 xmppPage :: Widget -> Handler RepHtml
-xmppPage w = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Jabber"
-	w
+xmppPage = page "Jabber" (Just Config)