web: Simplify hledgerLayout into defaultLayout

hledger-web/src/Foundation.hs

@@ -9,8 +9,10 @@ import Data.IORef (IORef, readIORef, writeIORef)
 import Data.List (isPrefixOf)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Time.Calendar (Day)
 import Network.HTTP.Conduit (Manager)
+import System.FilePath (takeFileName)
 import Text.Blaze (Markup)
 import Text.Blaze.Html.Renderer.String (renderHtml)
 import Text.Hamlet (hamletFile)
@@ -19,6 +21,7 @@ import Yesod.Static
 import Yesod.Default.Config
 
 import Handler.AddForm
+import Handler.Common (balanceReportAsHtml)
 import Settings.StaticFiles
 import Settings (widgetFile, Extra (..))
 #ifndef DEVELOPMENT
@@ -28,7 +31,7 @@ import Yesod.Default.Util (addStaticContentExternal)
 #endif
 
 import Hledger
-import Hledger.Cli
+import Hledger.Cli (CliOpts(..), journalReloadIfChanged)
 import Hledger.Web.WebOptions
 
 -- | The site argument for your application. This can be a good place to
@@ -86,7 +89,20 @@ instance Yesod App where
   defaultLayout widget = do
     master <- getYesod
     lastmsg <- getMessage
-        VD{j, opts} <- getViewData
+    VD{am, here, j, opts, q, qopts, showsidebar} <- getViewData
+
+    let journalcurrent = if here == JournalR then "inacct" else "" :: Text
+        ropts = reportopts_ (cliopts_ opts)
+        -- flip the default for items with zero amounts, show them by default
+        ropts' = ropts { empty_ = not (empty_ ropts) }
+        accounts = balanceReportAsHtml RegisterR j qopts $ balanceReport ropts' am j
+
+        topShowmd = if showsidebar then "col-md-4" else "col-any-0" :: Text
+        topShowsm = if showsidebar then "col-sm-4" else "" :: Text
+        sideShowmd = if showsidebar then "col-md-4" else "col-any-0" :: Text
+        sideShowsm = if showsidebar then "col-sm-4" else "" :: Text
+        mainShowmd = if showsidebar then "col-md-8" else "col-md-12" :: Text
+        mainShowsm = if showsidebar then "col-sm-8" else "col-sm-12" :: Text
 
     -- We break up the default layout into two components:
     -- default-layout is the contents of the body tag, and

hledger-web/src/Handler/AddR.hs

@@ -62,7 +62,7 @@ postAddR = do
        Right t -> do
         -- 3. all fields look good and form a balanced transaction; append it to the file
         liftIO (appendTransaction journalfile t)
-        setMessage [shamlet|<span>Transaction added.|]
+        setMessage "Transaction added."
         redirect JournalR
   where
     bail :: [Text] -> Handler ()

hledger-web/src/Handler/Common.hs

@@ -4,80 +4,17 @@
 
 module Handler.Common where
 
-import Import
+import Data.Semigroup ((<>))
-
+import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Calendar (Day, toGregorian)
-import System.FilePath (takeFileName)
 import Text.Blaze (ToMarkup)
 import Text.Blaze.Internal (preEscapedString)
-import Text.Printf (printf)
+import Yesod
 
-import Hledger.Cli.CliOptions
+import Settings (manualurl)
-import Hledger.Data
-import Hledger.Query
-import Hledger.Reports
-import Hledger.Utils
-import Hledger.Web.WebOptions
 
