diff --git a/hledger-web/Hledger/Web/App.hs b/hledger-web/Hledger/Web/App.hs index fcee2825b..e6d6e0bb0 100644 --- a/hledger-web/Hledger/Web/App.hs +++ b/hledger-web/Hledger/Web/App.hs @@ -61,6 +61,7 @@ import Data.List (isPrefixOf) data App = App { settings :: AppConfig DefaultEnv Extra , getStatic :: Static -- ^ Settings for static file serving. + , getDocument :: Static , httpManager :: Manager -- , appOpts :: WebOpts diff --git a/hledger-web/Hledger/Web/Application.hs b/hledger-web/Hledger/Web/Application.hs index 037de01f1..f88b8cded 100644 --- a/hledger-web/Hledger/Web/Application.hs +++ b/hledger-web/Hledger/Web/Application.hs @@ -19,8 +19,14 @@ import Network.Wai.Middleware.RequestLogger (logStdoutDev, logStdout) import Network.HTTP.Client (defaultManagerSettings) import Network.HTTP.Conduit (newManager) import Yesod.Default.Config +import Yesod.Static (staticDevel, Static(Static)) +import WaiAppStatic.Types (StaticSettings(..), LookupResult(LRNotFound), MaxAge(NoMaxAge)) +import Control.Applicative ((<|>)) +import Control.Monad (sequence) +import System.FilePath (takeDirectory, ()) +import System.Directory (doesDirectoryExist) -import Hledger.Data (Journal, nulljournal) +import Hledger.Data (Journal(jfiles), nulljournal) import Hledger.Web.Handler.AddR import Hledger.Web.Handler.MiscR @@ -29,7 +35,7 @@ import Hledger.Web.Handler.UploadR import Hledger.Web.Handler.JournalR import Hledger.Web.Handler.RegisterR import Hledger.Web.Import -import Hledger.Web.WebOptions (ServerMode(..), WebOpts(server_mode_), corsPolicy) +import Hledger.Web.WebOptions (ServerMode(..), WebOpts(server_mode_, document_directory_), corsPolicy) -- mkYesodDispatch creates our YesodDispatch instance. -- It complements the mkYesodData call in App.hs, @@ -42,7 +48,7 @@ mkYesodDispatch "App" resourcesApp -- migrations handled by Yesod. makeApplication :: WebOpts -> Journal -> AppConfig DefaultEnv Extra -> IO Application makeApplication opts' j' conf' = do - app <- makeApp conf' opts' + app <- makeAppWith j' conf' opts' writeIORef (appJournal app) j' (logWare . (corsPolicy opts')) <$> toWaiApp app where @@ -59,11 +65,29 @@ makeApp = makeAppWith nulljournal makeAppWith :: Journal -> AppConfig DefaultEnv Extra -> WebOpts -> IO App makeAppWith j' aconf wopts = do s <- staticSite + let ddd = fmap (( "tositteet") . takeDirectory . fst) . listToMaybe $ jfiles j' + when pred a = (\x -> if x then Just a else Nothing) <$> pred + defaultDocumentDir <- fmap join . sequence $ (when <$> doesDirectoryExist <*> id) <$> ddd + let documentDir = document_directory_ wopts <|> defaultDocumentDir + nullStatic = Static $ StaticSettings + { ssLookupFile = const $ pure LRNotFound + , ssGetMimeType = const $ pure "" + , ssIndices = [] + , ssListing = Nothing + , ssMaxAge = NoMaxAge + , ssMkRedirect = const id + , ssRedirectToIndex = False + , ssUseHash = False + , ssAddTrailingSlash = True + , ss404Handler = Nothing + } + documentStatic <- sequence $ staticDevel <$> documentDir m <- newManager defaultManagerSettings jref <- newIORef j' return App{ settings = aconf , getStatic = s + , getDocument = fromMaybe nullStatic documentStatic , httpManager = m , appOpts = wopts , appJournal = jref diff --git a/hledger-web/Hledger/Web/Handler/JournalR.hs b/hledger-web/Hledger/Web/Handler/JournalR.hs index 40cd4fe89..fbbf217be 100644 --- a/hledger-web/Hledger/Web/Handler/JournalR.hs +++ b/hledger-web/Hledger/Web/Handler/JournalR.hs @@ -7,9 +7,11 @@ module Hledger.Web.Handler.JournalR where -import qualified Data.Text as T -- for journal.hamlet +import qualified Data.Text as T -- also for journal.hamlet import qualified Text.URI as URI +import Yesod.Static + import Hledger import Hledger.Cli.CliOptions import Hledger.Web.Import @@ -38,6 +40,7 @@ getJournalR = do isVisibleTag = not . isHiddenTagName . fst isPostingTag account tag = not $ tag `elem` journalInheritedAccountTags j account isAbsoluteURI = maybe False URI.isPathAbsolute . URI.mkURI + documentRoute = DocumentR . flip StaticRoute [] . T.splitOn "/" defaultLayout $ do setTitle "päiväkirja - hledger-web" diff --git a/hledger-web/Hledger/Web/WebOptions.hs b/hledger-web/Hledger/Web/WebOptions.hs index 1b6976552..e44777f0c 100644 --- a/hledger-web/Hledger/Web/WebOptions.hs +++ b/hledger-web/Hledger/Web/WebOptions.hs @@ -100,6 +100,11 @@ webflags = (\s opts -> Right $ setopt "base-url" s opts) "BASEURL" "set the base url (default: http://IPADDR:PORT)" + , flagReq + ["document-directory"] + (\s opts -> Right $ setopt "document-directory" s opts) + "DIRECTORY" + "set the directory to search for tositteet (default: JOURNAL-DIRECTORY/tositteet)" -- XXX #2139 -- , flagReq -- ["file-url"] @@ -143,6 +148,7 @@ data WebOpts = WebOpts , port_ :: !Int , base_url_ :: !String , file_url_ :: !(Maybe String) + , document_directory_ :: !(Maybe FilePath) , allow_ :: !AccessLevel , cliopts_ :: !CliOpts , socket_ :: !(Maybe String) @@ -156,6 +162,7 @@ defwebopts = WebOpts , port_ = def , base_url_ = "" , file_url_ = Nothing + , document_directory_ = Nothing , allow_ = AddAccess , cliopts_ = def , socket_ = Nothing @@ -191,6 +198,7 @@ rawOptsToWebOpts rawopts = , port_ = p , base_url_ = b , file_url_ = stripTrailingSlash <$> maybestringopt "file-url" rawopts + , document_directory_ = maybestringopt "document-directory" rawopts , allow_ = access , cliopts_ = cliopts , socket_ = sock diff --git a/hledger-web/config/routes b/hledger-web/config/routes index c0eeb1d46..cdd99de47 100644 --- a/hledger-web/config/routes +++ b/hledger-web/config/routes @@ -1,6 +1,7 @@ /favicon.ico FaviconR GET /robots.txt RobotsR GET /static StaticR Static getStatic +/document DocumentR Static getDocument /openapi.json OpenApiR GET diff --git a/hledger-web/templates/journal.hamlet b/hledger-web/templates/journal.hamlet index 590bcb227..7e87a04cc 100644 --- a/hledger-web/templates/journal.hamlet +++ b/hledger-web/templates/journal.hamlet @@ -45,6 +45,8 @@ $if elem AddPermission perms
$if isAbsoluteURI tagValue #{tagValue} + $elseif tagName == "tosite" + #{tagValue} $else #{tagValue} @@ -68,6 +70,8 @@ $if elem AddPermission perms
$if isAbsoluteURI tagValue #{tagValue} + $elseif tagName == "tosite" + #{tagValue} $else #{tagValue}