web: Add yesod-form-generated AddForm, add GET & POST /add

This commit is contained in:
Jakub Zárybnický 2018-06-12 18:56:53 +02:00
parent ee36b529e7
commit cc1241fa20
24 changed files with 504 additions and 545 deletions

View File

@ -4,9 +4,6 @@
/ RootR GET
/journal JournalR GET
/register RegisterR GET
/add AddR POST
/edit EditR POST
/import ImportR POST
-- /accounts AccountsR GET
-- /api/accounts AccountsJsonR GET
/add AddR GET POST
/edit EditR GET POST
/import ImportR GET POST

View File

@ -123,14 +123,12 @@ library
exposed-modules:
Application
Foundation
Handler.AddForm
Handler.AddR
Handler.Common
Handler.EditR
Handler.ImportR
Handler.JournalR
Handler.RegisterR
Handler.RootR
Hledger.Web
Hledger.Web.Main
Hledger.Web.WebOptions
@ -138,6 +136,8 @@ library
Settings
Settings.Development
Settings.StaticFiles
Widget.AddForm
Widget.Common
other-modules:
Paths_hledger_web
ghc-options: -Wall

View File

@ -118,14 +118,12 @@ library:
exposed-modules:
- Application
- Foundation
- Handler.AddForm
- Handler.AddR
- Handler.Common
- Handler.EditR
- Handler.ImportR
- Handler.JournalR
- Handler.RegisterR
- Handler.RootR
- Hledger.Web
- Hledger.Web.Main
- Hledger.Web.WebOptions
@ -133,6 +131,8 @@ library:
- Settings
- Settings.Development
- Settings.StaticFiles
- Widget.AddForm
- Widget.Common
executables:
hledger-web:

View File

