git annex webapp now opens a browser to the webapp
Also, starts the assistant if it wasn't already running.
This commit is contained in:
parent
e6ce54de82
commit
1ffef3ad75
6 changed files with 122 additions and 23 deletions
|
@ -10,10 +10,12 @@
|
|||
module Assistant.Threads.WebApp where
|
||||
|
||||
import Assistant.Common
|
||||
import Assistant.ThreadedMonad
|
||||
import Assistant.DaemonStatus
|
||||
import Utility.WebApp
|
||||
|
||||
import Yesod
|
||||
import Network.Socket (PortNumber)
|
||||
|
||||
data WebApp = WebApp DaemonStatusHandle
|
||||
|
||||
|
@ -30,14 +32,33 @@ getHomeR = defaultLayout [whamlet|Hello, World<p><a href=@{ConfigR}>config|]
|
|||
getConfigR :: Handler RepHtml
|
||||
getConfigR = defaultLayout [whamlet|<a href=@{HomeR}>main|]
|
||||
|
||||
webAppThread :: DaemonStatusHandle -> IO ()
|
||||
webAppThread dstatus = do
|
||||
webAppThread :: ThreadState -> DaemonStatusHandle -> IO ()
|
||||
webAppThread st dstatus = do
|
||||
app <- toWaiApp (WebApp dstatus)
|
||||
app' <- ifM debugEnabled
|
||||
( return $ httpDebugLogger app
|
||||
, return app
|
||||
)
|
||||
runWebApp app' browser
|
||||
runWebApp app' $ \p -> runThreadState st $ writeHtmlShim p
|
||||
|
||||
{- Creates a html shim file that's used to redirect into the webapp. -}
|
||||
writeHtmlShim :: PortNumber -> Annex ()
|
||||
writeHtmlShim port = do
|
||||
htmlshim <- fromRepo gitAnnexHtmlShim
|
||||
liftIO $ writeFile htmlshim $ genHtmlShim port
|
||||
|
||||
{- TODO: generate this static file using Yesod. -}
|
||||
genHtmlShim :: PortNumber -> String
|
||||
genHtmlShim port = unlines
|
||||
[ "<html>"
|
||||
, "<head>"
|
||||
, "<meta http-equiv=\"refresh\" content=\"0; URL=" ++ url ++ "\">"
|
||||
, "</head>"
|
||||
, "<body>"
|
||||
, "<p>"
|
||||
, "<a href=\"" ++ url ++ "\">Starting webapp...</a>"
|
||||
, "</p>"
|
||||
, "</body>"
|
||||
]
|
||||
where
|
||||
browser p = void $
|
||||
runBrowser $ "http://" ++ localhost ++ ":" ++ show p
|
||||
url = "http://localhost:" ++ show port ++ "/"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue