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. | ||||
| -- 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.JournalR (getJournalR, postJournalR) | ||||
| import Handler.RegisterR (getRegisterR, postRegisterR) | ||||
| import Handler.SidebarR (getSidebarR) | ||||
| 
 | ||||
| import Hledger.Data (Journal, nulljournal) | ||||
|  | ||||
| @ -6,20 +6,19 @@ | ||||
| module Foundation where | ||||
| 
 | ||||
| import Data.IORef (IORef, readIORef, writeIORef) | ||||
| import Data.List (isPrefixOf, sort, nub) | ||||
| import Data.List (isPrefixOf) | ||||
| import Data.Maybe (fromMaybe) | ||||
| import Data.Text (Text) | ||||
| import Data.Time.Calendar (Day) | ||||
| import Network.HTTP.Conduit (Manager) | ||||
| import Text.Blaze (Markup) | ||||
| import Text.Blaze.Internal (preEscapedString) | ||||
| import Text.Blaze.Html.Renderer.String (renderHtml) | ||||
| import Text.Hamlet (hamletFile) | ||||
| import Text.JSON | ||||
| import Yesod | ||||
| import Yesod.Static | ||||
| import Yesod.Default.Config | ||||
| 
 | ||||
| import Handler.AddForm | ||||
| import Settings.StaticFiles | ||||
| import Settings (widgetFile, Extra (..)) | ||||
| #ifndef DEVELOPMENT | ||||
| @ -233,104 +232,3 @@ getCurrentJournal jref opts d = do | ||||
| -- referentially transparent manner (allowing multiple reads). | ||||
| getLastMessage :: Handler (Maybe Html) | ||||
| 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 | ||||
| -- Foundation so that the add form can be in the default layout for | ||||
| -- 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 (sortBy) | ||||
| import Data.List (sort, nub) | ||||
| import Data.Semigroup ((<>)) | ||||
| import Data.Text (Text) | ||||
| import qualified Data.Text as T | ||||
| import Data.Time.Calendar | ||||
| import Data.Void (Void) | ||||
| import Safe (headMay) | ||||
| import Text.Blaze (ToMarkup) | ||||
| import Text.Megaparsec | ||||
| import Text.Megaparsec.Char | ||||
| import Text.Blaze.Internal (preEscapedString) | ||||
| import Text.Hamlet (hamletFile) | ||||
| import Text.JSON | ||||
| import Yesod (HtmlUrl, HandlerSite, RenderMessage) | ||||
| import Yesod.Form | ||||
| 
 | ||||
| import Hledger | ||||
| import Hledger.Cli.Commands.Add (appendToJournalFileOrStdout) | ||||
| 
 | ||||
| -- Part of the data required from the add form. | ||||
| -- Don't know how to handle the variable posting fields with yesod-form yet. | ||||
| @ -29,7 +35,7 @@ data AddForm = AddForm | ||||
|     , addFormJournalFile  :: Maybe Text | ||||
|     } deriving Show | ||||
| 
 | ||||
| addForm :: Day -> Journal -> FormInput Handler AddForm | ||||
| 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" | ||||
| @ -44,79 +50,12 @@ addForm today j = AddForm | ||||
|       Right d  -> Right d | ||||
|       Left _   -> Left $ MsgInvalidEntry $ "could not parse date \"" <> s <> "\":" | ||||
| 
 | ||||
| postAddForm :: Handler Html | ||||
| postAddForm = 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 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> | ||||
| |] | ||||
| 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 | ||||
|  | ||||
							
								
								
									
										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 Data.Time.Calendar (Day, toGregorian) | ||||
| import System.FilePath (takeFileName) | ||||
| import Text.Blaze (ToMarkup) | ||||
| import Text.Blaze.Internal (preEscapedString) | ||||
| import Text.Printf (printf) | ||||
| 
 | ||||