--------------------------------------------------------------------------------
+import Hledger
--- Common page layout
-
--- | Standard hledger-web page layout.
-#if MIN_VERSION_yesod(1,6,0)
-hledgerLayout :: ViewData -> Text -> HtmlUrl AppRoute -> HandlerFor App Html
-#else
-hledgerLayout :: ViewData -> Text -> HtmlUrl AppRoute -> HandlerT App IO Html
-#endif
-hledgerLayout vd title content = do
-  defaultLayout $ do
-      setTitle $ toHtml $ title <> " - hledger-web"
-      toWidget [hamlet|
-         ^{topbar vd}
-         ^{sidebar vd}
-         <div #main-content .col-xs-12 .#{showmd} .#{showsm}>
-          ^{searchform vd}
-          ^{content}
-      |]
-  where
-    showmd = if showsidebar vd then "col-md-8" else "col-md-12" :: Text
-    showsm = if showsidebar vd then "col-sm-8" else "col-sm-12" :: Text
-
--- | Global toolbar/heading area.
-topbar :: ViewData -> HtmlUrl AppRoute
-topbar VD{j, showsidebar} = [hamlet|
-<div#spacer .#{showsm} .#{showmd} .col-xs-2>
- <h1>
-  <button .visible-xs .btn .btn-default type="button" data-toggle="offcanvas">
-   <span .glyphicon .glyphicon-align-left .tgl-icon>
-<div#topbar .col-md-8 .col-sm-8 .col-xs-10>
- <h1>#{title}
-|]
-  where
-    title = takeFileName $ journalFilePath j
-    showmd = if showsidebar then "col-md-4" else "col-any-0" :: Text
-    showsm = if showsidebar then "col-sm-4" else "" :: Text
-
--- | The sidebar used on most views.
-sidebar :: ViewData -> HtmlUrl AppRoute
-sidebar vd@VD{am, here, j, opts, showsidebar} =
- [hamlet|
- <div #sidebar-menu .#{showmd} .#{showsm} .sidebar-offcanvas>
-  <table .main-menu .table>
-   <tr .#{journalcurrent}>
-    <td .top .acct>
-     <a href=@{JournalR} .#{journalcurrent} title="Show general journal entries, most recent first">Journal
-    <td .top>
-   ^{accounts}
-|]
- where
-  journalcurrent = if here == JournalR then "inacct" else "" :: Text
-  ropts = reportopts_ $ cliopts_ opts
-  -- flip the default for items with zero amounts, show them by default
-  ropts' = ropts{empty_=not $ empty_ ropts}
-  accounts = balanceReportAsHtml vd $ balanceReport ropts' am j
-  showmd = if showsidebar then "col-md-4" else "col-any-0" :: Text
-  showsm = if showsidebar then "col-sm-4" else "" :: Text
 
 -- -- | Navigation link, preserving parameters and possibly highlighted.
 -- navlink :: ViewData -> String -> AppRoute -> String -> HtmlUrl AppRoute
@@ -97,67 +34,43 @@ sidebar vd@VD{am, here, j, opts, showsidebar} =
 -- <a#importformlink href="#" onclick="return importformToggle(event)" style="display:none;">import transactions
 -- |]
 
--- | Search form for entering custom queries to filter journal data.
-searchform :: ViewData -> HtmlUrl AppRoute
-searchform VD{q, here} = [hamlet|
-<div#searchformdiv .row>
- <form#searchform .form-inline method=GET>
-  <div .form-group .col-md-12 .col-sm-12 .col-xs-12>
-    <div #searchbar .input-group>
-     <input .form-control name=q value=#{q} title="Enter hledger search patterns to filter the data below" placeholder="Search">
-     <div .input-group-btn>
-      $if not (T.null q)
-       <a href=@{here} .btn .btn-default title="Clear search terms">
-        <span .glyphicon .glyphicon-remove-circle>
-      <button .btn .btn-default type=submit title="Apply search terms">
-       <span .glyphicon .glyphicon-search>
-      <button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal" title="Show search and general help">?
-|]
-
 -- | Link to a topic in the manual.
