1 files changed, 0 insertions, 158 deletions
diff --git a/Assistant/WebApp.hs b/Assistant/WebApp.hs
deleted file mode 100644
index c8eaeecf0..000000000
--- a/Assistant/WebApp.hs
+++ /dev/null
@@ -1,158 +0,0 @@
-{- git-annex assistant webapp core
- -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
-
-module Assistant.WebApp where
-
-import Assistant.WebApp.Types
-import Assistant.Common
-import Assistant.ThreadedMonad
-import Assistant.DaemonStatus
-import Utility.NotificationBroadcaster
-import Utility.Yesod
-import Locations.UserConfig
-
-import Yesod
-import Text.Hamlet
-import Data.Text (Text)
-import Control.Concurrent.STM
-import Control.Concurrent
-
-data NavBarItem = DashBoard | Config | About
-	deriving (Eq)
-
-navBarName :: NavBarItem -> Text
-navBarName DashBoard = "Dashboard"
-navBarName Config = "Configuration"
-navBarName About = "About"
-
-navBarRoute :: NavBarItem -> Route WebApp
-navBarRoute DashBoard = HomeR
-navBarRoute Config = ConfigR
-navBarRoute About = AboutR
-
-defaultNavBar :: [NavBarItem]
-defaultNavBar = [DashBoard, Config, About]
-
-firstRunNavBar :: [NavBarItem]
-firstRunNavBar = [Config, About]
-
-selectNavBar :: Handler [NavBarItem]
-selectNavBar = ifM (inFirstRun) (return firstRunNavBar, return defaultNavBar)
-
-inFirstRun :: Handler Bool
-inFirstRun = isNothing . relDir <$> getYesod
-
-{- Used instead of defaultContent; highlights the current page if it's
- - on the navbar. -}
-bootstrap :: Maybe NavBarItem -> Widget -> Handler RepHtml
-bootstrap navbaritem content = do
-	webapp <- getYesod
-	navbar <- map navdetails <$> selectNavBar
-	page <- widgetToPageContent $ do
-		addStylesheet $ StaticR css_bootstrap_css
-		addStylesheet $ StaticR css_bootstrap_responsive_css
-		addScript $ StaticR jquery_full_js
-		addScript $ StaticR js_bootstrap_dropdown_js
-		addScript $ StaticR js_bootstrap_modal_js
-		$(widgetFile "page")
-	hamletToRepHtml $(hamletFile $ hamletTemplate "bootstrap")
-	where
-		navdetails i = (navBarName i, navBarRoute i, Just i == navbaritem)
-
-newWebAppState :: IO (TMVar WebAppState)
-newWebAppState = do
-	otherrepos <- listOtherRepos
-	atomically $ newTMVar $ WebAppState
-		{ showIntro = True
-		, otherRepos = otherrepos }
-
-getWebAppState :: forall sub. GHandler sub WebApp WebAppState
-getWebAppState = liftIO . atomically . readTMVar =<< webAppState <$> getYesod
-
-modifyWebAppState :: forall sub. (WebAppState -> WebAppState) -> GHandler sub WebApp ()
-modifyWebAppState a = go =<< webAppState <$> getYesod
-	where
-		go s = liftIO $ atomically $ do
-			v <- takeTMVar s
-			putTMVar s $ a v
-
-{- Runs an Annex action from the webapp.
- -
- - When the webapp is run outside a git-annex repository, the fallback
- - value is returned.
- -}
-runAnnex :: forall sub a. a -> Annex a -> GHandler sub WebApp a
-runAnnex fallback a = maybe (return fallback) go =<< threadState <$> getYesod
-	where
-		go st = liftIO $ runThreadState st a
-
-waitNotifier :: forall sub. (DaemonStatus -> NotificationBroadcaster) -> NotificationId -> GHandler sub WebApp ()
-waitNotifier selector nid = do
-	notifier <- getNotifier selector
-	liftIO $ waitNotification $ notificationHandleFromId notifier nid
-
-newNotifier :: forall sub. (DaemonStatus -> NotificationBroadcaster) -> GHandler sub WebApp NotificationId
-newNotifier selector = do
-	notifier <- getNotifier selector
-	liftIO $ notificationHandleToId <$> newNotificationHandle notifier
-
-getNotifier :: forall sub. (DaemonStatus -> NotificationBroadcaster) -> GHandler sub WebApp NotificationBroadcaster
-getNotifier selector = do
-	webapp <- getYesod
-	liftIO $ selector <$> getDaemonStatus (daemonStatus webapp)
-
-{- Adds the auth parameter as a hidden field on a form. Must be put into
- - every form. -}
-webAppFormAuthToken :: Widget
-webAppFormAuthToken = do
-	webapp <- lift getYesod
-	[whamlet|<input type="hidden" name="auth" value="#{secretToken webapp}">|]
-
-{- A button with an icon, and maybe label, that can be clicked to perform
- - some action.
- - With javascript, clicking it POSTs the Route, and remains on the same
- - page.
- - With noscript, clicking it GETs the Route. -}
-actionButton :: Route WebApp -> (Maybe String) -> String -> String -> Widget
-actionButton route label buttonclass iconclass = $(widgetFile "actionbutton")
-
-type UrlRenderFunc = Route WebApp -> [(Text, Text)] -> Text
-type UrlRenderer = MVar (UrlRenderFunc)
-
-newUrlRenderer :: IO UrlRenderer
-newUrlRenderer = newEmptyMVar
-
-setUrlRenderer :: UrlRenderer -> (UrlRenderFunc) -> IO ()
-setUrlRenderer = putMVar
-
-{- Blocks until the webapp is running and has called setUrlRenderer. -}
-renderUrl :: UrlRenderer -> Route WebApp -> [(Text, Text)] -> IO Text
-renderUrl urlrenderer route params = do
-	r <- readMVar urlrenderer
-	return $ r route params
-
-{- Redirects back to the referring page, or if there's none, HomeR -}
-redirectBack :: Handler ()
-redirectBack = do
-	clearUltDest
-	setUltDestReferer
-	redirectUltDest HomeR
-
-{- List of other known repsitories, and link to add a new one. -}
-otherReposWidget :: Widget
-otherReposWidget = do
-	repolist <- lift $ otherRepos <$> getWebAppState
-	$(widgetFile "otherrepos")
-
-listOtherRepos :: IO [(String, String)]
-listOtherRepos = do
-	f <- autoStartFile
-	dirs <- ifM (doesFileExist f) ( lines <$> readFile f, return [])
-	names <- mapM relHome dirs
-	return $ sort $ zip names dirs