| @ -51,7 +52,6 @@ topbar VD{j, showsidebar} = [hamlet| | ||||
|    <span .glyphicon .glyphicon-align-left .tgl-icon> | ||||
| <div#topbar .col-md-8 .col-sm-8 .col-xs-10> | ||||
|  <h1>#{title} | ||||
| 
 | ||||
| |] | ||||
|   where | ||||
|     title = takeFileName $ journalFilePath j | ||||
| @ -106,15 +106,13 @@ searchform VD{q, here} = [hamlet| | ||||
|     <div #searchbar .input-group> | ||||
|      <input .form-control name=q value=#{q} title="Enter hledger search patterns to filter the data below" placeholder="Search"> | ||||
|      <div .input-group-btn> | ||||
|       $if filtering | ||||
|       $if not (T.null q) | ||||
|        <a href=@{here} .btn .btn-default title="Clear search terms"> | ||||
|         <span .glyphicon .glyphicon-remove-circle> | ||||
|       <button .btn .btn-default type=submit title="Apply search terms"> | ||||
|        <span .glyphicon .glyphicon-search> | ||||
|       <button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal" title="Show search and general help">? | ||||
| |] | ||||
|  where | ||||
|   filtering = not $ T.null q | ||||
| 
 | ||||
| -- -- | Edit journal form. | ||||
| -- editform :: ViewData -> HtmlUrl AppRoute | ||||
| @ -234,3 +232,9 @@ mixedAmountAsHtml b = preEscapedString $ unlines $ map addclass $ lines $ showMi | ||||
|             Just True -> "negative 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 Handler.AddForm | ||||
| import Handler.Common | ||||
|        (accountQuery, hledgerLayout, mixedAmountAsHtml, | ||||
|         numberTransactionsReportItems) | ||||
| 
 | ||||
| import Hledger.Cli.CliOptions | ||||
| import Hledger.Data | ||||
| @ -19,29 +20,24 @@ import Hledger.Web.WebOptions | ||||
| getJournalR :: Handler Html | ||||
| getJournalR = do | ||||
|   vd@VD{j, m, opts, qopts} <- getViewData | ||||
|   let -- XXX like registerReportAsHtml | ||||
|       title = case inAccount qopts of | ||||
|                 Nothing       -> "General Journal" <> s2 | ||||
|                 Just (a,inclsubs) -> "Transactions in " <> a <> s1 <> s2 | ||||
|                   where s1 = if inclsubs then "" else " (excluding subaccounts)" | ||||
|                 where | ||||
|                   s2 = if m /= Any then ", filtered" else "" | ||||
|       maincontent = journalTransactionsReportAsHtml $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m | ||||
|   -- XXX like registerReportAsHtml | ||||
|   let title = case inAccount qopts of | ||||
|         Nothing -> "General Journal" | ||||
|         Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)" | ||||
|       title' = title <> if m /= Any then ", filtered" else "" | ||||
|       maincontent = transactionsReportAsHtml $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m | ||||
|   hledgerLayout vd "journal" [hamlet| | ||||
|        <div .row> | ||||
|         <h2 #contenttitle>#{title} | ||||
|         <h2 #contenttitle>#{title'} | ||||
|         <!-- 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 | ||||
|        <div .table-responsive> | ||||
|         ^{maincontent} | ||||
|      |] | ||||
| 
 | ||||
| postJournalR :: Handler Html | ||||
| postJournalR = postAddForm | ||||
| 
 | ||||
