reorg templates

This commit is contained in:
Joey Hess 2012-09-08 23:32:08 -04:00
parent 6e60b08060
commit f62cc48482
10 changed files with 10 additions and 10 deletions

View file

@ -107,8 +107,8 @@ defaultRepositoryPath firstrun = do
) )
else return cwd else return cwd
localRepositoryForm :: Form RepositoryPath firstRepositoryForm :: Form RepositoryPath
localRepositoryForm msg = do firstRepositoryForm msg = do
path <- T.pack . addTrailingPathSeparator path <- T.pack . addTrailingPathSeparator
<$> (liftIO . defaultRepositoryPath =<< lift inFirstRun) <$> (liftIO . defaultRepositoryPath =<< lift inFirstRun)
(pathRes, pathView) <- mreq (repositoryPathField True) "" (Just path) (pathRes, pathView) <- mreq (repositoryPathField True) "" (Just path)
@ -118,7 +118,7 @@ localRepositoryForm msg = do
FormSuccess _ -> (False, "") FormSuccess _ -> (False, "")
let form = do let form = do
webAppFormAuthToken webAppFormAuthToken
$(widgetFile "configurators/localrepositoryform") $(widgetFile "configurators/firstrepository/form")
return (RepositoryPath <$> pathRes, form) return (RepositoryPath <$> pathRes, form)
{- Making the first repository, when starting the webapp for the first time. -} {- Making the first repository, when starting the webapp for the first time. -}
@ -126,7 +126,7 @@ getFirstRepositoryR :: Handler RepHtml
getFirstRepositoryR = bootstrap (Just Config) $ do getFirstRepositoryR = bootstrap (Just Config) $ do
sideBarDisplay sideBarDisplay
setTitle "Getting started" setTitle "Getting started"
((res, form), enctype) <- lift $ runFormGet localRepositoryForm ((res, form), enctype) <- lift $ runFormGet firstRepositoryForm
case res of case res of
FormSuccess (RepositoryPath p) -> lift $ FormSuccess (RepositoryPath p) -> lift $
startFullAssistant $ T.unpack p startFullAssistant $ T.unpack p

View file

@ -74,7 +74,7 @@ getInprogressPairR :: Text -> Handler RepHtml
getInprogressPairR secret = bootstrap (Just Config) $ do getInprogressPairR secret = bootstrap (Just Config) $ do
sideBarDisplay sideBarDisplay
setTitle "Pairing" setTitle "Pairing"
$(widgetFile "configurators/inprogresspairing") $(widgetFile "configurators/pairing/inprogress")
#else #else
getInprogressPairR _ = noPairing getInprogressPairR _ = noPairing
#endif #endif
@ -123,7 +123,7 @@ promptSecret msg cont = bootstrap (Just Config) $ do
u <- T.pack <$> liftIO getUserName u <- T.pack <$> liftIO getUserName
let sameusername = username == u let sameusername = username == u
let authtoken = webAppFormAuthToken let authtoken = webAppFormAuthToken
$(widgetFile "configurators/pairing") $(widgetFile "configurators/pairing/prompt")
{- This counts unicode characters as more than one character, {- This counts unicode characters as more than one character,
- but that's ok; they *do* provide additional entropy. -} - but that's ok; they *do* provide additional entropy. -}
@ -155,6 +155,6 @@ noPairing :: Handler RepHtml
noPairing = bootstrap (Just Config) $ do noPairing = bootstrap (Just Config) $ do
sideBarDisplay sideBarDisplay
setTitle "Pairing" setTitle "Pairing"
$(widgetFile "configurators/nopairing") $(widgetFile "configurators/pairing/disabled")
#endif #endif

View file

@ -112,7 +112,7 @@ getAddSshR = sshConfigurator $ do
where where
showform form enctype status = do showform form enctype status = do
let authtoken = webAppFormAuthToken let authtoken = webAppFormAuthToken
$(widgetFile "configurators/addssh") $(widgetFile "configurators/ssh/add")
{- Test if we can ssh into the server. {- Test if we can ssh into the server.
- -
@ -225,7 +225,7 @@ sshSetup opts input a = do
showSshErr :: String -> Handler RepHtml showSshErr :: String -> Handler RepHtml
showSshErr msg = sshConfigurator $ showSshErr msg = sshConfigurator $
$(widgetFile "configurators/makessherror") $(widgetFile "configurators/ssh/error")
{- Does ssh have known_hosts data for a hostname? -} {- Does ssh have known_hosts data for a hostname? -}
knownHost :: SshServer -> IO Bool knownHost :: SshServer -> IO Bool
@ -240,7 +240,7 @@ knownHost (SshServer { hostname = Just h }) = do
getConfirmSshR :: SshData -> Handler RepHtml getConfirmSshR :: SshData -> Handler RepHtml
getConfirmSshR sshdata = sshConfigurator $ do getConfirmSshR sshdata = sshConfigurator $ do
let authtoken = webAppFormAuthToken let authtoken = webAppFormAuthToken
$(widgetFile "configurators/confirmssh") $(widgetFile "configurators/ssh/confirm")
getMakeSshGitR :: SshData -> Handler RepHtml getMakeSshGitR :: SshData -> Handler RepHtml
getMakeSshGitR = makeSsh False getMakeSshGitR = makeSsh False