Make filter links exact

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
@@ -141,6 +142,7 @@ instance Yesod App where
         ropts' = (_rsReportOpts rspec)
           {accountlistmode_ = ALTree  -- force tree mode for sidebar
           ,empty_           = True    -- show zero items by default
+          ,no_elide_        = True    -- list every account on its own row
           }
         rspec' = rspec{_rsQuery=q,_rsReportOpts=ropts'}
 

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,7 +7,10 @@
 
 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
@@ -36,6 +39,16 @@ getJournalR = do
       transactionFrag = transactionFragment j
       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 "/"
+      escapeRegex = T.pack . concatMap escape . T.unpack
+      escape c
+        | c `elem` (".[$^()|*+?{\\" :: [Char]) = ['\\', c]
+        | otherwise = [c]
+       -- XXX:is there no way to escape quotes in queries
+      addTagQuery name value = (JournalR, [("q", qparam <> " \"tag:^" <> escapeRegex name <> "$" <> (if T.null value then "" else "=^" <> escapeRegex value <> "$") <> "\"")])
+      addCodeQuery code = (JournalR, [("q", qparam <> " \"code:^" <> escapeRegex code <> "$\"")])
+      addPayeeQuery code = (JournalR, [("q", qparam <> " \"payee:^" <> escapeRegex code <> "$\"")])
 
   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/static/hledger.css

@@ -100,9 +100,13 @@ ul {
     word-wrap: break-word;
 }
 
+#sidebar-menu .main-menu tr {
+    border-top: 1px solid #ebebeb;
+}
+
 #sidebar-menu .main-menu td {
     padding: 1px !important;
-    border-top: 1px solid #ebebeb;
+    border-top: none;
     overflow: hidden;
     white-space:nowrap;
     text-overflow:ellipsis;
@@ -187,6 +191,14 @@ ul {
     max-width: 10em;
 }
 
+a.filter {
+    color: inherit;
+}
+
+a:hover.filter  {
+    text-decoration: underline dotted;
+}
+
 .tag-value {
     background-color: #eee;
     padding: 0 6px;
@@ -219,6 +231,11 @@ ul {
     justify-content: space-between;
 }
 
+.balance-assertion {
+    filter: contrast(50%);
+    font-size: smaller;
+}
+
 .negative {
     color: #a94442;
 }

hledger-web/templates/journal.hamlet

@@ -25,10 +25,12 @@ $if elem AddPermission perms
                       <div .status-cleared title="Tarkistettu" aria-label="Tarkistettu">
                 $if not $ T.null $ tcode torig
                   <div .transaction-code>
-                    (#{tcode torig})
+                    <a href=@?{addCodeQuery $ tcode torig} .filter>
+                      (#{tcode torig})
                 $if not $ T.null $ T.strip payee
                   <span .transaction-payee>
-                    #{payee}
+                    <a href=@?{addPayeeQuery payee} .filter>
+                      #{payee}
             $if not $ T.null $ T.strip note
               <details .transaction-note .elided-text>
                 <summary>
@@ -40,30 +42,46 @@ $if elem AddPermission perms
               $forall (tagName, tagValue) <- filter isVisibleTag $ ttags torig
                 <li .tag title="#{mconcat [tagName, ": ", tagValue]}">
                   <div .tag-name>
-                    #{tagName}
+                    <a href=@?{addTagQuery tagName tagValue} .filter>
+                      #{tagName}
                   $if not $ T.null $ T.strip tagValue
                     <div .tag-value>
-                      #{tagValue}
+                      $if isAbsoluteURI tagValue
+                        <a href="#{tagValue}">#{tagValue}
+                      $elseif tagName == "tosite"
+                        <a href="@{documentRoute tagValue}">#{tagValue}
+                      $else
+                        #{tagValue}
 
         <ul .postings>
-          $forall Posting { paccount = acc, pamount = amt, ptags = tags } <- tpostings torig
+          $forall Posting { paccount = acc, pamount = amt, pbalanceassertion = passert, ptags = tags } <- tpostings torig
             <li .posting>
               <div .posting-row>
                 <div .account>
                   <a href="@?{acctlink acc}##{tindex torig}" title="#{acc}">
                     #{elideAccountName 40 acc}
                 <div .amount style="text-align:right;">
-                  ^{mixedAmountAsHtml amt}
+                  <span .posted-amount>
+                    ^{mixedAmountAsHtml amt}
+                  $maybe BalanceAssertion { baamount = assertAmt } <- passert
+                    <span .balance-assertion>
+                      jälkeen ^{mixedAmountAsHtml $ mixedAmount assertAmt}
               $if null $ filter (isPostingTag acc) $ filter isVisibleTag tags
               $else
                 <ul .tags>
                   $forall (tagName, tagValue) <- filter (isPostingTag acc) $ filter isVisibleTag tags
                     <li .tag title="#{mconcat [tagName, ": ", tagValue]}">
                       <div .tag-name>
-                        #{tagName}
+                        <a href=@?{addTagQuery tagName tagValue} .filter>
+                          #{tagName}
                       $if not $ T.null $ T.strip tagValue
                         <div .tag-value>
-                          #{tagValue}
+                          $if isAbsoluteURI tagValue
+                            <a href="#{tagValue}">#{tagValue}
+                          $elseif tagName == "tosite"
+                            <a href="@{documentRoute tagValue}">#{tagValue}
+                          $else
+                            #{tagValue}
 
 $if elem AddPermission perms
   ^{addModal AddR j today}