-helplink :: Text -> Text -> HtmlUrl AppRoute
+helplink :: Text -> Text -> HtmlUrl r
-helplink topic label = [hamlet|
+helplink topic label = [hamlet|<a href=#{u} target=hledgerhelp>#{label}|]
-<a href=#{u} target=hledgerhelp>#{label}
-|]
   where u = manualurl <> if T.null topic then "" else T.cons '#' topic
 
 ----------------------------------------------------------------------
 -- hledger report renderers
 
 -- | Render a "BalanceReport" as html.
-balanceReportAsHtml :: ViewData -> BalanceReport -> HtmlUrl AppRoute
+balanceReportAsHtml :: r -> Journal -> [QueryOpt] -> BalanceReport -> HtmlUrl r
-balanceReportAsHtml VD{j, qopts} (items, total) =
+balanceReportAsHtml registerR j qopts (items, total) = [hamlet|
- [hamlet|
+$forall (acct, adisplay, aindent, abal) <- items
-  $forall i <- items
+  <tr .#{inacctClass acct}>
-   ^{itemAsHtml i}
+    <td .acct>
+      <div .ff-wrapper>
+        \#{indent aindent}
+        <a href="@?{acctLink acct}" .#{inacctClass acct}
+           title="Show transactions affecting this account and subaccounts">
+          #{adisplay}
+        $if hasSubs acct
+          <a href="@?{acctOnlyLink acct}" .only .hidden-sm .hidden-xs
+             title="Show transactions affecting this account but not subaccounts">only
+    <td>
+      ^{mixedAmountAsHtml abal}
 <tr .total>
   <td>
   <td>
-    #{mixedAmountAsHtml total}
+    ^{mixedAmountAsHtml total}
-|]
+|] where
- where
   l = ledgerFromJournal Any j
-   inacctmatcher = inAccountQuery qopts
+  inacctClass acct = case inAccountQuery qopts of
-   itemAsHtml :: BalanceReportItem -> HtmlUrl AppRoute
-   itemAsHtml (acct, adisplay, aindent, abal) = [hamlet|
-<tr .#{inacctclass}>
- <td .acct>
-  <div .ff-wrapper>
-   \#{indent}
-   <a href="@?{acctquery}" .#{inacctclass} title="Show transactions affecting this account and subaccounts">#{adisplay}
-   $if hassubs
-    <a href="@?{acctonlyquery}" .only .hidden-sm .hidden-xs title="Show transactions affecting this account but not subaccounts">only
- <td>
-  #{mixedAmountAsHtml abal}
-|]
-     where
-       hassubs = not $ maybe False (null.asubs) $ ledgerAccount l acct
-       inacctclass = case inacctmatcher of
     Just m' -> if m' `matchesAccount` acct then "inacct" else ""
     Nothing -> "" :: Text
-       indent = preEscapedString $ concat $ replicate (2 * (1+aindent)) "&nbsp;"
+  hasSubs acct = maybe True (not . null . asubs) (ledgerAccount l acct)
-       acctquery = (RegisterR, [("q", accountQuery acct)])
+  indent a = preEscapedString $ concat $ replicate (2 + 2 * a) "&nbsp;"
-       acctonlyquery = (RegisterR, [("q", accountOnlyQuery acct)])
+  acctLink acct = (registerR, [("q", accountQuery acct)])
+  acctOnlyLink acct = (registerR, [("q", accountOnlyQuery acct)])
 
 accountQuery :: AccountName -> Text
 accountQuery = ("inacct:" <>) .  quoteIfSpaced
@@ -165,28 +78,31 @@ accountQuery = ("inacct:" <>) .  quoteIfSpaced
 accountOnlyQuery :: AccountName -> Text
 accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
 
-numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
+numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int, Bool, Bool, TransactionsReportItem)]
 numberTransactionsReportItems [] = []
 numberTransactionsReportItems items = number 0 nulldate items
   where
