4 files changed, 23 insertions(+), 3 deletions(-)

M src/Main.hs
M src/Messages.hs
M src/UI/Templates.hs
M src/Webdriver.hs

@@ 75,7 75,8 @@ serveSession = withSession session404 $ \uuid session -> msum [
         dir "timeout" $ setTimeout uuid session,
         dir "search" $ searchSession session,
         dir "nav" $ msum [
-            dir "load" $ loadPage uuid session
+            dir "load" $ loadPage uuid session,
+            dir "reload" $ reloadPage uuid session
         ]
     ]
 


@@ 132,3 133,10 @@ loadPage uuid session = do
         Nothing -> do
             session' <- liftIO $ readMVar session
             Tpl.inspector ok "400" session' $ \langs -> l langs ErrURL
+
+reloadPage uuid session = do
+    nullDir
+    method POST
+    session' <- liftIO $ readMVar session
+    liftIO $ Load.load session $ currentURL session'
+    seeOther ('/':ID.toString uuid) $ toResponse ()

@@ 47,7 47,8 @@ data AttrMessage =
     CreateSession' |
     CloseSession' |
     Search' |
-    DebugLink' deriving Show
+    DebugLink' |
+    Reload' deriving Show
 
 l' :: [Text] -> AttrMessage -> AttributeValue
 ---- Begin localization


@@ 56,6 57,7 @@ l' ("en":_) CreateSession' = "Open new test session"
 l' ("en":_) CloseSession' = "Close Session"
 l' ("en":_) Search' = "Search…"
 l' ("en":_) DebugLink' = "Debug link in this test session"
+l' ("en":_) Reload' = "Reload inspected page"
 ---- End localization
 l' (_:langs) msg = l' langs msg
 l' [] msg = stringValue $ show msg

@@ 29,6 29,8 @@ inspector return' title session' body' = do
     let timeout = H.stringValue $ show $ pageLoad $ timeouts session'
     page return' [title, pack $ show $ currentURL $ session', "Amphiarao"] $ \langs -> do
         header $ do
+            H.form ! action' ["/", uuid', "/nav/reload"] ! alt (l' langs Reload') ! A.method "POST" $ do
+                button ! type_ "submit" ! A.title (l' langs Reload') $ "↻"
             H.form ! action' ["/", uuid', "/search"] ! alt (l' langs Search') $ do
                 input ! type_ "search" ! name "q" ! placeholder (l' langs Search')
         body' langs

@@ 37,7 37,8 @@ serveSession sessions = WD.withSession fail (\uuid session -> msum [
         dir "timeouts" $ getTimeout session,
         dir "timeouts" $ setTimeout session,
         dir "url" $ navigateTo session,
-        dir "url" $ getURL session
+        dir "url" $ getURL session,
+        dir "refresh" $ reloadPage session
     ]) sessions
   where
     fail uuid'| Just _ <- ID.fromString uuid' = errJSON 404 "invalid session ID" $ (


@@ 102,3 103,10 @@ getURL session = do
     nullDir
     session' <- liftIO $ readMVar session
     ok $ toResponse $ show $ WD.currentURL session'
+
+reloadPage session = do
+    method POST
+    nullDir
+    session' <- liftIO $ readMVar session
+    liftIO $ WD.load session $ WD.currentURL session'
+    ok $ toResponse ()