@ -1,10 +1,10 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP, OverloadedStrings, TemplateHaskell #-}
module Application
( makeApplication
, getApplicationDev
, makeFoundation
) where
( makeApplication
, getApplicationDev
, makeFoundation
) where
import Import
@ -15,15 +15,13 @@ import Network.HTTP.Client (defaultManagerSettings)
import Network.HTTP.Conduit (newManager)
import Yesod.Default.Config
import Yesod.Default.Main (defaultDevelApp)
import Yesod.Default.Handlers (getFaviconR, getRobotsR)
import Handler.AddR (postAddR)
import Handler.EditR (postEditR)
import Handler.ImportR (postImportR)
import Handler.AddR (getAddR, postAddR)
import Handler.Common (getFaviconR, getRobotsR, getRootR)
import Handler.EditR (getEditR, postEditR)
import Handler.ImportR (getImportR, postImportR)
import Handler.JournalR (getJournalR)
import Handler.RegisterR (getRegisterR)
import Handler.RootR (getRootR)
import Hledger.Data (Journal, nulljournal)
import Hledger.Read (readJournalFile)
import Hledger.Utils (error')
@ -46,7 +44,7 @@ makeApplication opts' j' conf' = do
logWare <$> toWaiAppPlain foundation
where
logWare | development = logStdoutDev
| serve_ opts' = logStdout
| serve_ opts' = logStdout
| otherwise = id
makeFoundation :: AppConfig DefaultEnv Extra -> WebOpts -> IO App

View File

@ -6,7 +6,6 @@
module Foundation where
import Data.IORef (IORef, readIORef, writeIORef)
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
@ -14,16 +13,15 @@ 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)
import Yesod
import Yesod.Static
import Yesod.Default.Config
import Handler.AddForm
import Handler.Common (balanceReportAsHtml)
import Settings (Extra(..), widgetFile)
import Settings.StaticFiles
import Settings (widgetFile, Extra (..))
import Widget.Common (balanceReportAsHtml)
#ifndef DEVELOPMENT
import Settings (staticDir)
import Text.Jasmine (minifym)
@ -87,7 +85,8 @@ instance Yesod App where
defaultLayout widget = do
master <- getYesod
VD{am, here, j, opts, q, qopts, showsidebar} <- getViewData
here <- fromMaybe RootR <$> getCurrentRoute
VD {am, j, opts, q, qopts, showsidebar} <- getViewData
msg <- getMessage
let journalcurrent = if here == JournalR then "inacct" else "" :: Text
@ -152,18 +151,17 @@ instance RenderMessage App FormMessage where
-- XXX Parameter p - show/hide postings
-- | A bundle of data useful for hledger-web request handlers and templates.
data ViewData = VD {
opts :: WebOpts -- ^ the command-line options at startup
,here :: AppRoute -- ^ the current route
,today :: Day -- ^ today's date (for queries containing relative dates)
,j :: Journal -- ^ the up-to-date parsed unfiltered journal
,q :: Text -- ^ the current q parameter, the main query expression
,m :: Query -- ^ a query parsed from the q parameter
,qopts :: [QueryOpt] -- ^ query options parsed from the q parameter
,am :: Query -- ^ a query parsed from the accounts sidebar query expr ("a" parameter)
,aopts :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr
,showsidebar :: Bool -- ^ current showsidebar cookie value
} deriving (Show)
data ViewData = VD
{ opts :: WebOpts -- ^ the command-line options at startup
, today :: Day -- ^ today's date (for queries containing relative dates)
, j :: Journal -- ^ the up-to-date parsed unfiltered journal
, q :: Text -- ^ the current q parameter, the main query expression
, m :: Query -- ^ a query parsed from the q parameter
, qopts :: [QueryOpt] -- ^ query options parsed from the q parameter
, am :: Query -- ^ a query parsed from the accounts sidebar query expr ("a" parameter)
, aopts :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr
, showsidebar :: Bool -- ^ current showsidebar cookie value
} deriving (Show)
instance Show Text.Blaze.Markup where show _ = "<blaze markup>"
@ -178,7 +176,6 @@ viewdataWithDateAndParams d q a =
(acctsmatcher, acctsopts) = parseQuery d a
in VD
{ opts = defwebopts
, here = RootR
, today = d
, j = nulljournal
, q = q
@ -191,22 +188,20 @@ viewdataWithDateAndParams d q a =
-- | Gather data used by handlers and templates in the current request.
getViewData :: Handler ViewData
getViewData = getCurrentRoute >>= \case
Nothing -> return nullviewdata
Just here -> do
App {appOpts, appJournal = jref} <- getYesod
let opts@WebOpts {cliopts_ = copts@CliOpts {reportopts_ = ropts}} = appOpts
today <- liftIO getCurrentDay
(j, merr) <- getCurrentJournal jref copts {reportopts_ = ropts {no_elide_ = True}} today
case merr of
Just err -> setMessage (toHtml err)
Nothing -> pure ()
q <- fromMaybe "" <$> lookupGetParam "q"
a <- fromMaybe "" <$> lookupGetParam "a"
showsidebar <- shouldShowSidebar
return
(viewdataWithDateAndParams today q a)
{here, j, opts, showsidebar, today}
getViewData = do
App {appOpts, appJournal = jref} <- getYesod
let opts@WebOpts {cliopts_ = copts@CliOpts {reportopts_ = ropts}} = appOpts
today <- liftIO getCurrentDay
(j, merr) <- getCurrentJournal jref copts {reportopts_ = ropts {no_elide_ = True}} today
case merr of
Just err -> setMessage (toHtml err)
Nothing -> pure ()
q <- fromMaybe "" <$> lookupGetParam "q"
a <- fromMaybe "" <$> lookupGetParam "a"
showsidebar <- shouldShowSidebar
return
(viewdataWithDateAndParams today q a)
{j, opts, showsidebar, today}
-- | Find out if the sidebar should be visible. Show it, unless there is a
-- showsidebar cookie set to "0", or a ?sidebar=0 query parameter.

View File

@ -1,61 +0,0 @@
-- | Add form data & handler. (The layout and js are defined in
-- Foundation so that the add form can be in the default layout for
-- all views.)
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Handler.AddForm
( AddForm(..)
, addForm
, addFormHamlet
) where
import Data.List (sort, nub)
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
import Text.Blaze.Internal (preEscapedString)
import Text.Hamlet (hamletFile)
import Text.JSON
import Yesod (HtmlUrl, HandlerSite, RenderMessage)
import Yesod.Form
import Hledger
-- Part of the data required from the add form.
-- Don't know how to handle the variable posting fields with yesod-form yet.
-- XXX Variable postings fields
data AddForm = AddForm
{ addFormDate :: Day
, addFormDescription :: Maybe Text
, addFormJournalFile :: Maybe Text
} deriving Show
addForm :: (RenderMessage (HandlerSite m) FormMessage, Monad m) => Day -> Journal -> FormInput m AddForm
addForm today j = AddForm
<$> ireq (checkMMap (pure . validateDate) (T.pack . show) textField) "date"
<*> iopt textField "description"
<*> iopt (check validateJournalFile textField) "journal"
where
validateJournalFile :: Text -> Either FormMessage Text
validateJournalFile f
| T.unpack f `elem` journalFilePaths j = Right f
| otherwise = Left $ MsgInvalidEntry $ "the selected journal file \"" <> f <> "\"is unknown"
validateDate :: Text -> Either FormMessage Day
validateDate s = case fixSmartDateStrEither' today (T.strip s) of
Right d -> Right d
Left _ -> Left $ MsgInvalidEntry $ "could not parse date \"" <> s <> "\":"
addFormHamlet :: Journal -> t -> HtmlUrl t
addFormHamlet j r = $(hamletFile "templates/add-form.hamlet")
where
descriptions = sort $ nub $ tdescription <$> jtxns j
accts = journalAccountNamesDeclaredOrImplied j
escapeJSSpecialChars = regexReplaceCI "</script>" "<\\/script>" -- #236
listToJsonValueObjArrayStr as = preEscapedString $ escapeJSSpecialChars $ encode $ JSArray $ map (\a -> JSObject $ toJSObject [("value", showJSON a)]) as
postingnums = [1..4 :: Int]
filepaths = fst <$> jfiles j

View File

@ -1,85 +1,38 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Handler.AddR
( postAddR
( getAddR
, postAddR
) where
import Import
import Control.Monad.State.Strict (evalStateT)
import Data.List (dropWhileEnd, sort)
import qualified Data.Text as T
import Data.Void (Void)
import Safe (headMay)
import Text.Megaparsec
import Text.Megaparsec.Char
import Handler.AddForm (AddForm(..), addForm)
import Handler.Common (showErrors)
import Hledger
import Hledger.Cli.Commands.Add (appendToJournalFileOrStdout)
import Widget.AddForm (addForm)
postAddR :: Handler ()
getAddR :: Handler Html
getAddR = do
VD {j, today} <- getViewData
(view, enctype) <- generateFormPost $ addForm j today
defaultLayout [whamlet|<div .row><form class="addform form col-xs-12" method=post enctype=#{enctype}>^{view}|]
postAddR :: Handler Html
postAddR = do
VD{today, j} <- getViewData
-- 1. process the fixed fields with yesod-form
runInputPostResult (addForm today j) >>= \case
FormMissing -> bail ["there is no form data"]
FormFailure errs -> bail errs
FormSuccess form -> do
let journalfile = maybe (journalFilePath j) T.unpack $ addFormJournalFile form
-- 2. the fixed fields look good; now process the posting fields adhocly,
-- getting either errors or a balanced transaction
(params,_) <- runRequestBody
let acctparams = parseNumberedParameters "account" params
amtparams = parseNumberedParameters "amount" params
pnum = length acctparams
when (pnum == 0) (bail ["at least one posting must be entered"])
when (map fst acctparams /= [1..pnum] || map fst amtparams `notElem` [[1..pnum], [1..pnum-1]])
(bail ["the posting parameters are malformed"])
VD{j, today} <- getViewData
((res, view), enctype) <- runFormPost $ addForm j today
case res of
FormMissing -> defaultLayout [whamlet|<div .row><form class="addform form col-xs-12" method=post enctype=#{enctype}>^{view}|]
FormFailure _ -> defaultLayout [whamlet|<div .row><form class="addform form col-xs-12" method=post enctype=#{enctype}>^{view}|]
FormSuccess t -> do
liftIO $ do
-- XXX(?) move into balanceTransaction
ensureJournalFileExists (journalFilePath j)
appendToJournalFileOrStdout (journalFilePath j) (showTransaction $ txnTieKnot t)
setMessage "Transaction added."
redirect JournalR
let eaccts = runParser (accountnamep <* eof) "" . textstrip . snd <$> acctparams
eamts = runParser (evalStateT (amountp <* eof) mempty) "" . textstrip . snd <$> amtparams
(acctErrs, accts) = partitionEithers eaccts
(amtErrs, amts') = partitionEithers eamts
amts | length amts' == pnum = amts'
| otherwise = amts' ++ [missingamt]
errs = T.pack . parseErrorPretty <$> acctErrs ++ amtErrs
unless (null errs) (bail errs)
let etxn = balanceTransaction Nothing $ nulltransaction
{ tdate = addFormDate form
, tdescription = fromMaybe "" $ addFormDescription form
, tpostings = (\(ac, am) -> nullposting {paccount = ac, pamount = Mixed [am]}) <$> zip accts amts
}
case etxn of
Left errs' -> bail (fmap T.pack . maybeToList . headMay $ lines errs')
Right t -> do
-- 3. all fields look good and form a balanced transaction; append it to the file
liftIO (appendTransaction journalfile t)
setMessage "Transaction added."
redirect JournalR
where
bail :: [Text] -> Handler ()
bail xs = showErrors xs >> redirect (JournalR, [("add","1")])
parseNumberedParameters :: Text -> [(Text, Text)] -> [(Int, Text)]
parseNumberedParameters s =
dropWhileEnd (T.null . snd) . sort . mapMaybe parseNum
where
parseNum :: (Text, Text) -> Maybe (Int, Text)
parseNum (k, v) = case parsewith paramnamep k of
Left (_ :: ParseError Char Void) -> Nothing
Right k' -> Just (k', v)
paramnamep = string s *> (read <$> some digitChar) <* eof
-- XXX move into balanceTransaction
appendTransaction :: FilePath -> Transaction -> IO ()
appendTransaction journalfile t = do
ensureJournalFileExists journalfile
appendToJournalFileOrStdout journalfile $
showTransaction (txnTieKnot t)

View File

@ -1,111 +1,11 @@
{-# LANGUAGE CPP, OverloadedStrings, QuasiQuotes, NamedFieldPuns #-}
-- | Common page components and rendering helpers.
-- For global page layout, see Application.hs.
module Handler.Common
( getRootR
, getFaviconR
, getRobotsR
) where
module Handler.Common where
import Import
import Yesod.Default.Handlers (getFaviconR, getRobotsR)
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar (Day, toGregorian)
import Text.Blaze (ToMarkup)
import Text.Blaze.Internal (preEscapedString)
import Yesod
import Settings (manualurl)
import Hledger
-- -- | Navigation link, preserving parameters and possibly highlighted.
-- navlink :: ViewData -> String -> AppRoute -> String -> HtmlUrl AppRoute
-- navlink VD{..} s dest title = [hamlet|
-- <a##{s}link.#{style} href=@?{u'} title="#{title}">#{s}
-- |]
-- where u' = (dest, if null q then [] else [("q", pack q)])
-- style | dest == here = "navlinkcurrent"
-- | otherwise = "navlink" :: Text
-- -- | Links to the various journal editing forms.
-- editlinks :: HtmlUrl AppRoute
-- editlinks = [hamlet|
-- <a#editformlink href="#" onclick="return editformToggle(event)" title="Toggle journal edit form">edit
-- \ | #
-- <a#addformlink href="#" onclick="return addformToggle(event)" title="Toggle transaction add form">add
-- <a#importformlink href="#" onclick="return importformToggle(event)" style="display:none;">import transactions
-- |]
-- | Link to a topic in the manual.
helplink :: Text -> Text -> HtmlUrl r
helplink topic label = [hamlet|<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 :: r -> Journal -> [QueryOpt] -> BalanceReport -> HtmlUrl r
balanceReportAsHtml registerR j qopts (items, total) = [hamlet|
$forall (acct, adisplay, aindent, abal) <- items
<tr .#{inacctClass acct}>
<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}
|] where
l = ledgerFromJournal Any j
inacctClass acct = case inAccountQuery qopts of
Just m' -> if m' `matchesAccount` acct then "inacct" else ""
Nothing -> "" :: Text
hasSubs acct = maybe True (not . null . asubs) (ledgerAccount l acct)
indent a = preEscapedString $ concat $ replicate (2 + 2 * a) "&nbsp;"
acctLink acct = (registerR, [("q", accountQuery acct)])
acctOnlyLink acct = (registerR, [("q", accountOnlyQuery acct)])
accountQuery :: AccountName -> Text
accountQuery = ("inacct:" <>) . quoteIfSpaced
accountOnlyQuery :: AccountName -> Text
accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int, Bool, Bool, TransactionsReportItem)]
numberTransactionsReportItems [] = []
numberTransactionsReportItems items = number 0 nulldate items
where
number :: Int -> Day -> [TransactionsReportItem] -> [(Int, Bool, Bool, TransactionsReportItem)]
number _ _ [] = []
number n prevd (i@(t, _, _, _, _, _):rest) = (n+1, newday, newmonth, i): number (n+1) d rest
where
d = tdate t
newday = d /= prevd
newmonth = dm /= prevdm || dy /= prevdy
(dy, dm, _) = toGregorian d
(prevdy, prevdm, _) = toGregorian prevd
mixedAmountAsHtml :: MixedAmount -> HtmlUrl a
mixedAmountAsHtml b = [hamlet|
$forall t <- ts
<span .#{c}>#{t}
<br>
|] where
ts = lines (showMixedAmountWithoutPrice b)
c = case isNegativeMixedAmount b of
Just True -> "negative amount" :: Text
_ -> "positive amount"
showErrors :: ToMarkup a => [a] -> HandlerFor m ()
showErrors errs = setMessage [shamlet|
Errors:<br>
$forall e <- errs
\#{e}<br>
|]
getRootR :: Handler Html
getRootR = redirect JournalR

View File

@ -1,46 +1,49 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Handler.EditR
( postEditR
( getEditR
, postEditR
) where
import Import
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Except
import qualified Data.Text as T
import Text.Printf (printf)
import Handler.Common (showErrors)
import Hledger
import Hledger.Cli.Utils
-- | Handle a post from the journal edit form.
postEditR :: Handler ()
postEditR = runE $ do
VD {j} <- lift getViewData
-- get form input values, or validation errors.
text <- ExceptT $ maybe (Left "No value provided") Right <$> lookupPostParam "text"
journalpath <- ExceptT $ maybe
(Right . T.pack $ journalFilePath j)
(\f ->
if T.unpack f `elem` journalFilePaths j
then Right f
else Left "unrecognised journal file path") <$>
lookupPostParam "journal"
-- try to avoid unnecessary backups or saving invalid data
let tnew = T.filter (/= '\r') text
editForm :: [(FilePath, Text)] -> Markup -> MForm Handler (FormResult (FilePath, Text), Widget)
editForm journals = identifyForm "import" $ \extra -> do
let files = fst <$> journals
(jRes, jView) <- mreq (selectFieldList ((\x -> (T.pack x, x)) <$> files)) "journal" (listToMaybe files)
(tRes, tView) <- mreq textareaField "text" (Textarea . snd <$> listToMaybe journals)
pure ((,) <$> jRes <*> (unTextarea <$> tRes), [whamlet|
#{extra}
<p>
^{fvInput jView}<br>
^{fvInput tView}
<input type=submit value="Introduce myself">
|])
jE <- liftIO $ readJournal def (Just $ T.unpack journalpath) tnew
_ <- ExceptT . pure $ first T.pack jE
_ <- liftIO $ writeFileWithBackupIfChanged (T.unpack journalpath) tnew
setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String)
redirect JournalR
where
runE :: ExceptT Text Handler () -> Handler ()
runE f = runExceptT f >>= \case
Left e -> showErrors [e] >> redirect JournalR
Right x -> pure x
getEditR :: Handler Html
getEditR = do
VD {j} <- getViewData
(view, enctype) <- generateFormPost (editForm $ jfiles j)
defaultLayout [whamlet|<form enctype=#{enctype}>^{view}|]
postEditR :: Handler Html
postEditR = do
VD {j} <- getViewData
((res, view), enctype) <- runFormPost (editForm $ jfiles j)
case res of
FormMissing -> defaultLayout [whamlet|<form enctype=#{enctype}>^{view}|]
FormFailure _ -> defaultLayout [whamlet|<form enctype=#{enctype}>^{view}|]
FormSuccess (journalPath, text) -> do
-- try to avoid unnecessary backups or saving invalid data
_ <- liftIO $ first T.pack <$> readJournal def (Just journalPath) text
_ <- liftIO $ writeFileWithBackupIfChanged journalPath text
setMessage $ toHtml (printf "Saved journal %s\n" journalPath :: String)
redirect JournalR

View File

@ -1,29 +1,36 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Handler.ImportR
( postImportR
( getImportR
, postImportR
) where
import Import
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Except
importForm :: Markup -> MForm Handler (FormResult FileInfo, Widget)
importForm = identifyForm "import" $ \extra -> do
(res, view) <- mreq fileField "file" Nothing
pure (res, [whamlet|
#{extra}
<p>
Hello, my name is #
^{fvInput view}
<input type=submit value="Introduce myself">
|])
import Handler.Common (showErrors)
getImportR :: Handler Html
getImportR = do
(view, enctype) <- generateFormPost importForm
defaultLayout [whamlet|<form enctype=#{enctype}>^{view}|]
-- | Handle a post from the journal import form.
postImportR :: Handler ()
postImportR = runE $ do
((res, _), _) <- lift . runFormPost . renderDivs $ areq fileField "file" Nothing
postImportR :: Handler Html
postImportR = do
((res, view), enctype) <- runFormPost importForm
case res of
FormMissing -> throwE ["No file provided"]
FormFailure es -> throwE es
FormMissing -> defaultLayout [whamlet|<form enctype=#{enctype}>^{view}|]
FormFailure _ -> defaultLayout [whamlet|<form enctype=#{enctype}>^{view}|]
FormSuccess _ -> do
setMessage "File uploaded successfully"
redirect JournalR
where
runE :: ExceptT [Text] Handler () -> Handler ()
runE f = runExceptT f >>= \case
Left e -> showErrors e >> redirect JournalR
Right x -> pure x
setMessage "File uploaded successfully"
redirect JournalR

View File

@ -9,21 +9,17 @@ module Handler.JournalR where
import Import
import Handler.Common (accountQuery, mixedAmountAsHtml)
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Data
import Hledger.Query
import Hledger.Reports
import Hledger.Utils
import Hledger.Web.WebOptions
import Widget.AddForm (addForm)
import Widget.Common (accountQuery, mixedAmountAsHtml)
-- | The formatted journal view, with sidebar.
-- XXX like registerReportAsHtml
getJournalR :: Handler Html
getJournalR = do
VD{j, m, opts, qopts} <- getViewData
-- XXX like registerReportAsHtml
VD{j, m, opts, qopts, today} <- getViewData
let title = case inAccount qopts of
Nothing -> "General Journal"
Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)"
@ -31,6 +27,7 @@ getJournalR = do
acctlink a = (RegisterR, [("q", accountQuery a)])
(_, items) = journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
(addView, addEnctype) <- generateFormPost (addForm j today)
defaultLayout $ do
setTitle "journal - hledger-web"
$(widgetFile "journal")

View File

@ -10,22 +10,20 @@ module Handler.RegisterR where
import Import
import Data.Time
import Data.List (intersperse)
import qualified Data.Text as T
import Safe (headMay)
import Text.Hamlet (hamletFile)
import Handler.Common (mixedAmountAsHtml, numberTransactionsReportItems)
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Web.WebOptions
import Widget.AddForm (addForm)
import Widget.Common (mixedAmountAsHtml, numberTransactionsReportItems)
-- | The main journal/account register view, with accounts sidebar.
getRegisterR :: Handler Html
getRegisterR = do
VD{j, m, opts, qopts} <- getViewData
VD{j, m, opts, qopts, today} <- getViewData
let (a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts
s1 = if inclsubs then "" else " (excluding subaccounts)"
s2 = if m /= Any then ", filtered" else ""
@ -39,6 +37,7 @@ getRegisterR = do
| newd = "newday"
| otherwise = "" :: Text
(addView, addEnctype) <- generateFormPost (addForm j today)
defaultLayout $ do
setTitle "register - hledger-web"
$(widgetFile "register")
@ -50,12 +49,12 @@ registerChartHtml percommoditytxnreports = $(hamletFile "templates/chart.hamlet"
-- have to make sure plot is not called when our container (maincontent)
-- is hidden, eg with add form toggled
where
charttitle = case maybe "" (fst.snd) $ headMay percommoditytxnreports of
charttitle = case maybe "" (fst . snd) $ listToMaybe percommoditytxnreports of
"" -> ""
s -> s <> ":"
colorForCommodity = fromMaybe 0 . flip lookup commoditiesIndex
commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)]
simpleMixedAmountQuantity = maybe 0 aquantity . headMay . amounts
simpleMixedAmountQuantity = maybe 0 aquantity . listToMaybe . amounts
shownull c = if null c then " " else c
dayToJsTimestamp :: Day -> Integer

View File

@ -1,8 +0,0 @@
-- | Site root and misc. handlers.
module Handler.RootR where
import Import
getRootR :: Handler Html
getRootR = redirect JournalR

View File

@ -7,12 +7,20 @@ import Prelude as Import hiding (head, init, last,
readFile, tail, writeFile)
import Yesod as Import hiding (Route (..))
import Control.Monad as Import (when, unless, void)
import Data.Bifunctor as Import (first, second, bimap)
import Data.Default as Import (Default(def))
import Data.Either as Import (lefts, rights, partitionEithers)
import Data.Maybe as Import (fromMaybe, maybeToList, mapMaybe, isJust)
import Control.Arrow as Import ((&&&))
import Control.Monad as Import
import Data.Bifunctor as Import
import Data.Default as Import
import Data.Either as Import
import Data.Foldable as Import
import Data.List as Import (foldl', unfoldr)
import Data.Maybe as Import
import Data.Text as Import (Text)
import Data.Time as Import hiding (parseTime)
import Data.Traversable as Import
import Data.Void as Import (Void)
import Text.Blaze as Import (Markup)
import Text.Printf as Import (printf)
import Foundation as Import
import Settings as Import

View File

@ -0,0 +1,115 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Widget.AddForm
( addForm
) where
import Control.Monad.State.Strict (evalStateT)
import Data.Bifunctor (first)
import Data.List (dropWhileEnd, nub, sort, unfoldr)
import Data.Maybe (isJust)
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (Day)
import Text.Blaze.Internal (Markup, preEscapedString)
import Text.JSON
import Text.Megaparsec (eof, parseErrorPretty, runParser)
import Yesod
import Hledger
import Settings (widgetFile)
-- XXX <select> which journal to add to
addForm ::
(site ~ HandlerSite m, RenderMessage site FormMessage, MonadHandler m)
=> Journal
-> Day
-> Markup
-> MForm m (FormResult Transaction, WidgetFor site ())
addForm j today = identifyForm "add" $ \extra -> do
(dateRes, dateView) <- mreq dateField dateFS Nothing
(descRes, descView) <- mreq textField descFS Nothing
(acctRes, _) <- mreq listField acctFS Nothing
(amtRes, _) <- mreq listField amtFS Nothing
let (msgs', postRes) = case validatePostings <$> acctRes <*> amtRes of
FormSuccess (Left es) -> (es, FormFailure ["Postings validation failed"])
FormSuccess (Right xs) -> ([], FormSuccess xs)
FormMissing -> ([], FormMissing)
FormFailure es -> ([], FormFailure es)
msgs = zip [(1 :: Int)..] $ msgs' ++ replicate (4 - length msgs') ("", "", Nothing, Nothing)
let descriptions = sort $ nub $ tdescription <$> jtxns j
escapeJSSpecialChars = regexReplaceCI "</script>" "<\\/script>" -- #236
listToJsonValueObjArrayStr = preEscapedString . escapeJSSpecialChars .
encode . JSArray . fmap (\a -> JSObject $ toJSObject [("value", showJSON a)])
journals = fst <$> jfiles j
pure (makeTransaction <$> dateRes <*> descRes <*> postRes, $(widgetFile "add-form"))
where
makeTransaction date desc postings =
nulltransaction {tdate = date, tdescription = desc, tpostings = postings}
dateFS = FieldSettings "date" Nothing Nothing (Just "date")
[("class", "form-control input-lg"), ("placeholder", "Date")]
descFS = FieldSettings "desc" Nothing Nothing (Just "description")
[("class", "form-control input-lg typeahead"), ("placeholder", "Description"), ("size", "40")]
acctFS = FieldSettings "amount" Nothing Nothing (Just "account") []
amtFS = FieldSettings "amount" Nothing Nothing (Just "amount") []
dateField = checkMMap (pure . validateDate) (T.pack . show) textField
validateDate s =
first (const ("Invalid date format" :: Text)) $
fixSmartDateStrEither' today (T.strip s)
listField = Field
{ fieldParse = const . pure . Right . Just . dropWhileEnd T.null
, fieldView = error "Don't render using this!"
, fieldEnctype = UrlEncoded
}
validatePostings :: [Text] -> [Text] -> Either [(Text, Text, Maybe Text, Maybe Text)] [Posting]
validatePostings a b =
case traverse id $ (\(_, _, x) -> x) <$> postings of
Left _ -> Left $ foldr catPostings [] postings
Right [] -> Left
[ ("", "", Just "Missing account", Just "Missing amount")
, ("", "", Just "Missing account", Nothing)
]
Right [p] -> Left
[ (paccount p, T.pack . showMixedAmountWithoutPrice $ pamount p, Nothing, Nothing)
, ("", "", Just "Missing account", Nothing)
]
Right xs -> Right xs
where
postings = unfoldr go (True, a, b)
go (_, x:xs, y:ys) = Just ((x, y, zipPosting (validateAccount x) (validateAmount y)), (True, xs, ys))
go (True, x:y:xs, []) = Just ((x, "", zipPosting (validateAccount x) (Left "Missing amount")), (True, y:xs, []))
go (True, x:xs, []) = Just ((x, "", zipPosting (validateAccount x) (Right missingamt)), (False, xs, []))
go (False, x:xs, []) = Just ((x, "", zipPosting (validateAccount x) (Left "Missing amount")), (False, xs, []))
go (_, [], y:ys) = Just (("", y, zipPosting (Left "Missing account") (validateAmount y)), (False, [], ys))
go (_, [], []) = Nothing
zipPosting = zipEither (\acc amt -> nullposting {paccount = acc, pamount = Mixed [amt]})
catPostings (t, t', Left (e, e')) xs = (t, t', e, e') : xs
catPostings (t, t', Right _) xs = (t, t', Nothing, Nothing) : xs
errorToFormMsg = first (("Invalid value: " <>) . T.pack . parseErrorPretty)
validateAccount = errorToFormMsg . runParser (accountnamep <* eof) "" . T.strip
validateAmount = errorToFormMsg . runParser (evalStateT (amountp <* eof) mempty) "" . T.strip
-- Modification of Align, from the `these` package
zipEither :: (a -> a' -> r) -> Either e a -> Either e' a' -> Either (Maybe e, Maybe e') r
zipEither f a b = case (a, b) of
(Right a', Right b') -> Right (f a' b')
(Left a', Right _) -> Left (Just a', Nothing)
(Right _, Left b') -> Left (Nothing, Just b')
(Left a', Left b') -> Left (Just a', Just b')

View File

@ -0,0 +1,92 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Widget.Common
( accountQuery
, accountOnlyQuery
, balanceReportAsHtml
, helplink
, mixedAmountAsHtml
, numberTransactionsReportItems
) where
import Data.Foldable (for_)
import Data.List (mapAccumL)
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar (Day, toGregorian)
import Text.Blaze
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Internal (preEscapedString)
import Yesod
import Hledger
import Settings (manualurl)
-- | Link to a topic in the manual.
helplink :: Text -> Text -> HtmlUrl r
helplink topic label _ = H.a ! A.href u ! A.target "hledgerhelp" $ toHtml label
where u = textValue $ manualurl <> if T.null topic then "" else T.cons '#' topic
-- | Render a "BalanceReport" as html.
balanceReportAsHtml :: r -> Journal -> [QueryOpt] -> BalanceReport -> HtmlUrl r
balanceReportAsHtml registerR j qopts (items, total) = [hamlet|
$forall (acct, adisplay, aindent, abal) <- items
<tr .#{inacctClass acct}>
<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}
|] where
l = ledgerFromJournal Any j
inacctClass acct = case inAccountQuery qopts of
Just m' -> if m' `matchesAccount` acct then "inacct" else ""
Nothing -> "" :: Text
hasSubs acct = maybe True (not . null . asubs) (ledgerAccount l acct)
indent a = preEscapedString $ concat $ replicate (2 + 2 * a) "&nbsp;"
acctLink acct = (registerR, [("q", accountQuery acct)])
acctOnlyLink acct = (registerR, [("q", accountOnlyQuery acct)])
accountQuery :: AccountName -> Text
accountQuery = ("inacct:" <>) . quoteIfSpaced
accountOnlyQuery :: AccountName -> Text
accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int, Bool, Bool, TransactionsReportItem)]
numberTransactionsReportItems = snd . mapAccumL number (0, nulldate)
where
number :: (Int, Day) -> TransactionsReportItem -> ((Int, Day), (Int, Bool, Bool, TransactionsReportItem))
number (!n, !prevd) i@(t, _, _, _, _, _) = ((n', d), (n', newday, newmonth, i))
where
n' = n + 1
d = tdate t
newday = d /= prevd
newmonth = dm /= prevdm || dy /= prevdy
(dy, dm, _) = toGregorian d
(prevdy, prevdm, _) = toGregorian prevd
mixedAmountAsHtml :: MixedAmount -> HtmlUrl a
mixedAmountAsHtml b _ =
for_ (lines (showMixedAmountWithoutPrice b)) $ \t -> do
H.span ! A.class_ c $ toHtml t
H.br
where
c = case isNegativeMixedAmount b of
Just True -> "negative amount"
_ -> "positive amount"

View File

@ -78,10 +78,9 @@ function registerChart($container, series) {
position: 'sw'
},
grid: {
markings:
function (axes) {
markings: function () {
var now = Date.now();
var markings = [
return [
{
xaxis: { to: now }, // past
yaxis: { to: 0 }, // <0
@ -103,7 +102,6 @@ function registerChart($container, series) {
lineWidth:1
},
];
return markings;
},
hoverable: true,
autoHighlight: true,
@ -127,15 +125,16 @@ function registerChart($container, series) {
}
function registerChartClick(ev, pos, item) {
if (item) {
targetselector = '#'+item.series.data[item.dataIndex][5];
$target = $(targetselector);
if ($target.length) {
window.location.hash = targetselector;
$('html, body').animate({
scrollTop: $target.offset().top
}, 1000);
}
if (!item) {
return;
}
var targetselector = '#' + item.series.data[item.dataIndex][5];
var $target = $(targetselector);
if ($target.length) {
window.location.hash = targetselector;
$('html, body').animate({
scrollTop: $target.offset().top
}, 1000);
}
}
@ -192,9 +191,8 @@ function addformAddPosting() {
// clear and renumber the field, add keybindings
$acctinput
.val('')
.prop('id','account'+(num+1))
.prop('name','account'+(num+1))
.prop('placeholder','Account '+(num+1));
.prop('name', 'account')
.prop('placeholder', 'Account ' + (num + 1));
//lastrow.find('input') // not :last this time
$acctinput
.bind('keydown', 'ctrl+shift+=', addformAddPosting)
@ -203,9 +201,8 @@ function addformAddPosting() {
$amntinput
.val('')
.prop('id','amount'+(num+1))
.prop('name','amount'+(num+1))
.prop('placeholder','Amount '+(num+1))
.prop('name','amount')
.prop('placeholder','Amount ' + (num + 1))
.keypress(addformAddPosting);
$acctinput
@ -241,47 +238,3 @@ function sidebarToggle() {
$('#spacer').toggleClass('col-md-4 col-sm-4 col-any-0');
$.cookie('showsidebar', $('#sidebar-menu').hasClass('col-any-0') ? '0' : '1');
}
//----------------------------------------------------------------------
// MISC
function enableTypeahead($el, suggester) {
return $el.typeahead(
{
highlight: true
},
{
source: suggester.ttAdapter()
}
);
}
// function journalSelect(ev) {
// var textareas = $('textarea', $('form#editform'));
// for (i=0; i<textareas.length; i++) {
// textareas[i].style.display = 'none';
// textareas[i].disabled = true;
// }
// var targ = getTarget(ev);
// if (targ.value) {
// var journalid = targ.value+'_textarea';
// var textarea = document.getElementById(journalid);
// }
// else {
// var textarea = textareas[0];
// }
// textarea.style.display = 'block';
// textarea.disabled = false;
// return true;
// }
// // Get the current event's target in a robust way.
// // http://www.quirksmode.org/js/events_properties.html
// function getTarget(ev) {
// var targ;
// if (!ev) var ev = window.event;
// if (ev.target) targ = ev.target;
// else if (ev.srcElement) targ = ev.srcElement;
// if (targ.nodeType == 3) targ = targ.parentNode;
// return targ;
// }

View File

@ -1,6 +1,5 @@
<script>
jQuery(document).ready(function() {
/* set up typeahead fields */
descriptionsSuggester = new Bloodhound({
local:#{listToJsonValueObjArrayStr descriptions},
limit:100,
@ -10,53 +9,62 @@
descriptionsSuggester.initialize();
accountsSuggester = new Bloodhound({
local:#{listToJsonValueObjArrayStr accts},
local:#{listToJsonValueObjArrayStr (journalAccountNamesDeclaredOrImplied j)},
limit:100,
datumTokenizer: function(d) { return [d.value]; },
queryTokenizer: function(q) { return [q]; }
/*
datumTokenizer: Bloodhound.tokenizers.obj.whitespace('value'),
datumTokenizer: Bloodhound.tokenizers.whitespace(d.value)
queryTokenizer: Bloodhound.tokenizers.whitespace
*/
});
accountsSuggester.initialize();
enableTypeahead(jQuery('input#description'), descriptionsSuggester);
enableTypeahead(jQuery('input#account1, input#account2, input#account3, input#account4'), accountsSuggester);
jQuery('input[name=description]').typeahead({ highlight: true }, { source: descriptionsSuggester.ttAdapter() });
jQuery('input[name=account]').typeahead({ highlight: true }, { source: accountsSuggester.ttAdapter() });
});
^{extra}
<form#addform action=@{r} method=POST .form>
<div .form-group>
<div .form-group>
<div .row>
<div .col-md-3 .col-xs-6 .col-sm-6>
<div #dateWrap .input-group .date>
<input #date required lang=en name=date .form-control .input-lg placeholder="Date" >
<div .input-group-addon>
<span .glyphicon .glyphicon-th>
<div .col-md-9 .col-xs-6 .col-sm-6>
<input #description required .typeahead .form-control .input-lg type=text size=40 name=description placeholder="Description">
<div .col-md-3 .col-xs-6 .col-sm-6 :isJust (fvErrors dateView):.has-error>
<div #dateWrap .form-group.input-group.date>
^{fvInput dateView}
<div .input-group-addon>
<span .glyphicon .glyphicon-th>
$maybe err <- fvErrors dateView
<span .help-block .error-block>#{err}
<div .col-md-9 .col-xs-6 .col-sm-6 :isJust (fvErrors descView):.has-error>
<div .form-group>
^{fvInput descView}
$maybe err <- fvErrors descView
<span .help-block .error-block>#{err}
<div .row>
<div .col-md-3 .col-xs-6 .col-sm-6>
<div .col-md-9 .col-xs-6 .col-sm-6>
<div .account-postings>
$forall n <- postingnums
<div .form-group .row .account-group #grp#{n}>
<div .col-md-8 .col-xs-8 .col-sm-8>
<input #account#{n} .account-input.form-control.input-lg.typeahead type=text name=account#{n} placeholder="Account #{n}">
<div .col-md-4 .col-xs-4 .col-sm-4>
<input #amount#{n} .amount-input.form-control.input-lg type=text name=amount#{n} placeholder="Amount#{n}">
<div .account-postings>
$forall (n, (acc, amt, accE, amtE)) <- msgs
<div .form-group .row .account-group #grp#{n}>
<div .col-md-8 .col-xs-8 .col-sm-8 :isJust accE:.has-error>
<input .account-input.form-control.input-lg.typeahead type=text
name=account placeholder="Account #{n}" value="#{acc}">
$maybe err <- accE
<span .help-block .error-block>_{err}
<div .col-md-4 .col-xs-4 .col-sm-4 :isJust amtE:.has-error>
<input .amount-input.form-control.input-lg type=text
name=amount placeholder="Amount #{n}" value="#{amt}">
$maybe err <- amtE
<span .help-block .error-block>_{err}
<div .col-md-8 .col-xs-8 .col-sm-8>
<div .col-md-4 .col-xs-4 .col-sm-4>
<button type=submit .btn .btn-default .btn-lg name=submit>add
$if length filepaths > 1
<div .row>
<div .col-md-8 .col-xs-8 .col-sm-8>
<div .col-md-4 .col-xs-4 .col-sm-4>
<button type=submit .btn .btn-default .btn-lg name=submit>add
$if length journals > 1
<br>
<span .input-lg>to:
<select #journalselect .form-control.input-lg name=journal onchange="/*journalSelect(event)*/" style="width:auto; display:inline-block;">
$forall p <- filepaths
<option value=#{p}>#{p}
<span style="padding-left:2em;">
<span .small>
Enter a value in the last field for
<select #journalselect .form-control.input-lg name=journal style="width:auto; display:inline-block;">
$forall p <- journals
<option value=#{p}>#{p}
<span .small style="padding-left:2em;">
Enter a value in the last field for
<a href="#" onclick="addformAddPosting(); return false;">more
(or ctrl +, ctrl -)

View File

@ -29,7 +29,7 @@ $newline never
<div .row .row-offcanvas .row-offcanvas-left>
^{pageBody pc}
<footer>
#{extraCopyright $ appExtra $ settings master}
#{extraCopyright $ appExtra $ settings master}
$maybe analytics <- extraAnalytics $ appExtra $ settings master
<script>
@ -47,61 +47,3 @@ $newline never
<script>
window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})
\<![endif]-->
<div .modal.fade #helpmodal tabindex="-1" role="dialog" aria-labelledby="helpLabel" aria-hidden="true">
<div .modal-dialog .modal-lg>
<div .modal-content>
<div .modal-header>
<button type="button" .close data-dismiss="modal" aria-hidden="true">&times;
<h3 .modal-title #helpLabel>Help
<div .modal-body>
<div .row>
<div .col-xs-6>
<p>
<b>Keyboard shortcuts
<ul>
<li> <code>h</code> or maybe <code>?</code> - view this help (escape or click to exit)
<li> <code>j</code> - go to the Journal view (home)
<li> <code>a</code> - add a transaction (escape to cancel)
<li> <code>s</code> - toggle sidebar
<li> <code>f</code> - focus search form ("find")
<p>
<b>General
<ul>
<li> The Journal view shows general journal entries, representing zero-sum movements of money (or other commodity) between hierarchical accounts
<li> The sidebar shows the resulting accounts and their final balances
<li> Parent account balances include subaccount balances
<li> Multiple currencies in balances are displayed one above the other
<li> Click account name links to see transactions affecting that account, with running balance
<li> Click date links to see journal entries on that date
<div .col-xs-6>
<p>
<b>Search
<ul>
<li> <code>acct:REGEXP</code> - filter on to/from account
<li> <code>desc:REGEXP</code> - filter on description
<li> <code>date:PERIODEXP</code>, <code>date2:PERIODEXP</code> - filter on date or secondary date
<li> <code>code:REGEXP</code> - filter on transaction's code (eg check number)
<li> <code>status:*</code>, <code>status:!</code>, <code>status:</code> - filter on transaction's cleared status (cleared, pending, uncleared)
<!-- <li> <code>empty:BOOL</code> - filter on whether amount is zero -->
<li> <code>amt:N</code>, <code>amt:&lt;N</code>, <code>amt:&gt;N</code> - filter on the unsigned amount magnitude. Or with a sign before N, filter on the signed value. (Single-commodity amounts only.)
<li> <code>cur:REGEXP</code> - filter on the currency/commodity symbol (must match all of it). Dollar sign must be written as <code>\$</code>
<li> <code>tag:NAME</code>, <code>tag:NAME=REGEX</code> - filter on tag name, or tag name and value
<!-- <li> <code>depth:N</code> - filter out accounts below this depth -->
<li> <code>real:BOOL</code> - filter on postings' real/virtual-ness
<li> Enclose search patterns containing spaces in single or double quotes
<li> Prepend <code>not:</code> to negate a search term
<li> Multiple search terms on different fields are AND'ed, multiple search terms on the same field are OR'ed
<li> These search terms also work with command-line hledger
<div .modal #addmodal tabindex="-1" role="dialog" aria-labelledby="addLabel" aria-hidden="true">
<div .modal-dialog .modal-lg>
<div .modal-content>
<div .modal-header>
<button type="button" .close data-dismiss="modal" aria-hidden="true">&times;
<h3 .modal-title #addLabel>Add a transaction
<div .modal-body>
$maybe m <- msg
$if isPrefixOf "Errors" (renderHtml m)
<div #message>#{m}
^{addFormHamlet j AddR}

View File

@ -1,6 +1,5 @@
$maybe m <- msg
$if not (isPrefixOf "Errors" (renderHtml m))
<div #message>#{m}
<div #message .alert-primary>#{m}
<div#spacer .col-xs-2.#{topShowsm}.#{topShowmd}>
<h1>
@ -21,7 +20,7 @@ $maybe m <- msg
^{accounts}
<div #main-content .col-xs-12.#{mainShowmd}.#{mainShowsm}>
<div#searchformdiv .row>
<div .row>
<form#searchform .form-inline method=GET>
<div .form-group .col-md-12 .col-sm-12 .col-xs-12>
<div #searchbar .input-group>
@ -36,3 +35,49 @@ $maybe m <- msg
<button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal"
title="Show search and general help">?
^{widget}
<div .modal.fade #helpmodal tabindex="-1" role="dialog" aria-labelledby="helpLabel" aria-hidden="true">
<div .modal-dialog .modal-lg>
<div .modal-content>
<div .modal-header>
<button type="button" .close data-dismiss="modal" aria-hidden="true">&times;
<h3 .modal-title #helpLabel>Help
<div .modal-body>
<div .row>
<div .col-xs-6>
<p>
<b>Keyboard shortcuts
<ul>
<li> <code>h</code> or maybe <code>?</code> - view this help (escape or click to exit)
<li> <code>j</code> - go to the Journal view (home)
<li> <code>a</code> - add a transaction (escape to cancel)
<li> <code>s</code> - toggle sidebar
<li> <code>f</code> - focus search form ("find")
<p>
<b>General
<ul>
<li> The Journal view shows general journal entries, representing zero-sum movements of money (or other commodity) between hierarchical accounts
<li> The sidebar shows the resulting accounts and their final balances
<li> Parent account balances include subaccount balances
<li> Multiple currencies in balances are displayed one above the other
<li> Click account name links to see transactions affecting that account, with running balance
<li> Click date links to see journal entries on that date
<div .col-xs-6>
<p>
<b>Search
<ul>
<li> <code>acct:REGEXP</code> - filter on to/from account
<li> <code>desc:REGEXP</code> - filter on description
<li> <code>date:PERIODEXP</code>, <code>date2:PERIODEXP</code> - filter on date or secondary date
<li> <code>code:REGEXP</code> - filter on transaction's code (eg check number)
<li> <code>status:*</code>, <code>status:!</code>, <code>status:</code> - filter on transaction's cleared status (cleared, pending, uncleared)
<!-- <li> <code>empty:BOOL</code> - filter on whether amount is zero -->
<li> <code>amt:N</code>, <code>amt:&lt;N</code>, <code>amt:&gt;N</code> - filter on the unsigned amount magnitude. Or with a sign before N, filter on the signed value. (Single-commodity amounts only.)
<li> <code>cur:REGEXP</code> - filter on the currency/commodity symbol (must match all of it). Dollar sign must be written as <code>\$</code>
<li> <code>tag:NAME</code>, <code>tag:NAME=REGEX</code> - filter on tag name, or tag name and value
<!-- <li> <code>depth:N</code> - filter out accounts below this depth -->
<li> <code>real:BOOL</code> - filter on postings' real/virtual-ness
<li> Enclose search patterns containing spaces in single or double quotes
<li> Prepend <code>not:</code> to negate a search term
<li> Multiple search terms on different fields are AND'ed, multiple search terms on the same field are OR'ed
<li> These search terms also work with command-line hledger

View File

@ -2,13 +2,13 @@
<h2#contenttitle>Edit journal
<table.form>
$if length (jfiles j) > 1
<tr>
<td colspan=2>
Editing ^{journalselect (fmap (T.unpack . snd) (jfiles j))}
<tr>
<td colspan=2>
Editing ^{journalselect (fmap (T.unpack . snd) (jfiles j))}
<tr>
<td colspan=2>
<!-- XXX textarea ids are unquoted journal file paths here, not valid html -->
$forall f <- jfiles j
$forall f <- jfiles j
<textarea id=#{fst f}_textarea name=text rows=25 cols=80 style=display:none; disabled=disabled>
\#{snd f}
<tr#addbuttonrow>
@ -18,7 +18,5 @@
<td>
<span.help>
Are you sure ? This will overwrite the journal. #
<input type=hidden name=action value=edit>
<input type=submit name=submit value="save journal">
\ or #
<input type=submit name=submit value="save">
<a href="#" onclick="return editformToggle(event)">cancel

View File

@ -3,7 +3,5 @@
<tr>
<td>
<input type=file name=file>
<input type=hidden name=action value=import>
<input type=submit name=submit value="import from file">
\ or #
<a href="#" onclick="return importformToggle(event)">cancel

View File

@ -30,3 +30,13 @@
#{elideAccountName 40 acc}
<td .amount .nonhead style="text-align:right;">
^{mixedAmountAsHtml amt}
<div .modal #addmodal tabindex="-1" role="dialog" aria-labelledby="addLabel" aria-hidden="true">
<div .modal-dialog .modal-lg>
<div .modal-content>
<div .modal-header>
<button type="button" .close data-dismiss="modal" aria-hidden="true">&times;
<h3 .modal-title #addLabel>Add a transaction
<div .modal-body>
<form#addform.form action=@{AddR} method=POST enctype=#{addEnctype}>
^{addView}

View File

@ -30,3 +30,13 @@
$if not split || not (isZeroMixedAmount amt)
\^{mixedAmountAsHtml amt}
<td .balance style="text-align:right;">^{mixedAmountAsHtml bal}
<div .modal #addmodal tabindex="-1" role="dialog" aria-labelledby="addLabel" aria-hidden="true">
<div .modal-dialog .modal-lg>
<div .modal-content>
<div .modal-header>
<button type="button" .close data-dismiss="modal" aria-hidden="true">&times;
<h3 .modal-title #addLabel>Add a transaction
<div .modal-body>
<form#addform.form action=@{AddR} method=POST enctype=#{addEnctype}>
^{addView}