add a navbar button that opens the repo in the desktop's native file browser

This should work on linux (xdg-open) and OSX (open). If the program
is not in $PATH, it falls back to opening a browser window/tab with file:///

The only tricky bit is the javascript code, that handles clicking on the
link. This is to avoid unnecessary page refreshes. Until I added the
return false at the end, the <a>'s normal click event also fired, so two
file browsers opened. I have not checked portability extensively.

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. -}

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

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

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}