38d691a10f
Running git-annex linux builds in termux seems to work well enough that the only reason to keep the Android app would be to support Android 4-5, which the old Android app supported, and which I don't know if the termux method works on (although I see no reason why it would not). According to [1], Android 4-5 remains on around 29% of devices, down from 51% one year ago. [1] https://www.statista.com/statistics/271774/share-of-android-platforms-on-mobile-devices-with-android-os/ This is a rather large commit, but mostly very straightfoward removal of android ifdefs and patches and associated cruft. Also, removed support for building with very old ghc < 8.0.1, and with yesod < 1.4.3, and without concurrent-output, which were only being used by the cross build. Some documentation specific to the Android app (screenshots etc) needs to be updated still. This commit was sponsored by Brett Eisenberg on Patreon.
75 lines
2.3 KiB
Haskell
75 lines
2.3 KiB
Haskell
{- git-annex assistant webapp page display
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
|
|
|
|
module Assistant.WebApp.Page where
|
|
|
|
import Assistant.Common
|
|
import Assistant.WebApp
|
|
import Assistant.WebApp.Types
|
|
import Assistant.WebApp.SideBar
|
|
import Utility.Yesod
|
|
|
|
import qualified Text.Hamlet as Hamlet
|
|
import Data.Text (Text)
|
|
|
|
data NavBarItem = DashBoard | Configuration | About
|
|
deriving (Eq, Ord, Enum, Bounded)
|
|
|
|
navBarName :: NavBarItem -> Text
|
|
navBarName DashBoard = "Dashboard"
|
|
navBarName Configuration = "Configuration"
|
|
navBarName About = "About"
|
|
|
|
navBarRoute :: NavBarItem -> Route WebApp
|
|
navBarRoute DashBoard = DashboardR
|
|
navBarRoute Configuration = ConfigurationR
|
|
navBarRoute About = AboutR
|
|
|
|
defaultNavBar :: [NavBarItem]
|
|
defaultNavBar = [minBound .. maxBound]
|
|
|
|
firstRunNavBar :: [NavBarItem]
|
|
firstRunNavBar = [Configuration, About]
|
|
|
|
selectNavBar :: Handler [NavBarItem]
|
|
selectNavBar = ifM inFirstRun (return firstRunNavBar, return defaultNavBar)
|
|
|
|
{- A standard page of the webapp, with a title, a sidebar, and that may
|
|
- be highlighted on the navbar. -}
|
|
page :: Hamlet.Html -> Maybe NavBarItem -> Widget -> Handler Html
|
|
page title navbaritem content = customPage navbaritem $ do
|
|
setTitle title
|
|
content
|
|
sideBarDisplay
|
|
|
|
{- A custom page, with no title or sidebar set. -}
|
|
customPage :: Maybe NavBarItem -> Widget -> Handler Html
|
|
customPage = customPage' True
|
|
|
|
customPage' :: Bool -> Maybe NavBarItem -> Widget -> Handler Html
|
|
customPage' with_longpolling navbaritem content = do
|
|
webapp <- getYesod
|
|
case cannotRun webapp of
|
|
Nothing -> do
|
|
navbar <- map navdetails <$> selectNavBar
|
|
pageinfo <- widgetToPageContent $ do
|
|
addStylesheet $ StaticR css_bootstrap_css
|
|
addStylesheet $ StaticR css_bootstrap_theme_css
|
|
addScript $ StaticR js_jquery_full_js
|
|
addScript $ StaticR js_bootstrap_js
|
|
when with_longpolling $
|
|
addScript $ StaticR js_longpolling_js
|
|
$(widgetFile "page")
|
|
withUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap")
|
|
Just msg -> error msg
|
|
where
|
|
navdetails i = (navBarName i, navBarRoute i, Just i == navbaritem)
|
|
|
|
controlMenu :: Widget
|
|
controlMenu = $(widgetFile "controlmenu")
|