| -- | Render a "TransactionsReport" as html for the formatted journal view. | ||||
| journalTransactionsReportAsHtml :: TransactionsReport -> HtmlUrl AppRoute | ||||
| journalTransactionsReportAsHtml (_,items) = [hamlet| | ||||
| transactionsReportAsHtml :: (w, [TransactionsReportItem]) -> HtmlUrl AppRoute | ||||
| transactionsReportAsHtml (_,items) = [hamlet| | ||||
| <table .transactionsreport .table .table-condensed> | ||||
|  <thead> | ||||
|   <th .date style="text-align:left;"> | ||||
| @ -50,11 +46,11 @@ journalTransactionsReportAsHtml (_,items) = [hamlet| | ||||
|   <th .account style="text-align:left;">Account | ||||
|   <th .amount style="text-align:right;">Amount | ||||
|  $forall i <- numberTransactionsReportItems items | ||||
|   ^{itemAsHtml i} | ||||
|   ^{transactionReportItem i} | ||||
|  |] | ||||
|  where | ||||
|    itemAsHtml :: (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute | ||||
|    itemAsHtml (_, _, _, _, (torig, _, split, _, amt, _)) = [hamlet| | ||||
| 
 | ||||
| transactionReportItem :: (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute | ||||
| transactionReportItem (_, _, _, _, (torig, _, split, _, amt, _)) = [hamlet| | ||||
| <tr .title #transaction-#{tindex torig}> | ||||
|  <td .date nowrap>#{date} | ||||
|  <td .description colspan=2>#{textElideRight 60 desc} | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| {-# LANGUAGE OverloadedStrings, QuasiQuotes, NamedFieldPuns #-} | ||||
| {-# LANGUAGE ScopedTypeVariables, OverloadedStrings, QuasiQuotes, NamedFieldPuns #-} | ||||
| -- | /register handlers. | ||||
| 
 | ||||
| module Handler.RegisterR where | ||||
| @ -10,13 +10,9 @@ import Data.List (intersperse) | ||||
| import qualified Data.Text as T | ||||
| import Safe (headMay) | ||||
| 
 | ||||
| import Handler.AddForm (postAddForm) | ||||
| import Handler.Common | ||||
| import Handler.Common (hledgerLayout, numberTransactionsReportItems, mixedAmountAsHtml) | ||||
| 
 | ||||
| import Hledger.Data | ||||
| import Hledger.Query | ||||
| import Hledger.Reports | ||||
| import Hledger.Utils | ||||
| import Hledger | ||||
| import Hledger.Cli.CliOptions | ||||
| import Hledger.Web.WebOptions | ||||
| 
 | ||||
| @ -31,22 +27,19 @@ getRegisterR = do | ||||
|           s2 = if m /= Any then ", filtered" else "" | ||||
|   hledgerLayout vd "register" $ do | ||||
|     _ <- [hamlet|<h2 #contenttitle>#{title}|] | ||||
|     registerReportHtml vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts | ||||
| 
 | ||||
| postRegisterR :: Handler Html | ||||
| postRegisterR = postAddForm | ||||
|     registerReportHtml qopts $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts | ||||
| 
 | ||||
| -- | Generate html for an account register, including a balance chart and transaction list. | ||||
| registerReportHtml :: ViewData -> TransactionsReport -> HtmlUrl AppRoute | ||||
| registerReportHtml vd r = [hamlet| | ||||
| registerReportHtml :: [QueryOpt] -> TransactionsReport -> HtmlUrl AppRoute | ||||
| registerReportHtml qopts r = [hamlet| | ||||
|  <div .hidden-xs> | ||||
|   ^{registerChartHtml $ transactionsReportByCommodity r} | ||||
|  ^{registerItemsHtml vd r} | ||||
|  ^{registerItemsHtml qopts r} | ||||
| |] | ||||
| 
 | ||||
| -- | Generate html for a transaction list from an "TransactionsReport". | ||||
| registerItemsHtml :: ViewData -> TransactionsReport -> HtmlUrl AppRoute | ||||
| registerItemsHtml VD{qopts} (balancelabel,items) = [hamlet| | ||||
| registerItemsHtml :: [QueryOpt] -> TransactionsReport -> HtmlUrl AppRoute | ||||
| registerItemsHtml qopts (balancelabel,items) = [hamlet| | ||||
| <div .table-responsive> | ||||
|  <table.registerreport .table .table-striped .table-condensed> | ||||
|   <thead> | ||||
|  | ||||
| @ -2,9 +2,10 @@ | ||||
| /robots.txt      RobotsR         GET | ||||
| /static          StaticR         Static getStatic | ||||
| /                RootR           GET | ||||
| /journal         JournalR        GET POST | ||||
| /register        RegisterR       GET POST | ||||
| /journal         JournalR        GET | ||||
| /register        RegisterR       GET | ||||
| /sidebar         SidebarR        GET | ||||
| /add             AddR            POST | ||||
| 
 | ||||
| -- /accounts        AccountsR       GET | ||||
| -- /api/accounts    AccountsJsonR   GET | ||||
|  | ||||
| @ -123,6 +123,7 @@ library | ||||
|       Application | ||||
|       Foundation | ||||
|       Handler.AddForm | ||||
|       Handler.AddR | ||||
|       Handler.Common | ||||
|       Handler.JournalR | ||||
|       Handler.RegisterR | ||||
|  | ||||
| @ -119,6 +119,7 @@ library: | ||||
|   - Foundation | ||||
|   - Handler.AddForm | ||||
|   - Handler.Common | ||||
|   - Handler.AddR | ||||
|   - Handler.JournalR | ||||
|   - Handler.RegisterR | ||||
|   - 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 | ||||
|                   $if isPrefixOf "Errors" (renderHtml m) | ||||
|                     <div #message>#{m} | ||||
|                 ^{addform j} | ||||
|                 ^{addFormHamlet j AddR} | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user