web: Separate the add form from Foundation & JournalR/RegisterR
This commit is contained in:
parent
d760904982
commit
89ff5612ec
@ -19,9 +19,10 @@ import Yesod.Default.Handlers (getFaviconR, getRobotsR)
|
|||||||
|
|
||||||
-- Import all relevant handler modules here.
|
-- Import all relevant handler modules here.
|
||||||
-- Don't forget to add new modules to your cabal file!
|
-- Don't forget to add new modules to your cabal file!
|
||||||
|
import Handler.AddR (postAddR)
|
||||||
|
import Handler.JournalR (getJournalR)
|
||||||
|
import Handler.RegisterR (getRegisterR)
|
||||||
import Handler.RootR (getRootR)
|
import Handler.RootR (getRootR)
|
||||||
import Handler.JournalR (getJournalR, postJournalR)
|
|
||||||
import Handler.RegisterR (getRegisterR, postRegisterR)
|
|
||||||
import Handler.SidebarR (getSidebarR)
|
import Handler.SidebarR (getSidebarR)
|
||||||
|
|
||||||
import Hledger.Data (Journal, nulljournal)
|
import Hledger.Data (Journal, nulljournal)
|
||||||
|
|||||||
@ -6,20 +6,19 @@
|
|||||||
module Foundation where
|
module Foundation where
|
||||||
|
|
||||||
import Data.IORef (IORef, readIORef, writeIORef)
|
import Data.IORef (IORef, readIORef, writeIORef)
|
||||||
import Data.List (isPrefixOf, sort, nub)
|
import Data.List (isPrefixOf)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Time.Calendar (Day)
|
import Data.Time.Calendar (Day)
|
||||||
import Network.HTTP.Conduit (Manager)
|
import Network.HTTP.Conduit (Manager)
|
||||||
import Text.Blaze (Markup)
|
import Text.Blaze (Markup)
|
||||||
import Text.Blaze.Internal (preEscapedString)
|
|
||||||
import Text.Blaze.Html.Renderer.String (renderHtml)
|
import Text.Blaze.Html.Renderer.String (renderHtml)
|
||||||
import Text.Hamlet (hamletFile)
|
import Text.Hamlet (hamletFile)
|
||||||
import Text.JSON
|
|
||||||
import Yesod
|
import Yesod
|
||||||
import Yesod.Static
|
import Yesod.Static
|
||||||
import Yesod.Default.Config
|
import Yesod.Default.Config
|
||||||
|
|
||||||
|
import Handler.AddForm
|
||||||
import Settings.StaticFiles
|
import Settings.StaticFiles
|
||||||
import Settings (widgetFile, Extra (..))
|
import Settings (widgetFile, Extra (..))
|
||||||
#ifndef DEVELOPMENT
|
#ifndef DEVELOPMENT
|
||||||
@ -233,104 +232,3 @@ getCurrentJournal jref opts d = do
|
|||||||
-- referentially transparent manner (allowing multiple reads).
|
-- referentially transparent manner (allowing multiple reads).
|
||||||
getLastMessage :: Handler (Maybe Html)
|
getLastMessage :: Handler (Maybe Html)
|
||||||
getLastMessage = cached getMessage
|
getLastMessage = cached getMessage
|
||||||
|
|
||||||
-- add form dialog, part of the default template
|
|
||||||
|
|
||||||
-- | Add transaction form.
|
|
||||||
addform :: Journal -> HtmlUrl AppRoute
|
|
||||||
addform j = [hamlet|
|
|
||||||
|
|
||||||
<script>
|
|
||||||
jQuery(document).ready(function() {
|
|
||||||
|
|
||||||
/* set up typeahead fields */
|
|
||||||
|
|
||||||
descriptionsSuggester = new Bloodhound({
|
|
||||||
local:#{listToJsonValueObjArrayStr descriptions},
|
|
||||||
limit:100,
|
|
||||||
datumTokenizer: function(d) { return [d.value]; },
|
|
||||||
queryTokenizer: function(q) { return [q]; }
|
|
||||||
});
|
|
||||||
descriptionsSuggester.initialize();
|
|
||||||
|
|
||||||
accountsSuggester = new Bloodhound({
|
|
||||||
local:#{listToJsonValueObjArrayStr accts},
|
|
||||||
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);
|
|
||||||
|
|
||||||
});
|
|
||||||
|
|
||||||
<form#addform method=POST .form>
|
|
||||||
<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 .account-postings>
|
|
||||||
$forall n <- postingnums
|
|
||||||
^{postingfields n}
|
|
||||||
<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
|
|
||||||
<br>
|
|
||||||
<span class="input-lg">to:
|
|
||||||
^{journalselect filepaths}
|
|
||||||
<span style="padding-left:2em;">
|
|
||||||
<span .small>
|
|
||||||
Enter a value in the last field for
|
|
||||||
<a href="#" onclick="addformAddPosting(); return false;">more
|
|
||||||
(or ctrl +, ctrl -)
|
|
||||||
|]
|
|
||||||
where
|
|
||||||
descriptions = sort $ nub $ map 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
|
|
||||||
numpostings = 4
|
|
||||||
postingnums = [1..numpostings]
|
|
||||||
filepaths = map fst $ jfiles j
|
|
||||||
postingfields :: Int -> HtmlUrl AppRoute
|
|
||||||
postingfields n = [hamlet|
|
|
||||||
<div .form-group .row .account-group ##{grpvar}>
|
|
||||||
<div .col-md-8 .col-xs-8 .col-sm-8>
|
|
||||||
<input ##{acctvar} .account-input .typeahead .form-control .input-lg type=text name=#{acctvar} placeholder="#{acctph}">
|
|
||||||
<div .col-md-4 .col-xs-4 .col-sm-4>
|
|
||||||
<input ##{amtvar} .amount-input .form-control .input-lg type=text name=#{amtvar} placeholder="#{amtph}">
|
|
||||||
|]
|
|
||||||
where
|
|
||||||
acctvar = "account" ++ show n
|
|
||||||
acctph = "Account " ++ show n
|
|
||||||
amtvar = "amount" ++ show n
|
|
||||||
amtph = "Amount " ++ show n
|
|
||||||
grpvar = "grp" ++ show n
|
|
||||||
|
|
||||||
journalselect :: [FilePath] -> HtmlUrl AppRoute
|
|
||||||
journalselect journalfilepaths = [hamlet|
|
|
||||||
<select id=journalselect name=journal onchange="/*journalSelect(event)*/" class="form-control input-lg" style="width:auto; display:inline-block;">
|
|
||||||
$forall p <- journalfilepaths
|
|
||||||
<option value=#{p}>#{p}
|
|
||||||
|]
|
|
||||||
|
|
||||||
journalradio :: [FilePath] -> HtmlUrl AppRoute
|
|
||||||
journalradio journalfilepaths = [hamlet|
|
|
||||||
$forall p <- journalfilepaths
|
|
||||||
<div style="white-space:nowrap;">
|
|
||||||
<span class="input-lg" style="position:relative; top:-8px; left:8px;">#{p}
|
|
||||||
<input name=journal type=radio value=#{p} class="form-control" style="width:auto; display:inline;">
|
|
||||||
|]
|
|
||||||
|
|||||||
@ -1,24 +1,30 @@
|
|||||||
{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, QuasiQuotes, NamedFieldPuns, ScopedTypeVariables, TypeFamilies #-}
|
|
||||||
-- | Add form data & handler. (The layout and js are defined in
|
-- | Add form data & handler. (The layout and js are defined in
|
||||||
-- Foundation so that the add form can be in the default layout for
|
-- Foundation so that the add form can be in the default layout for
|
||||||
-- all views.)
|
-- all views.)
|
||||||
|
|
||||||
module Handler.AddForm where
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
import Import
|
module Handler.AddForm
|
||||||
|
( AddForm(..)
|
||||||
|
, addForm
|
||||||
|
, addFormHamlet
|
||||||
|
) where
|
||||||
|
|
||||||
import Control.Monad.State.Strict (evalStateT)
|
import Data.List (sort, nub)
|
||||||
import Data.List (sortBy)
|
import Data.Semigroup ((<>))
|
||||||
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
import Data.Void (Void)
|
import Text.Blaze.Internal (preEscapedString)
|
||||||
import Safe (headMay)
|
import Text.Hamlet (hamletFile)
|
||||||
import Text.Blaze (ToMarkup)
|
import Text.JSON
|
||||||
import Text.Megaparsec
|
import Yesod (HtmlUrl, HandlerSite, RenderMessage)
|
||||||
import Text.Megaparsec.Char
|
import Yesod.Form
|
||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli.Commands.Add (appendToJournalFileOrStdout)
|
|
||||||
|
|
||||||
-- Part of the data required from the add form.
|
-- Part of the data required from the add form.
|
||||||
-- Don't know how to handle the variable posting fields with yesod-form yet.
|
-- Don't know how to handle the variable posting fields with yesod-form yet.
|
||||||
@ -29,7 +35,7 @@ data AddForm = AddForm
|
|||||||
, addFormJournalFile :: Maybe Text
|
, addFormJournalFile :: Maybe Text
|
||||||
} deriving Show
|
} deriving Show
|
||||||
|
|
||||||
addForm :: Day -> Journal -> FormInput Handler AddForm
|
addForm :: (RenderMessage (HandlerSite m) FormMessage, Monad m) => Day -> Journal -> FormInput m AddForm
|
||||||
addForm today j = AddForm
|
addForm today j = AddForm
|
||||||
<$> ireq (checkMMap (pure . validateDate) (T.pack . show) textField) "date"
|
<$> ireq (checkMMap (pure . validateDate) (T.pack . show) textField) "date"
|
||||||
<*> iopt textField "description"
|
<*> iopt textField "description"
|
||||||
@ -44,79 +50,12 @@ addForm today j = AddForm
|
|||||||
Right d -> Right d
|
Right d -> Right d
|
||||||
Left _ -> Left $ MsgInvalidEntry $ "could not parse date \"" <> s <> "\":"
|
Left _ -> Left $ MsgInvalidEntry $ "could not parse date \"" <> s <> "\":"
|
||||||
|
|
||||||
postAddForm :: Handler Html
|
addFormHamlet :: Journal -> t -> HtmlUrl t
|
||||||
postAddForm = do
|
addFormHamlet j r = $(hamletFile "templates/add-form.hamlet")
|
||||||
-- 1. process the fixed fields with yesod-form
|
where
|
||||||
VD{today, j} <- getViewData
|
descriptions = sort $ nub $ tdescription <$> jtxns j
|
||||||
formresult <- runInputPostResult (addForm today j)
|
accts = journalAccountNamesDeclaredOrImplied j
|
||||||
|
escapeJSSpecialChars = regexReplaceCI "</script>" "<\\/script>" -- #236
|
||||||
ok <- case formresult of
|
listToJsonValueObjArrayStr as = preEscapedString $ escapeJSSpecialChars $ encode $ JSArray $ map (\a -> JSObject $ toJSObject [("value", showJSON a)]) as
|
||||||
FormMissing -> showErrors ["there is no form data" :: Text] >> return False
|
postingnums = [1..4 :: Int]
|
||||||
FormFailure errs -> showErrors errs >> return False
|
filepaths = fst <$> jfiles j
|
||||||
FormSuccess dat -> do
|
|
||||||
let AddForm{
|
|
||||||
addFormDate =date
|
|
||||||
,addFormDescription=mdesc
|
|
||||||
,addFormJournalFile=mjournalfile
|
|
||||||
} = dat
|
|
||||||
desc = fromMaybe "" mdesc
|
|
||||||
journalfile = maybe (journalFilePath j) T.unpack mjournalfile
|
|
||||||
|
|
||||||
-- 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
|
|
||||||
num = length acctparams
|
|
||||||
paramErrs | num == 0 = ["at least one posting must be entered"]
|
|
||||||
| map fst acctparams == [1..num] &&
|
|
||||||
map fst amtparams `elem` [[1..num], [1..num-1]] = []
|
|
||||||
| otherwise = ["the posting parameters are malformed"]
|
|
||||||
eaccts = map (runParser (accountnamep <* eof) "" . textstrip . snd) acctparams
|
|
||||||
eamts = map (runParser (evalStateT (amountp <* eof) mempty) "" . textstrip . snd) amtparams
|
|
||||||
(accts, acctErrs) = (rights eaccts, map show $ lefts eaccts)
|
|
||||||
(amts', amtErrs) = (rights eamts, map show $ lefts eamts)
|
|
||||||
amts | length amts' == num = amts'
|
|
||||||
| otherwise = amts' ++ [missingamt]
|
|
||||||
errs = if not (null paramErrs) then paramErrs else (acctErrs ++ amtErrs)
|
|
||||||
etxn | not $ null errs = Left errs
|
|
||||||
| otherwise = either (Left . maybeToList . headMay . lines) Right
|
|
||||||
(balanceTransaction Nothing $ nulltransaction {
|
|
||||||
tdate=date
|
|
||||||
,tdescription=desc
|
|
||||||
,tpostings=[nullposting{paccount=acct, pamount=Mixed [amt]} | (acct,amt) <- zip accts amts]
|
|
||||||
})
|
|
||||||
case etxn of
|
|
||||||
Left errs -> showErrors errs >> return False
|
|
||||||
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.|]
|
|
||||||
return True
|
|
||||||
|
|
||||||
if ok then redirect JournalR else redirect (JournalR, [("add","1")])
|
|
||||||
|
|
||||||
parseNumberedParameters :: Text -> [(Text, Text)] -> [(Int, Text)]
|
|
||||||
parseNumberedParameters s =
|
|
||||||
reverse . dropWhile (T.null . snd) . sortBy (flip compare) . 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)
|
|
||||||
|
|
||||||
showErrors :: ToMarkup a => [a] -> Handler ()
|
|
||||||
showErrors errs = setMessage [shamlet|
|
|
||||||
Errors:<br>
|
|
||||||
$forall e<-errs
|
|
||||||
\#{e}<br>
|
|
||||||
|]
|
|
||||||
|
|||||||
87
hledger-web/Handler/AddR.hs
Normal file
87
hledger-web/Handler/AddR.hs
Normal file
@ -0,0 +1,87 @@
|
|||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
|
module Handler.AddR
|
||||||
|
( postAddR
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Import
|
||||||
|
|
||||||
|
import Control.Monad.State.Strict (evalStateT)
|
||||||
|
import Data.List (sortBy)
|
||||||
|
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)
|
||||||
|
|
||||||
|
postAddR :: Handler Html
|
||||||
|
postAddR = do
|
||||||
|
-- 1. process the fixed fields with yesod-form
|
||||||
|
VD{today, j} <- getViewData
|
||||||
|
formresult <- runInputPostResult (addForm today j)
|
||||||
|
|
||||||
|
ok <- case formresult of
|
||||||
|
FormMissing -> showErrors ["there is no form data" :: Text] >> return False
|
||||||
|
FormFailure errs -> showErrors errs >> return False
|
||||||
|
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
|
||||||
|
paramErrs | pnum == 0 = ["at least one posting must be entered"]
|
||||||
|
| map fst acctparams == [1..pnum] &&
|
||||||
|
map fst amtparams `elem` [[1..pnum], [1..pnum-1]] = []
|
||||||
|
| otherwise = ["the posting parameters are malformed"]
|
||||||
|
eaccts = map (runParser (accountnamep <* eof) "" . textstrip . snd) acctparams
|
||||||
|
eamts = map (runParser (evalStateT (amountp <* eof) mempty) "" . textstrip . snd) amtparams
|
||||||
|
(accts, acctErrs) = (rights eaccts, map show $ lefts eaccts)
|
||||||
|
(amts', amtErrs) = (rights eamts, map show $ lefts eamts)
|
||||||
|
amts | length amts' == pnum = amts'
|
||||||
|
| otherwise = amts' ++ [missingamt]
|
||||||
|
errs = if not (null paramErrs) then paramErrs else acctErrs ++ amtErrs
|
||||||
|
etxn | not $ null errs = Left errs
|
||||||
|
| otherwise = either (Left . maybeToList . headMay . lines) Right
|
||||||
|
(balanceTransaction Nothing $ nulltransaction {
|
||||||
|
tdate = addFormDate form
|
||||||
|
,tdescription = fromMaybe "" $ addFormDescription form
|
||||||
|
,tpostings=[nullposting{paccount=acct, pamount=Mixed [amt]} | (acct,amt) <- zip accts amts]
|
||||||
|
})
|
||||||
|
case etxn of
|
||||||
|
Left errs' -> showErrors errs' >> return False
|
||||||
|
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.|]
|
||||||
|
return True
|
||||||
|
|
||||||
|
if ok then redirect JournalR else redirect (JournalR, [("add","1")])
|
||||||
|
|
||||||
|
parseNumberedParameters :: Text -> [(Text, Text)] -> [(Int, Text)]
|
||||||
|
parseNumberedParameters s =
|
||||||
|
reverse . dropWhile (T.null . snd) . sortBy (flip compare) . 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)
|
||||||
@ -9,6 +9,7 @@ import Import
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Time.Calendar (Day, toGregorian)
|
import Data.Time.Calendar (Day, toGregorian)
|
||||||
import System.FilePath (takeFileName)
|
import System.FilePath (takeFileName)
|
||||||
|
import Text.Blaze (ToMarkup)
|
||||||
import Text.Blaze.Internal (preEscapedString)
|
import Text.Blaze.Internal (preEscapedString)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
|
||||||
@ -51,7 +52,6 @@ topbar VD{j, showsidebar} = [hamlet|
|
|||||||
<span .glyphicon .glyphicon-align-left .tgl-icon>
|
<span .glyphicon .glyphicon-align-left .tgl-icon>
|
||||||
<div#topbar .col-md-8 .col-sm-8 .col-xs-10>
|
<div#topbar .col-md-8 .col-sm-8 .col-xs-10>
|
||||||
<h1>#{title}
|
<h1>#{title}
|
||||||
|
|
||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
title = takeFileName $ journalFilePath j
|
title = takeFileName $ journalFilePath j
|
||||||
@ -106,15 +106,13 @@ searchform VD{q, here} = [hamlet|
|
|||||||
<div #searchbar .input-group>
|
<div #searchbar .input-group>
|
||||||
<input .form-control name=q value=#{q} title="Enter hledger search patterns to filter the data below" placeholder="Search">
|
<input .form-control name=q value=#{q} title="Enter hledger search patterns to filter the data below" placeholder="Search">
|
||||||
<div .input-group-btn>
|
<div .input-group-btn>
|
||||||
$if filtering
|
$if not (T.null q)
|
||||||
<a href=@{here} .btn .btn-default title="Clear search terms">
|
<a href=@{here} .btn .btn-default title="Clear search terms">
|
||||||
<span .glyphicon .glyphicon-remove-circle>
|
<span .glyphicon .glyphicon-remove-circle>
|
||||||
<button .btn .btn-default type=submit title="Apply search terms">
|
<button .btn .btn-default type=submit title="Apply search terms">
|
||||||
<span .glyphicon .glyphicon-search>
|
<span .glyphicon .glyphicon-search>
|
||||||
<button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal" title="Show search and general help">?
|
<button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal" title="Show search and general help">?
|
||||||
|]
|
|]
|
||||||
where
|
|
||||||
filtering = not $ T.null q
|
|
||||||
|
|
||||||
-- -- | Edit journal form.
|
-- -- | Edit journal form.
|
||||||
-- editform :: ViewData -> HtmlUrl AppRoute
|
-- editform :: ViewData -> HtmlUrl AppRoute
|
||||||
@ -234,3 +232,9 @@ mixedAmountAsHtml b = preEscapedString $ unlines $ map addclass $ lines $ showMi
|
|||||||
Just True -> "negative amount"
|
Just True -> "negative amount"
|
||||||
_ -> "positive amount"
|
_ -> "positive amount"
|
||||||
|
|
||||||
|
showErrors :: ToMarkup a => [a] -> Handler ()
|
||||||
|
showErrors errs = setMessage [shamlet|
|
||||||
|
Errors:<br>
|
||||||
|
$forall e<-errs
|
||||||
|
\#{e}<br>
|
||||||
|
|]
|
||||||
|
|||||||
@ -5,8 +5,9 @@ module Handler.JournalR where
|
|||||||
|
|
||||||
import Import
|
import Import
|
||||||
|
|
||||||
import Handler.AddForm
|
|
||||||
import Handler.Common
|
import Handler.Common
|
||||||
|
(accountQuery, hledgerLayout, mixedAmountAsHtml,
|
||||||
|
numberTransactionsReportItems)
|
||||||
|
|
||||||
import Hledger.Cli.CliOptions
|
import Hledger.Cli.CliOptions
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
@ -19,29 +20,24 @@ import Hledger.Web.WebOptions
|
|||||||
getJournalR :: Handler Html
|
getJournalR :: Handler Html
|
||||||
getJournalR = do
|
getJournalR = do
|
||||||
vd@VD{j, m, opts, qopts} <- getViewData
|
vd@VD{j, m, opts, qopts} <- getViewData
|
||||||
let -- XXX like registerReportAsHtml
|
-- XXX like registerReportAsHtml
|
||||||
title = case inAccount qopts of
|
let title = case inAccount qopts of
|
||||||
Nothing -> "General Journal" <> s2
|
Nothing -> "General Journal"
|
||||||
Just (a,inclsubs) -> "Transactions in " <> a <> s1 <> s2
|
Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)"
|
||||||
where s1 = if inclsubs then "" else " (excluding subaccounts)"
|
title' = title <> if m /= Any then ", filtered" else ""
|
||||||
where
|
maincontent = transactionsReportAsHtml $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
|
||||||
s2 = if m /= Any then ", filtered" else ""
|
|
||||||
maincontent = journalTransactionsReportAsHtml $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
|
|
||||||
hledgerLayout vd "journal" [hamlet|
|
hledgerLayout vd "journal" [hamlet|
|
||||||
<div .row>
|
<div .row>
|
||||||
<h2 #contenttitle>#{title}
|
<h2 #contenttitle>#{title'}
|
||||||
<!-- p>Journal entries record movements of commodities between accounts. -->
|
<!-- p>Journal entries record movements of commodities between accounts. -->
|
||||||
<a #addformlink role="button" style="cursor:pointer; margin-top:1em;" data-toggle="modal" data-target="#addmodal" title="Add a new transaction to the journal" href="#">Add a transaction
|
<a #addformlink role="button" style="cursor:pointer; margin-top:1em;" data-toggle="modal" data-target="#addmodal" title="Add a new transaction to the journal" href="#">Add a transaction
|
||||||
<div .table-responsive>
|
<div .table-responsive>
|
||||||
^{maincontent}
|
^{maincontent}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
postJournalR :: Handler Html
|
|
||||||
postJournalR = postAddForm
|
|
||||||
|
|
||||||
-- | Render a "TransactionsReport" as html for the formatted journal view.
|
-- | Render a "TransactionsReport" as html for the formatted journal view.
|
||||||
journalTransactionsReportAsHtml :: TransactionsReport -> HtmlUrl AppRoute
|
transactionsReportAsHtml :: (w, [TransactionsReportItem]) -> HtmlUrl AppRoute
|
||||||
journalTransactionsReportAsHtml (_,items) = [hamlet|
|
transactionsReportAsHtml (_,items) = [hamlet|
|
||||||
<table .transactionsreport .table .table-condensed>
|
<table .transactionsreport .table .table-condensed>
|
||||||
<thead>
|
<thead>
|
||||||
<th .date style="text-align:left;">
|
<th .date style="text-align:left;">
|
||||||
@ -50,11 +46,11 @@ journalTransactionsReportAsHtml (_,items) = [hamlet|
|
|||||||
<th .account style="text-align:left;">Account
|
<th .account style="text-align:left;">Account
|
||||||
<th .amount style="text-align:right;">Amount
|
<th .amount style="text-align:right;">Amount
|
||||||
$forall i <- numberTransactionsReportItems items
|
$forall i <- numberTransactionsReportItems items
|
||||||
^{itemAsHtml i}
|
^{transactionReportItem i}
|
||||||
|]
|
|]
|
||||||
where
|
|
||||||
itemAsHtml :: (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
|
transactionReportItem :: (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
|
||||||
itemAsHtml (_, _, _, _, (torig, _, split, _, amt, _)) = [hamlet|
|
transactionReportItem (_, _, _, _, (torig, _, split, _, amt, _)) = [hamlet|
|
||||||
<tr .title #transaction-#{tindex torig}>
|
<tr .title #transaction-#{tindex torig}>
|
||||||
<td .date nowrap>#{date}
|
<td .date nowrap>#{date}
|
||||||
<td .description colspan=2>#{textElideRight 60 desc}
|
<td .description colspan=2>#{textElideRight 60 desc}
|
||||||
|
|||||||
@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE OverloadedStrings, QuasiQuotes, NamedFieldPuns #-}
|
{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, QuasiQuotes, NamedFieldPuns #-}
|
||||||
-- | /register handlers.
|
-- | /register handlers.
|
||||||
|
|
||||||
module Handler.RegisterR where
|
module Handler.RegisterR where
|
||||||
@ -10,13 +10,9 @@ import Data.List (intersperse)
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Safe (headMay)
|
import Safe (headMay)
|
||||||
|
|
||||||
import Handler.AddForm (postAddForm)
|
import Handler.Common (hledgerLayout, numberTransactionsReportItems, mixedAmountAsHtml)
|
||||||
import Handler.Common
|
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger
|
||||||
import Hledger.Query
|
|
||||||
import Hledger.Reports
|
|
||||||
import Hledger.Utils
|
|
||||||
import Hledger.Cli.CliOptions
|
import Hledger.Cli.CliOptions
|
||||||
import Hledger.Web.WebOptions
|
import Hledger.Web.WebOptions
|
||||||
|
|
||||||
@ -31,22 +27,19 @@ getRegisterR = do
|
|||||||
s2 = if m /= Any then ", filtered" else ""
|
s2 = if m /= Any then ", filtered" else ""
|
||||||
hledgerLayout vd "register" $ do
|
hledgerLayout vd "register" $ do
|
||||||
_ <- [hamlet|<h2 #contenttitle>#{title}|]
|
_ <- [hamlet|<h2 #contenttitle>#{title}|]
|
||||||
registerReportHtml vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
|
registerReportHtml qopts $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
|
||||||
|
|
||||||
postRegisterR :: Handler Html
|
|
||||||
postRegisterR = postAddForm
|
|
||||||
|
|
||||||
-- | Generate html for an account register, including a balance chart and transaction list.
|
-- | Generate html for an account register, including a balance chart and transaction list.
|
||||||
registerReportHtml :: ViewData -> TransactionsReport -> HtmlUrl AppRoute
|
registerReportHtml :: [QueryOpt] -> TransactionsReport -> HtmlUrl AppRoute
|
||||||
registerReportHtml vd r = [hamlet|
|
registerReportHtml qopts r = [hamlet|
|
||||||
<div .hidden-xs>
|
<div .hidden-xs>
|
||||||
^{registerChartHtml $ transactionsReportByCommodity r}
|
^{registerChartHtml $ transactionsReportByCommodity r}
|
||||||
^{registerItemsHtml vd r}
|
^{registerItemsHtml qopts r}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
-- | Generate html for a transaction list from an "TransactionsReport".
|
-- | Generate html for a transaction list from an "TransactionsReport".
|
||||||
registerItemsHtml :: ViewData -> TransactionsReport -> HtmlUrl AppRoute
|
registerItemsHtml :: [QueryOpt] -> TransactionsReport -> HtmlUrl AppRoute
|
||||||
registerItemsHtml VD{qopts} (balancelabel,items) = [hamlet|
|
registerItemsHtml qopts (balancelabel,items) = [hamlet|
|
||||||
<div .table-responsive>
|
<div .table-responsive>
|
||||||
<table.registerreport .table .table-striped .table-condensed>
|
<table.registerreport .table .table-striped .table-condensed>
|
||||||
<thead>
|
<thead>
|
||||||
|
|||||||
@ -2,9 +2,10 @@
|
|||||||
/robots.txt RobotsR GET
|
/robots.txt RobotsR GET
|
||||||
/static StaticR Static getStatic
|
/static StaticR Static getStatic
|
||||||
/ RootR GET
|
/ RootR GET
|
||||||
/journal JournalR GET POST
|
/journal JournalR GET
|
||||||
/register RegisterR GET POST
|
/register RegisterR GET
|
||||||
/sidebar SidebarR GET
|
/sidebar SidebarR GET
|
||||||
|
/add AddR POST
|
||||||
|
|
||||||
-- /accounts AccountsR GET
|
-- /accounts AccountsR GET
|
||||||
-- /api/accounts AccountsJsonR GET
|
-- /api/accounts AccountsJsonR GET
|
||||||
|
|||||||
@ -123,6 +123,7 @@ library
|
|||||||
Application
|
Application
|
||||||
Foundation
|
Foundation
|
||||||
Handler.AddForm
|
Handler.AddForm
|
||||||
|
Handler.AddR
|
||||||
Handler.Common
|
Handler.Common
|
||||||
Handler.JournalR
|
Handler.JournalR
|
||||||
Handler.RegisterR
|
Handler.RegisterR
|
||||||
|
|||||||
@ -119,6 +119,7 @@ library:
|
|||||||
- Foundation
|
- Foundation
|
||||||
- Handler.AddForm
|
- Handler.AddForm
|
||||||
- Handler.Common
|
- Handler.Common
|
||||||
|
- Handler.AddR
|
||||||
- Handler.JournalR
|
- Handler.JournalR
|
||||||
- Handler.RegisterR
|
- Handler.RegisterR
|
||||||
- Handler.RootR
|
- Handler.RootR
|
||||||
|
|||||||
62
hledger-web/templates/add-form.hamlet
Normal file
62
hledger-web/templates/add-form.hamlet
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
<script>
|
||||||
|
jQuery(document).ready(function() {
|
||||||
|
/* set up typeahead fields */
|
||||||
|
descriptionsSuggester = new Bloodhound({
|
||||||
|
local:#{listToJsonValueObjArrayStr descriptions},
|
||||||
|
limit:100,
|
||||||
|
datumTokenizer: function(d) { return [d.value]; },
|
||||||
|
queryTokenizer: function(q) { return [q]; }
|
||||||
|
});
|
||||||
|
descriptionsSuggester.initialize();
|
||||||
|
|
||||||
|
accountsSuggester = new Bloodhound({
|
||||||
|
local:#{listToJsonValueObjArrayStr accts},
|
||||||
|
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);
|
||||||
|
});
|
||||||
|
|
||||||
|
<form#addform action=@{r} method=POST .form>
|
||||||
|
<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 .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 .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
|
||||||
|
<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
|
||||||
|
<a href="#" onclick="addformAddPosting(); return false;">more
|
||||||
|
(or ctrl +, ctrl -)
|
||||||
@ -104,4 +104,4 @@ $newline never
|
|||||||
$maybe m <- lastmsg
|
$maybe m <- lastmsg
|
||||||
$if isPrefixOf "Errors" (renderHtml m)
|
$if isPrefixOf "Errors" (renderHtml m)
|
||||||
<div #message>#{m}
|
<div #message>#{m}
|
||||||
^{addform j}
|
^{addFormHamlet j AddR}
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user