diff options
| -rw-r--r-- | Assistant/WebApp.hs | 2 | ||||
| -rw-r--r-- | Assistant/WebApp/DashBoard.hs | 37 | ||||
| -rw-r--r-- | Assistant/WebApp/routes | 1 | ||||
| -rw-r--r-- | templates/page.hamlet | 3 |
4 files changed, 41 insertions, 2 deletions
diff --git a/Assistant/WebApp.hs b/Assistant/WebApp.hs index 1b767c642..4042d410e 100644 --- a/Assistant/WebApp.hs +++ b/Assistant/WebApp.hs @@ -63,7 +63,7 @@ selectNavBar :: Handler [NavBarItem] selectNavBar = ifM (inFirstRun) (return firstRunNavBar, return defaultNavBar) inFirstRun :: Handler Bool -inFirstRun = isNothing . threadState <$> getYesod +inFirstRun = isNothing . relDir <$> getYesod {- Used instead of defaultContent; highlights the current page if it's - on the navbar. -} diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs index f4f56a476..a1e499d70 100644 --- a/Assistant/WebApp/DashBoard.hs +++ b/Assistant/WebApp/DashBoard.hs @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-} +{-# LANGUAGE CPP, TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-} module Assistant.WebApp.DashBoard where @@ -23,6 +23,7 @@ import Utility.Percentage import Utility.DataUnits import Types.Key import qualified Remote +import qualified Git import Yesod import Text.Hamlet @@ -88,3 +89,37 @@ getNoScriptAutoR = bootstrap (Just DashBoard) $ do let this = NoScriptAutoR toWidgetHead $(hamletFile $ hamletTemplate "dashboard/metarefresh") dashboard False + +{- The javascript code does a post. -} +postFileBrowserR :: Handler () +postFileBrowserR = void openFileBrowser + +{- Used by non-javascript browsers, where clicking on the link actually + - opens this page, so we redirect back to the referrer. -} +getFileBrowserR :: Handler () +getFileBrowserR = whenM openFileBrowser $ do + clearUltDest + setUltDestReferer + redirectUltDest HomeR + +{- Opens the system file browser on the repo, or, as a fallback, + - goes to a file:// url. Returns True if it's ok to redirect away + - from the page (ie, the system file browser was opened). -} +openFileBrowser :: Handler Bool +openFileBrowser = do + path <- runAnnex (error "no configured repository") $ + fromRepo Git.repoPath + ifM (liftIO $ inPath cmd <&&> boolSystem cmd [File path]) + ( return True + , do + clearUltDest + setUltDest $ "file://" ++ path + void $ redirectUltDest HomeR + return False + ) + where +#if OSX + cmd = "open" +#else + cmd = "xdg-open" +#endif diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index 95813edb6..192e1cd6b 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -11,5 +11,6 @@ /notifier/transfers NotifierTransfersR GET /notifier/sidebar NotifierSideBarR GET /closealert/#AlertId CloseAlert GET +/filebrowser FileBrowserR GET POST /static StaticR Static getStatic diff --git a/templates/page.hamlet b/templates/page.hamlet index 29a091110..6321f7a18 100644 --- a/templates/page.hamlet +++ b/templates/page.hamlet @@ -9,6 +9,9 @@ <a href="@{route}">#{name}</a> $maybe reldir <- relDir webapp <ul .nav .pull-right> + <li> + <a href="@{FileBrowserR}" onclick="(function( $ ) { $.post('@{FileBrowserR}'); })( jQuery ); return false;"> + <i .icon-folder-open .icon-white></i> Files <li .dropdown #menu1> <a .dropdown-toggle data-toggle="dropdown" href="#menu1"> Current Repository: #{reldir} |