Add links to tosite tags

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

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

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"

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

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
 

hledger-web/templates/journal.hamlet

@@ -45,6 +45,8 @@ $if elem AddPermission perms
                     <div .tag-value>
                       $if isAbsoluteURI tagValue
                         <a href="#{tagValue}">#{tagValue}
+                      $elseif tagName == "tosite"
+                        <a href="@{documentRoute tagValue}">#{tagValue}
                       $else
                         #{tagValue}
 
@@ -68,6 +70,8 @@ $if elem AddPermission perms
                         <div .tag-value>
                           $if isAbsoluteURI tagValue
                             <a href="#{tagValue}">#{tagValue}
+                          $elseif tagName == "tosite"
+                            <a href="@{documentRoute tagValue}">#{tagValue}
                           $else
                             #{tagValue}