slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

web: begin moving inline templates to files

Browse Source
This commit is contained in:
Simon Michael 2011-05-24 20:10:17 +00:00
parent dc6c3dec76
commit de8943b01b
4 changed files with 162 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
hledger-web/.hledger/web/templates/default-layout.hamlet
View File

@ -1,9 +1,18 @@
!!! !!!
<html <html
<head <head
<title>#{pageTitle pc} <title>#{pageTitle pc}
^{pageHead pc} ^{pageHead pc}
<body <script type=text/javascript src=@{StaticR jquery_js}
$maybe msg <- mmsg <script type=text/javascript src=@{StaticR jquery_url_js}
<div #message>#{msg} <script type=text/javascript src=@{StaticR dhtmlxcommon_js}
^{pageBody pc} <script type=text/javascript src=@{StaticR dhtmlxcombo_js}
<script type=text/javascript src=@{StaticR hledger_js}
<link rel=stylesheet type=text/css media=all href=@{StaticR style_css}
<body
<!-- {navbar td} -->
$maybe msg <- mmsg
<div #message>#{msg}
<!-- <div#messages>{m} -->
<div#content
^{pageBody pc}

91
hledger-web/App.hs
View File

@ -11,21 +11,38 @@ module App
, StaticRoute (..) , StaticRoute (..)
, lift , lift
, liftIO , liftIO
,getHandlerData
) where ) where
import Yesod.Core
import Yesod.Helpers.Static
import qualified Settings
import System.Directory
import qualified Data.ByteString.Lazy as L
import Settings (hamletFile, cassiusFile, juliusFile, widgetFile)
import Control.Monad (unless) import Control.Monad (unless)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T import qualified Data.Text as T
import System.Directory
import qualified Data.ByteString.Lazy as L
import Yesod.Core
import Yesod.Helpers.Static
import Hledger.Cli.Options (Opt) import Control.Applicative ((<$>)) --, (<*>))
import Hledger.Data (Journal) import Data.Text(Text,pack,unpack)
import System.FilePath (takeFileName) --(</>))
import System.IO.Storage (putValue, getValue)
import Text.Hamlet hiding (hamletFile)
import Text.ParserCombinators.Parsec hiding (string)
import Hledger.Cli.Options
import Hledger.Data
import Hledger.Cli.Balance
import Hledger.Cli.Print
import Hledger.Cli.Register
import Hledger.Cli.Options hiding (value)
import Hledger.Cli.Utils
import Hledger.Cli.Version (version)
import Hledger.Data hiding (insert, today)
import Settings
import StaticFiles
-- | The site argument for your application. This can be a good place to -- | The site argument for your application. This can be a good place to
-- keep settings and values requiring initialization before your application -- keep settings and values requiring initialization before your application
@ -74,6 +91,7 @@ instance Yesod App where
approot = appRoot approot = appRoot
defaultLayout widget = do defaultLayout widget = do
-- (a, p, opts, fspec, j, msg, here) <- getHandlerData
mmsg <- getMessage mmsg <- getMessage
pc <- widgetToPageContent $ do pc <- widgetToPageContent $ do
widget widget
@ -97,4 +115,59 @@ instance Yesod App where
let fn' = statictmp ++ fn let fn' = statictmp ++ fn
exists <- liftIO $ doesFileExist fn' exists <- liftIO $ doesFileExist fn'
unless exists $ liftIO $ L.writeFile fn' content unless exists $ liftIO $ L.writeFile fn' content
return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], []) return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], [])
-- | Gather the data useful for a hledger web request handler, including:
-- initial command-line options, current a and p query string values, a
-- journal filter specification based on the above and the current time,
-- an up-to-date parsed journal, the current route, and the current ui
-- message if any.
getHandlerData :: Handler (String, String, [Opt], FilterSpec, Journal, Maybe Html, AppRoute)
getHandlerData = do
Just here' <- getCurrentRoute
(a, p, opts, fspec) <- getReportParameters
(j, err) <- getLatestJournal opts
msg <- getMessage' err
return (a, p, opts, fspec, j, msg, here')
where
-- | Get current report parameters for this request.
getReportParameters :: Handler (String, String, [Opt], FilterSpec)
getReportParameters = do
app <- getYesod
t <- liftIO $ getCurrentLocalTime
a <- fromMaybe "" <$> lookupGetParam "a"
p <- fromMaybe "" <$> lookupGetParam "p"
let (a',p') = (unpack a, unpack p)
opts = appOpts app ++ [Period p']
args = appArgs app ++ words' a'
fspec = optsToFilterSpec opts args t
return (a', p', opts, fspec)
-- | Quote-sensitive words, ie don't split on spaces which are inside quotes.
words' :: String -> [String]
words' = fromparse . parsewith ((quotedPattern <|> pattern) `sepBy` many1 spacenonewline)
where
pattern = many (noneOf " \n\r\"")
quotedPattern = between (oneOf "'\"") (oneOf "'\"") $ many $ noneOf "'\""
-- | Update our copy of the journal if the file changed. If there is an
-- error while reloading, keep the old one and return the error, and set a
-- ui message.
getLatestJournal :: [Opt] -> Handler (Journal, Maybe String)
getLatestJournal opts = do
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
(jE, changed) <- liftIO $ journalReloadIfChanged opts j
if not changed
then return (j,Nothing)
else case jE of
Right j' -> do liftIO $ putValue "hledger" "journal" j'
return (j',Nothing)
Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-}
return (j, Just e)
-- | Helper to work around a yesod feature (can't set and get a message in the same request.)
getMessage' :: Maybe String -> Handler (Maybe Html)
getMessage' newmsgstr = do
oldmsg <- getMessage
return $ maybe oldmsg (Just . toHtml) newmsgstr

163
hledger-web/Handlers.hs
View File

@ -5,7 +5,7 @@ import Control.Applicative ((<$>)) --, (<*>))
import Data.Text(Text,pack,unpack) import Data.Text(Text,pack,unpack)
import System.FilePath (takeFileName) --(</>)) import System.FilePath (takeFileName) --(</>))
import System.IO.Storage (putValue, getValue) import System.IO.Storage (putValue, getValue)
import Text.Hamlet import Text.Hamlet hiding (hamletFile)
import Text.ParserCombinators.Parsec hiding (string) import Text.ParserCombinators.Parsec hiding (string)
import Hledger.Cli.Balance import Hledger.Cli.Balance
@ -27,14 +27,38 @@ import StaticFiles
getRootR :: Handler RepHtml getRootR :: Handler RepHtml
getRootR = redirect RedirectTemporary defaultroute where defaultroute = JournalR getRootR = redirect RedirectTemporary defaultroute where defaultroute = JournalR
-- defaultLayout $ do
-- h2id <- lift newIdent
-- setTitle "hledger-web homepage"
-- addWidget $(widgetFile "homepage")
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | A combined accounts and journal view. -- | A combined accounts and journal view.
-- old inline version
getJournalR1 :: Handler RepHtml
getJournalR1 = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData
today <- liftIO getCurrentDay
-- app <- getYesod
-- t <- liftIO $ getCurrentLocalTime
let -- args = appArgs app
-- fspec' = optsToFilterSpec opts args t
sidecontent = balanceReportAsHtml opts td $ balanceReport opts fspec j
maincontent = journalReportAsHtml opts td $ journalReport opts fspec j
td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td
hamletToRepHtml $ pageLayout td [$hamlet|
<div#content
<div#sidebar
^{sidecontent}
<div#main.journal
^{navlinks td}
<div#transactions
^{filterform td}
^{maincontent}
^{addform td}
^{editform'}
^{importform}
|]
-- new widget file version
getJournalR :: Handler RepHtml getJournalR :: Handler RepHtml
getJournalR = do getJournalR = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData (a, p, opts, fspec, j, msg, here) <- getHandlerData
@ -47,19 +71,10 @@ getJournalR = do
maincontent = journalReportAsHtml opts td $ journalReport opts fspec j maincontent = journalReportAsHtml opts td $ journalReport opts fspec j
td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today} td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td editform' = editform td
hamletToRepHtml $ pageLayout td [hamlet| defaultLayout $ do
<div#content h2id <- lift newIdent
<div#sidebar setTitle "hledger-web journal view"
^{sidecontent} addHamlet $(Settings.hamletFile "journal")
<div#main.journal
^{navlinks td}
<div#transactions
^{filterform td}
^{maincontent}
^{addform td}
^{editform'}
^{importform}
|]
-- postJournalR :: Handler RepPlain -- postJournalR :: Handler RepPlain
-- postJournalR = postJournalOnlyR -- postJournalR = postJournalOnlyR
@ -80,7 +95,7 @@ getRegisterR = do
maincontent = registerReportAsHtml opts td $ registerReport opts fspec j maincontent = registerReportAsHtml opts td $ registerReport opts fspec j
td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today} td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td editform' = editform td
hamletToRepHtml $ pageLayout td [hamlet| hamletToRepHtml $ pageLayout td [$hamlet|
<div#content <div#content
<div#sidebar <div#sidebar
^{sidecontent} ^{sidecontent}
@ -109,7 +124,7 @@ getAccountsOnlyR = do
-- | Render a balance report as HTML. -- | Render a balance report as HTML.
balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Hamlet AppRoute balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Hamlet AppRoute
balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = [hamlet| balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = [$hamlet|
^{accountsheading} ^{accountsheading}
<table.balancereport> <table.balancereport>
$forall i <- items $forall i <- items
@ -121,7 +136,7 @@ balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = [hamlet|
<td align=right>#{mixedAmountAsHtml total} <td align=right>#{mixedAmountAsHtml total}
|] |]
where where
accountsheading = [hamlet| accountsheading = [$hamlet|
<span#accountsheading <span#accountsheading
accounts accounts
\ # \ #
@ -129,20 +144,20 @@ balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = [hamlet|
|] :: Hamlet AppRoute |] :: Hamlet AppRoute
where where
filteringaccts = not $ null a filteringaccts = not $ null a
showlinks = [hamlet|<span#showmoreaccounts>^{showmore} ^{showall}|] :: Hamlet AppRoute showlinks = [$hamlet|<span#showmoreaccounts>^{showmore} ^{showall}|] :: Hamlet AppRoute
showmore = case (filteringaccts, items) of showmore = case (filteringaccts, items) of
-- cunning parent account logic -- cunning parent account logic
(True, ((acct, _, _, _):_)) -> (True, ((acct, _, _, _):_)) ->
let a' = if isAccountRegex a then a else acct let a' = if isAccountRegex a then a else acct
a'' = accountNameToAccountRegex $ parentAccountName $ accountRegexToAccountName a' a'' = accountNameToAccountRegex $ parentAccountName $ accountRegexToAccountName a'
parenturl = (here, [("a",pack a''), ("p",pack p)]) parenturl = (here, [("a",pack a''), ("p",pack p)])
in [hamlet| in [$hamlet|
\ | # \ | #
<a href=@?{parenturl}>show more &uarr; <a href=@?{parenturl}>show more &uarr;
|] |]
_ -> nulltemplate _ -> nulltemplate
showall = if filteringaccts showall = if filteringaccts
then [hamlet| then [$hamlet|
\ | # \ | #
<a href=@?{allurl}>show all <a href=@?{allurl}>show all
|] |]
@ -150,7 +165,7 @@ balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = [hamlet|
where allurl = (here, [("p",pack p)]) where allurl = (here, [("p",pack p)])
itemAsHtml' = itemAsHtml td itemAsHtml' = itemAsHtml td
itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet AppRoute itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet AppRoute
itemAsHtml TD{p=p} (acct, adisplay, adepth, abal) = [hamlet| itemAsHtml TD{p=p} (acct, adisplay, adepth, abal) = [$hamlet|
<tr.item <tr.item
<td.account <td.account
#{indent} #{indent}
@ -181,7 +196,7 @@ getJournalOnlyR = do
let td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today} let td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td editform' = editform td
txns = journalReportAsHtml opts td $ journalReport opts fspec j txns = journalReportAsHtml opts td $ journalReport opts fspec j
hamletToRepHtml $ pageLayout td [hamlet| hamletToRepHtml $ pageLayout td [$hamlet|
<div#journal <div#journal
<div.nav2 <div.nav2
<a#addformlink href onclick="return addformToggle(event)" add one transaction <a#addformlink href onclick="return addformToggle(event)" add one transaction
@ -194,7 +209,7 @@ getJournalOnlyR = do
-- | Render a journal report as HTML. -- | Render a journal report as HTML.
journalReportAsHtml :: [Opt] -> TemplateData -> JournalReport -> Hamlet AppRoute journalReportAsHtml :: [Opt] -> TemplateData -> JournalReport -> Hamlet AppRoute
journalReportAsHtml _ td items = [hamlet| journalReportAsHtml _ td items = [$hamlet|
<table.journalreport> <table.journalreport>
$forall i <- number items $forall i <- number items
^{itemAsHtml' i} ^{itemAsHtml' i}
@ -203,7 +218,7 @@ journalReportAsHtml _ td items = [hamlet|
number = zip [1..] number = zip [1..]
itemAsHtml' = itemAsHtml td itemAsHtml' = itemAsHtml td
itemAsHtml :: TemplateData -> (Int, JournalReportItem) -> Hamlet AppRoute itemAsHtml :: TemplateData -> (Int, JournalReportItem) -> Hamlet AppRoute
itemAsHtml _ (n, t) = [hamlet| itemAsHtml _ (n, t) = [$hamlet|
<tr.item.#{evenodd} > <tr.item.#{evenodd} >
<td.transaction> <td.transaction>
<pre> #{txn} <pre> #{txn}
@ -212,7 +227,7 @@ journalReportAsHtml _ td items = [hamlet|
txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse
addform :: TemplateData -> Hamlet AppRoute addform :: TemplateData -> Hamlet AppRoute
addform td = [hamlet| addform td = [$hamlet|
<script type=text/javascript> <script type=text/javascript>
$(document).ready(function() { $(document).ready(function() {
/* dhtmlxcombo setup */ /* dhtmlxcombo setup */
@ -270,7 +285,7 @@ addform td = [hamlet|
manyfiles = (length $ files $ j td) > 1 manyfiles = (length $ files $ j td) > 1
postingsfields :: TemplateData -> Hamlet AppRoute postingsfields :: TemplateData -> Hamlet AppRoute
postingsfields td = [hamlet| postingsfields td = [$hamlet|
^{p1} ^{p1}
^{p2} ^{p2}
|] |]
@ -279,7 +294,7 @@ postingsfields td = [hamlet|
p2 = postingfields td 2 p2 = postingfields td 2
postingfields :: TemplateData -> Int -> Hamlet AppRoute postingfields :: TemplateData -> Int -> Hamlet AppRoute
postingfields TD{j=j} n = [hamlet| postingfields TD{j=j} n = [$hamlet|
<tr#postingrow <tr#postingrow
<td align=right>#{acctlabel}: <td align=right>#{acctlabel}:
<td <td
@ -304,7 +319,7 @@ postingfields TD{j=j} n = [hamlet|
(acctlabel, accthelp, amtfield, amthelp) (acctlabel, accthelp, amtfield, amthelp)
| n == 1 = ("To account" | n == 1 = ("To account"
,"eg: expenses:food" ,"eg: expenses:food"
,[hamlet| ,[$hamlet|
<td style=padding-left:1em; <td style=padding-left:1em;
Amount: Amount:
<td <td
@ -319,7 +334,7 @@ postingfields TD{j=j} n = [hamlet|
) )
editform :: TemplateData -> Hamlet AppRoute editform :: TemplateData -> Hamlet AppRoute
editform TD{j=j} = [hamlet| editform TD{j=j} = [$hamlet|
<form#editform method=POST style=display:none; <form#editform method=POST style=display:none;
<table.form#editform <table.form#editform
$if manyfiles $if manyfiles
@ -346,14 +361,14 @@ editform TD{j=j} = [hamlet|
formathelp = helplink "file-format" "file format help" formathelp = helplink "file-format" "file format help"
journalselect :: [(FilePath,String)] -> Hamlet AppRoute journalselect :: [(FilePath,String)] -> Hamlet AppRoute
journalselect journalfiles = [hamlet| journalselect journalfiles = [$hamlet|
<select id=journalselect name=journal onchange="editformJournalSelect(event)" <select id=journalselect name=journal onchange="editformJournalSelect(event)"
$forall f <- journalfiles $forall f <- journalfiles
<option value=#{fst f}>#{fst f} <option value=#{fst f}>#{fst f}
|] |]
importform :: Hamlet AppRoute importform :: Hamlet AppRoute
importform = [hamlet| importform = [$hamlet|
<form#importform method=POST style=display:none; <form#importform method=POST style=display:none;
<table.form <table.form
<tr <tr
@ -510,7 +525,7 @@ getRegisterOnlyR = do
-- | Render a register report as HTML. -- | Render a register report as HTML.
registerReportAsHtml :: [Opt] -> TemplateData -> RegisterReport -> Hamlet AppRoute registerReportAsHtml :: [Opt] -> TemplateData -> RegisterReport -> Hamlet AppRoute
registerReportAsHtml _ td items = [hamlet| registerReportAsHtml _ td items = [$hamlet|
<table.registerreport <table.registerreport
<tr.headings <tr.headings
^{headings} ^{headings}
@ -519,7 +534,7 @@ registerReportAsHtml _ td items = [hamlet|
|] |]
where where
number = zip [1..] number = zip [1..]
headings = [hamlet| headings = [$hamlet|
<th.date align=left Date <th.date align=left Date
<th.description align=left Description <th.description align=left Description
<th.account align=left Account <th.account align=left Account
@ -528,7 +543,7 @@ registerReportAsHtml _ td items = [hamlet|
|] :: Hamlet AppRoute |] :: Hamlet AppRoute
itemAsHtml' = itemAsHtml td itemAsHtml' = itemAsHtml td
itemAsHtml :: TemplateData -> (Int, RegisterReportItem) -> Hamlet AppRoute itemAsHtml :: TemplateData -> (Int, RegisterReportItem) -> Hamlet AppRoute
itemAsHtml TD{here=here,p=p} (n, (ds, posting, b)) = [hamlet| itemAsHtml TD{here=here,p=p} (n, (ds, posting, b)) = [$hamlet|
<tr.item.#{evenodd}.#{firstposting} <tr.item.#{evenodd}.#{firstposting}
<td.date>#{date} <td.date>#{date}
<td.description>#{desc} <td.description>#{desc}
@ -554,7 +569,7 @@ mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "<br>" $ lines $
---------------------------------------------------------------------- ----------------------------------------------------------------------
nulltemplate :: Hamlet AppRoute nulltemplate :: Hamlet AppRoute
nulltemplate = [hamlet||] nulltemplate = [$hamlet||]
-- | A bundle of useful data passed to templates. -- | A bundle of useful data passed to templates.
data TemplateData = TD { data TemplateData = TD {
@ -578,63 +593,9 @@ mktd = TD {
,today = ModifiedJulianDay 0 ,today = ModifiedJulianDay 0
} }
-- | Gather the data useful for a hledger web request handler, including:
-- initial command-line options, current a and p query string values, a
-- journal filter specification based on the above and the current time,
-- an up-to-date parsed journal, the current route, and the current ui
-- message if any.
getHandlerData :: Handler (String, String, [Opt], FilterSpec, Journal, Maybe Html, AppRoute)
getHandlerData = do
Just here' <- getCurrentRoute
(a, p, opts, fspec) <- getReportParameters
(j, err) <- getLatestJournal opts
msg <- getMessage' err
return (a, p, opts, fspec, j, msg, here')
where
-- | Get current report parameters for this request.
getReportParameters :: Handler (String, String, [Opt], FilterSpec)
getReportParameters = do
app <- getYesod
t <- liftIO $ getCurrentLocalTime
a <- fromMaybe "" <$> lookupGetParam "a"
p <- fromMaybe "" <$> lookupGetParam "p"
let (a',p') = (unpack a, unpack p)
opts = appOpts app ++ [Period p']
args = appArgs app ++ words' a'
fspec = optsToFilterSpec opts args t
return (a', p', opts, fspec)
-- | Quote-sensitive words, ie don't split on spaces which are inside quotes.
words' :: String -> [String]
words' = fromparse . parsewith ((quotedPattern <|> pattern) `sepBy` many1 spacenonewline)
where
pattern = many (noneOf " \n\r\"")
quotedPattern = between (oneOf "'\"") (oneOf "'\"") $ many $ noneOf "'\""
-- | Update our copy of the journal if the file changed. If there is an
-- error while reloading, keep the old one and return the error, and set a
-- ui message.
getLatestJournal :: [Opt] -> Handler (Journal, Maybe String)
getLatestJournal opts = do
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
(jE, changed) <- liftIO $ journalReloadIfChanged opts j
if not changed
then return (j,Nothing)
else case jE of
Right j' -> do liftIO $ putValue "hledger" "journal" j'
return (j',Nothing)
Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-}
return (j, Just e)
-- | Helper to work around a yesod feature (can't set and get a message in the same request.)
getMessage' :: Maybe String -> Handler (Maybe Html)
getMessage' newmsgstr = do
oldmsg <- getMessage
return $ maybe oldmsg (Just . toHtml) newmsgstr
-- | Wrap a template with the standard hledger web ui page layout. -- | Wrap a template with the standard hledger web ui page layout.
pageLayout :: TemplateData -> Hamlet AppRoute -> Hamlet AppRoute pageLayout :: TemplateData -> Hamlet AppRoute -> Hamlet AppRoute
pageLayout td@TD{title=basetitle, msg=msg, p=p, j=j, today=today} content = [hamlet| pageLayout td@TD{title=basetitle, msg=msg, p=p, j=j, today=today} content = [$hamlet|
!!! !!!
<html <html
<head <head
@ -659,7 +620,7 @@ pageLayout td@TD{title=basetitle, msg=msg, p=p, j=j, today=today} content = [ham
-- | Global toolbar/heading area. -- | Global toolbar/heading area.
navbar :: TemplateData -> Hamlet AppRoute navbar :: TemplateData -> Hamlet AppRoute
navbar TD{p=p,j=j,today=today} = [hamlet| navbar TD{p=p,j=j,today=today} = [$hamlet|
<div#navbar <div#navbar
<a.topleftlink href=#{hledgerorgurl} <a.topleftlink href=#{hledgerorgurl}
hledger-web hledger-web
@ -685,7 +646,7 @@ journalTitleDesc j p today = (title, desc)
-- | Links to the main views. -- | Links to the main views.
navlinks :: TemplateData -> Hamlet AppRoute navlinks :: TemplateData -> Hamlet AppRoute
navlinks td = [hamlet| navlinks td = [$hamlet|
<div#navlinks <div#navlinks
^{accountsjournallink} ^{accountsjournallink}
\ | # \ | #
@ -702,7 +663,7 @@ navlinks td = [hamlet|
accountsregisterlink = navlink td "register" RegisterR accountsregisterlink = navlink td "register" RegisterR
navlink :: TemplateData -> String -> AppRoute -> Hamlet AppRoute navlink :: TemplateData -> String -> AppRoute -> Hamlet AppRoute
navlink TD{here=here,a=a,p=p} s dest = [hamlet|<a##{s}link.#{style} href=@?{u}>#{s}|] navlink TD{here=here,a=a,p=p} s dest = [$hamlet|<a##{s}link.#{style} href=@?{u}>#{s}|]
where u = (dest, concat [(if null a then [] else [("a", pack a)]) where u = (dest, concat [(if null a then [] else [("a", pack a)])
,(if null p then [] else [("p", pack p)])]) ,(if null p then [] else [("p", pack p)])])
style | dest == here = "navlinkcurrent" style | dest == here = "navlinkcurrent"
@ -710,7 +671,7 @@ navlink TD{here=here,a=a,p=p} s dest = [hamlet|<a##{s}link.#{style} href=@?{u}>#
-- | Form controlling journal filtering parameters. -- | Form controlling journal filtering parameters.
filterform :: TemplateData -> Hamlet AppRoute filterform :: TemplateData -> Hamlet AppRoute
filterform TD{here=here,a=a,p=p} = [hamlet| filterform TD{here=here,a=a,p=p} = [$hamlet|
<div#filterformdiv <div#filterformdiv
<form#filterform.form method=GET style=display:#{visible}; <form#filterform.form method=GET style=display:#{visible};
<table.form <table.form
@ -745,13 +706,13 @@ filterform TD{here=here,a=a,p=p} = [hamlet|
visible = "block" :: String visible = "block" :: String
filteringclass = if filtering then "filtering" else "" :: String filteringclass = if filtering then "filtering" else "" :: String
filteringperiodclass = if filteringperiod then "filtering" else "" :: String filteringperiodclass = if filteringperiod then "filtering" else "" :: String
stopfiltering = if filtering then [hamlet|<a#stopfilterlink href=@?{u}>clear filter|] else nulltemplate stopfiltering = if filtering then [$hamlet|<a#stopfilterlink href=@?{u}>clear filter|] else nulltemplate
where u = (here, if filteringperiod then [("p", pack p)] else []) where u = (here, if filteringperiod then [("p", pack p)] else [])
stopfilteringperiod = if filteringperiod then [hamlet|<a#stopfilterlink href=@?{u}>clear filter|] else nulltemplate stopfilteringperiod = if filteringperiod then [$hamlet|<a#stopfilterlink href=@?{u}>clear filter|] else nulltemplate
where u = (here, if filtering then [("a", pack a)] else []) where u = (here, if filtering then [("a", pack a)] else [])
-- | Link to a topic in the manual. -- | Link to a topic in the manual.
helplink :: String -> String -> Hamlet AppRoute helplink :: String -> String -> Hamlet AppRoute
helplink topic label = [hamlet|<a href=#{u} target=hledgerhelp>#{label}|] helplink topic label = [$hamlet|<a href=#{u} target=hledgerhelp>#{label}|]
where u = manualurl ++ if null topic then "" else '#':topic where u = manualurl ++ if null topic then "" else '#':topic

4
hledger-web/hledger-web.cabal
View File

@ -59,7 +59,7 @@ executable hledger-web
Handlers Handlers
build-depends: build-depends:
hledger == 0.14.98 hledger == 0.14.98
,hledger-lib == 0.14 ,hledger-lib == 0.14.98
-- ,HUnit -- ,HUnit
,base >= 4 && < 5 ,base >= 4 && < 5
,bytestring ,bytestring
@ -86,7 +86,7 @@ executable hledger-web
,template-haskell >= 2.4 && < 2.6 ,template-haskell >= 2.4 && < 2.6
-- ,yesod >= 0.8 && < 0.9 -- ,yesod >= 0.8 && < 0.9
,yesod-core >= 0.8 && < 0.9 ,yesod-core >= 0.8 && < 0.9
,yesod-static ,yesod-static == 0.1.0
,hamlet == 0.8.* ,hamlet == 0.8.*
,transformers ,transformers
,wai ,wai