diff --git a/hbs2-git/hbs2-git-dashboard-assets/HBS2/Git/Web/Assets.hs b/hbs2-git/hbs2-git-dashboard-assets/HBS2/Git/Web/Assets.hs new file mode 100644 index 00000000..993f30f2 --- /dev/null +++ b/hbs2-git/hbs2-git-dashboard-assets/HBS2/Git/Web/Assets.hs @@ -0,0 +1,14 @@ +{-# Language TemplateHaskell #-} +module HBS2.Git.Web.Assets where + +import Data.FileEmbed + +import Data.ByteString + +version :: Int +version = 3 + +assetsDir :: [(FilePath, ByteString)] +assetsDir = $(embedDir "hbs2-git-dashboard-assets/assets") + + diff --git a/hbs2-git/hbs2-git-dashboard/assets/css/custom.css b/hbs2-git/hbs2-git-dashboard-assets/assets/css/custom.css similarity index 100% rename from hbs2-git/hbs2-git-dashboard/assets/css/custom.css rename to hbs2-git/hbs2-git-dashboard-assets/assets/css/custom.css diff --git a/hbs2-git/hbs2-git-dashboard/assets/css/fontawesomeall.css b/hbs2-git/hbs2-git-dashboard-assets/assets/css/fontawesomeall.css similarity index 100% rename from hbs2-git/hbs2-git-dashboard/assets/css/fontawesomeall.css rename to hbs2-git/hbs2-git-dashboard-assets/assets/css/fontawesomeall.css diff --git a/hbs2-git/hbs2-git-dashboard/assets/css/pico.min.css b/hbs2-git/hbs2-git-dashboard-assets/assets/css/pico.min.css similarity index 100% rename from hbs2-git/hbs2-git-dashboard/assets/css/pico.min.css rename to hbs2-git/hbs2-git-dashboard-assets/assets/css/pico.min.css diff --git a/hbs2-git/hbs2-git-dashboard/assets/icon/lock-closed.svg b/hbs2-git/hbs2-git-dashboard-assets/assets/icon/lock-closed.svg similarity index 100% rename from hbs2-git/hbs2-git-dashboard/assets/icon/lock-closed.svg rename to hbs2-git/hbs2-git-dashboard-assets/assets/icon/lock-closed.svg diff --git a/hbs2-git/hbs2-git-dashboard/assets/icon/refresh.svg b/hbs2-git/hbs2-git-dashboard-assets/assets/icon/refresh.svg similarity index 100% rename from hbs2-git/hbs2-git-dashboard/assets/icon/refresh.svg rename to hbs2-git/hbs2-git-dashboard-assets/assets/icon/refresh.svg diff --git a/hbs2-git/hbs2-git-dashboard/assets/icon/xclip.svg b/hbs2-git/hbs2-git-dashboard-assets/assets/icon/xclip.svg similarity index 100% rename from hbs2-git/hbs2-git-dashboard/assets/icon/xclip.svg rename to hbs2-git/hbs2-git-dashboard-assets/assets/icon/xclip.svg diff --git a/hbs2-git/hbs2-git-dashboard/assets/icon/xclipdone.svg b/hbs2-git/hbs2-git-dashboard-assets/assets/icon/xclipdone.svg similarity index 100% rename from hbs2-git/hbs2-git-dashboard/assets/icon/xclipdone.svg rename to hbs2-git/hbs2-git-dashboard-assets/assets/icon/xclipdone.svg diff --git a/hbs2-git/hbs2-git-dashboard/GitDashBoard.hs b/hbs2-git/hbs2-git-dashboard/GitDashBoard.hs index 83719c7f..c43a1027 100644 --- a/hbs2-git/hbs2-git-dashboard/GitDashBoard.hs +++ b/hbs2-git/hbs2-git-dashboard/GitDashBoard.hs @@ -6,11 +6,13 @@ import HBS2.Prelude.Plated import HBS2.OrDie import HBS2.System.Dir -import HBS2.Git.Html.Root +import HBS2.Git.Web.Assets +import HBS2.Git.Web.Html.Root import HBS2.Peer.CLI.Detect import Data.Config.Suckless +import Data.Config.Suckless.KeyValue import Lucid import Options.Applicative as O @@ -21,6 +23,7 @@ import Control.Applicative import Data.ByteString.Lazy qualified as LBS import Network.HTTP.Types.Status import Network.Wai.Middleware.Static hiding ((<|>)) +import Network.Wai.Middleware.StaticEmbedded as E import Network.Wai.Middleware.RequestLogger import Text.InterpolatedString.Perl6 (qc) import Web.Scotty.Trans @@ -33,9 +36,15 @@ import UnliftIO data HttpPortOpt +data DevelopAssetsOpt + instance HasConf m => HasCfgKey HttpPortOpt a m where key = "port" + +instance HasConf m => HasCfgKey DevelopAssetsOpt a m where + key = "develop-assets" + data RunDashBoardOpts = RunDashBoardOpts { configPath :: Maybe FilePath } @@ -110,15 +119,26 @@ runDashBoardM cli m = do withDashBoardEnv env m --- type App = -runDashboardWeb :: ScottyT (DashBoardM IO) () -runDashboardWeb = do +data WebOptions = + WebOptions + { _assetsOverride :: Maybe FilePath + } + + +runDashboardWeb :: WebOptions -> ScottyT (DashBoardM IO) () +runDashboardWeb wo = do middleware logStdout - middleware $ staticPolicy (noDots >-> addBase "hbs2-git/hbs2-git-dashboard/assets/") + let assets = _assetsOverride wo - get "/" $ do + case assets of + Nothing -> do + middleware (E.static assetsDir) + Just f -> do + middleware $ staticPolicy (noDots >-> addBase f) + + get "/" do html =<< renderTextT (dashboardRootPage mempty) main :: IO () @@ -130,13 +150,15 @@ main = do -- FIXME: to-config pno <- cfgValue @HttpPortOpt @(Maybe Int) <&> fromMaybe 8090 + wo <- cfgValue @DevelopAssetsOpt @(Maybe FilePath) <&> WebOptions soname <- runMaybeT (getRPC <|> detectRPC) `orDie` "hbs2-peer RPC not detected" env <- ask + conf <- getConf - scottyT pno (withDashBoardEnv env) runDashboardWeb + scottyT pno (withDashBoardEnv env) (runDashboardWeb wo) where opts = info (configParser <**> helper) diff --git a/hbs2-git/hbs2-git-dashboard/src/HBS2/Git/Html/Root.hs b/hbs2-git/hbs2-git-dashboard/src/HBS2/Git/Web/Html/Root.hs similarity index 98% rename from hbs2-git/hbs2-git-dashboard/src/HBS2/Git/Html/Root.hs rename to hbs2-git/hbs2-git-dashboard/src/HBS2/Git/Web/Html/Root.hs index 30e1ec7f..1a20c472 100644 --- a/hbs2-git/hbs2-git-dashboard/src/HBS2/Git/Html/Root.hs +++ b/hbs2-git/hbs2-git-dashboard/src/HBS2/Git/Web/Html/Root.hs @@ -1,4 +1,4 @@ -module HBS2.Git.Html.Root where +module HBS2.Git.Web.Html.Root where import HBS2.Prelude import HBS2.Base58 diff --git a/hbs2-git/hbs2-git.cabal b/hbs2-git/hbs2-git.cabal index 3b8d935e..2c3653fd 100644 --- a/hbs2-git/hbs2-git.cabal +++ b/hbs2-git/hbs2-git.cabal @@ -125,23 +125,39 @@ library hs-source-dirs: hbs2-git-client-lib +library hbs2-git-dashboard-assets + import: shared-properties + + build-depends: + base, file-embed + + exposed-modules: + HBS2.Git.Web.Assets + + hs-source-dirs: hbs2-git-dashboard-assets + + default-language: GHC2021 + + executable hbs2-git-dashboard import: shared-properties main-is: GitDashBoard.hs other-modules: - HBS2.Git.Html.Root + HBS2.Git.Web.Html.Root -- other-extensions: build-depends: - base, hbs2-peer, hbs2-git, suckless-conf + base, hbs2-git-dashboard-assets, hbs2-peer, hbs2-git, suckless-conf , binary , vector , optparse-applicative , http-types + , file-embed , wai , wai-extra , wai-middleware-static + , wai-middleware-static-embedded , lucid , lucid-htmx , scotty >= 0.22