-    number :: Int -> Day -> [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
+    number :: Int -> Day -> [TransactionsReportItem] -> [(Int, Bool, Bool, TransactionsReportItem)]
     number _ _ [] = []
-    number n prevd (i@(Transaction{tdate=d},_,_,_,_,_):rest)  = (n+1,newday,newmonth,newyear,i): number (n+1) d rest
+    number n prevd (i@(Transaction{tdate=d},_,_,_,_,_):rest) = (n+1, newday, newmonth, i): number (n+1) d rest
       where
         newday = d /= prevd
         newmonth = dm /= prevdm || dy /= prevdy
-          newyear = dy/=prevdy
         (dy, dm, _) = toGregorian d
         (prevdy, prevdm, _) = toGregorian prevd
 
-mixedAmountAsHtml :: MixedAmount -> Html
+mixedAmountAsHtml :: MixedAmount -> HtmlUrl a
-mixedAmountAsHtml b = preEscapedString $ unlines $ map addclass $ lines $ showMixedAmountWithoutPrice b
+mixedAmountAsHtml b = [hamlet|
-    where addclass = printf "<span class=\"%s\">%s</span><br/>" (c :: Text)
+$forall t <- ts
+  <span .#{c}>#{t}
+  <br>
+|] where
+  ts = T.lines . T.pack $ showMixedAmountWithoutPrice b
   c = case isNegativeMixedAmount b of
-            Just True -> "negative amount"
+    Just True -> "negative amount" :: Text
     _         -> "positive amount"
 
-showErrors :: ToMarkup a => [a] -> Handler ()
+showErrors :: ToMarkup a => [a] -> HandlerFor a ()
 showErrors errs = setMessage [shamlet|
 Errors:<br>
 $forall e<-errs

hledger-web/src/Handler/JournalR.hs

@@ -5,9 +5,7 @@ module Handler.JournalR where
 
 import Import
 
-import Handler.Common
+import Handler.Common (accountQuery, mixedAmountAsHtml)
-       (accountQuery, hledgerLayout, mixedAmountAsHtml,
-        numberTransactionsReportItems)
 
 import Hledger.Cli.CliOptions
 import Hledger.Data
@@ -19,14 +17,16 @@ import Hledger.Web.WebOptions
 -- | The formatted journal view, with sidebar.
 getJournalR :: Handler Html
 getJournalR = do
-  vd@VD{j, m, opts, qopts} <- getViewData
+  VD{j, m, opts, qopts} <- getViewData
   -- XXX like registerReportAsHtml
   let title = case inAccount qopts of
         Nothing -> "General Journal"
         Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)"
       title' = title <> if m /= Any then ", filtered" else ""
       maincontent = transactionsReportAsHtml $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
-  hledgerLayout vd "journal" [hamlet|
+  defaultLayout $ do
+    setTitle "journal - hledger-web"
+    toWidget [hamlet|
 <div .row>
   <h2 #contenttitle>#{title'}
   <!-- p>Journal entries record movements of commodities between accounts. -->
@@ -45,18 +45,18 @@ transactionsReportAsHtml (_,items) = [hamlet|
   <th .description style="text-align:left;">Description
   <th .account style="text-align:left;">Account
   <th .amount style="text-align:right;">Amount
- $forall i <- numberTransactionsReportItems items
+ $forall i <- items
   ^{transactionReportItem i}
  |]
 
-transactionReportItem :: (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
+transactionReportItem :: TransactionsReportItem -> HtmlUrl AppRoute
-transactionReportItem (_, _, _, _, (torig, _, split, _, amt, _)) = [hamlet|
+transactionReportItem (torig, _, split, _, amt, _) = [hamlet|
 <tr .title #transaction-#{tindex torig}>
  <td .date nowrap>#{date}
  <td .description colspan=2>#{textElideRight 60 desc}
  <td .amount style="text-align:right;">
   $if showamt
-   \#{mixedAmountAsHtml amt}
+   \^{mixedAmountAsHtml amt}
 $forall p' <- tpostings torig
  <tr .item .posting title="#{show torig}">
   <td .nonhead>
@@ -64,7 +64,7 @@ $forall p' <- tpostings torig
   <td .nonhead>
    &nbsp;
    <a href="@?{acctlink (paccount p')}##{tindex torig}" title="#{paccount p'}">#{elideAccountName 40 $ paccount p'}
-  <td .amount .nonhead style="text-align:right;">#{mixedAmountAsHtml $ pamount p'}
+  <td .amount .nonhead style="text-align:right;">^{mixedAmountAsHtml $ pamount p'}
 |]
      where
        acctlink a = (RegisterR, [("q", accountQuery a)])

hledger-web/src/Handler/RegisterR.hs

@@ -10,7 +10,7 @@ import Data.List (intersperse)
 import qualified Data.Text as T
 import Safe (headMay)
 
-import Handler.Common (hledgerLayout, numberTransactionsReportItems, mixedAmountAsHtml)
+import Handler.Common (mixedAmountAsHtml, numberTransactionsReportItems)
 
 import Hledger
 import Hledger.Cli.CliOptions
@@ -19,15 +19,16 @@ import Hledger.Web.WebOptions
 -- | The main journal/account register view, with accounts sidebar.
 getRegisterR :: Handler Html
 getRegisterR = do
-  vd@VD{j, m, opts, qopts} <- getViewData
+  VD{j, m, opts, qopts} <- getViewData
   let title = a <> s1 <> s2
         where
           (a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts
           s1 = if inclsubs then "" else " (excluding subaccounts)"
           s2 = if m /= Any then ", filtered" else ""
-  hledgerLayout vd "register" $ do
+  defaultLayout $ do
-    _ <- [hamlet|<h2 #contenttitle>#{title}|]
+    setTitle "register - hledger-web"
-    registerReportHtml qopts $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
+    _ <- toWidget [hamlet|<h2 #contenttitle>#{title}|]
+    toWidget $ registerReportHtml qopts $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
 
 -- | Generate html for an account register, including a balance chart and transaction list.
 registerReportHtml :: [QueryOpt] -> TransactionsReport -> HtmlUrl AppRoute
@@ -58,8 +59,8 @@ registerItemsHtml qopts (balancelabel,items) = [hamlet|
    insomeacct = isJust $ inAccount qopts
    balancelabel' = if insomeacct then balancelabel else "Total"
 
-   itemAsHtml :: (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
+   itemAsHtml :: (Int, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
-   itemAsHtml (n, newd, newm, _, (torig, tacct, split, acct, amt, bal)) = [hamlet|
+   itemAsHtml (n, newd, newm, (torig, tacct, split, acct, amt, bal)) = [hamlet|
 <tr ##{tindex torig} .item.#{evenodd}.#{firstposting}.#{datetransition} title="#{show torig}" style="vertical-align:top;">
  <td .date>
   <a href="@{JournalR}#transaction-#{tindex torig}">#{date}
@@ -67,8 +68,8 @@ registerItemsHtml qopts (balancelabel,items) = [hamlet|
  <td .account>#{elideRight 40 acct}
  <td .amount style="text-align:right; white-space:nowrap;">
   $if showamt
-   \#{mixedAmountAsHtml amt}
+   \^{mixedAmountAsHtml amt}
- <td .balance style="text-align:right;">#{mixedAmountAsHtml bal}
+ <td .balance style="text-align:right;">^{mixedAmountAsHtml bal}
 |]
      where
        evenodd = if even n then "even" else "odd" :: Text

hledger-web/templates/default-layout.hamlet

@@ -1,4 +1,38 @@
 $maybe m <- lastmsg
   $if not $ isPrefixOf "Errors" (renderHtml m)
     <div #message>#{m}
+
+<div#spacer .col-xs-2.#{topShowsm}.#{topShowmd}>
+  <h1>
+    <button .visible-xs.btn.btn-default type="button" data-toggle="offcanvas">
+      <span .glyphicon.glyphicon-align-left.tgl-icon>
+
+<div#topbar .col-md-8 .col-sm-8 .col-xs-10>
+  <h1>#{takeFileName (journalFilePath j)}
+
+<div #sidebar-menu .sidebar-offcanvas.#{sideShowmd}.#{sideShowsm}>
+  <table .main-menu .table>
+    <tr .#{journalcurrent}>
+      <td .top .acct>
+        <a href=@{JournalR} .#{journalcurrent}
+           title="Show general journal entries, most recent first">
+          Journal
+      <td .top>
+    ^{accounts}
+
+<div #main-content .col-xs-12.#{mainShowmd}.#{mainShowsm}>
+  <div#searchformdiv .row>
+    <form#searchform .form-inline method=GET>
+      <div .form-group .col-md-12 .col-sm-12 .col-xs-12>
+        <div #searchbar .input-group>
+          <input .form-control name=q value=#{q} placeholder="Search"
+            title="Enter hledger search patterns to filter the data below">
+          <div .input-group-btn>
+            $if not (T.null q)
+              <a href=@{here} .btn .btn-default title="Clear search terms">
+                <span .glyphicon .glyphicon-remove-circle>
+            <button .btn .btn-default type=submit title="Apply search terms">
+              <span .glyphicon .glyphicon-search>
+            <button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal"
+               title="Show search and general help">?
   ^{widget}