mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
web: Remove dead code
This commit is contained in:
parent
ee97e476c8
commit
7404813239
@ -1,3 +1,4 @@
|
|||||||
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
{-# LANGUAGE CPP, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, QuasiQuotes, TemplateHaskell, TypeFamilies, TypeSynonymInstances, FlexibleInstances #-}
|
{-# LANGUAGE CPP, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, QuasiQuotes, TemplateHaskell, TypeFamilies, TypeSynonymInstances, FlexibleInstances #-}
|
||||||
-- | Define the web application's foundation, in the usual Yesod style.
|
-- | Define the web application's foundation, in the usual Yesod style.
|
||||||
-- See a default Yesod app's comments for more details of each part.
|
-- See a default Yesod app's comments for more details of each part.
|
||||||
@ -102,7 +103,6 @@ instance Yesod App where
|
|||||||
<script type="text/javascript" src="@{StaticR js_typeahead_bundle_min_js}">
|
<script type="text/javascript" src="@{StaticR js_typeahead_bundle_min_js}">
|
||||||
|]
|
|]
|
||||||
addScript $ StaticR js_bootstrap_min_js
|
addScript $ StaticR js_bootstrap_min_js
|
||||||
-- addScript $ StaticR js_typeahead_bundle_min_js
|
|
||||||
addScript $ StaticR js_bootstrap_datepicker_min_js
|
addScript $ StaticR js_bootstrap_datepicker_min_js
|
||||||
addScript $ StaticR js_jquery_url_js
|
addScript $ StaticR js_jquery_url_js
|
||||||
addScript $ StaticR js_jquery_cookie_js
|
addScript $ StaticR js_jquery_cookie_js
|
||||||
@ -131,15 +131,12 @@ instance Yesod App where
|
|||||||
instance RenderMessage App FormMessage where
|
instance RenderMessage App FormMessage where
|
||||||
renderMessage _ _ = defaultFormMessage
|
renderMessage _ _ = defaultFormMessage
|
||||||
|
|
||||||
-- | Get the 'Extra' value, used to hold data from the settings.yml file.
|
|
||||||
getExtra :: Handler Extra
|
|
||||||
getExtra = fmap (appExtra . settings) getYesod
|
|
||||||
|
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
-- template and handler utilities
|
-- template and handler utilities
|
||||||
|
|
||||||
-- view data, used by the add form and handlers
|
-- view data, used by the add form and handlers
|
||||||
|
-- XXX Parameter p - show/hide postings
|
||||||
|
|
||||||
-- | A bundle of data useful for hledger-web request handlers and templates.
|
-- | A bundle of data useful for hledger-web request handlers and templates.
|
||||||
data ViewData = VD {
|
data ViewData = VD {
|
||||||
@ -153,7 +150,6 @@ data ViewData = VD {
|
|||||||
,qopts :: [QueryOpt] -- ^ query options 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)
|
,am :: Query -- ^ a query parsed from the accounts sidebar query expr ("a" parameter)
|
||||||
,aopts :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr
|
,aopts :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr
|
||||||
,showpostings :: Bool -- ^ current p parameter, 1 or 0 shows/hides all postings where applicable
|
|
||||||
,showsidebar :: Bool -- ^ current showsidebar cookie value
|
,showsidebar :: Bool -- ^ current showsidebar cookie value
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
@ -161,11 +157,11 @@ instance Show Text.Blaze.Markup where show _ = "<blaze markup>"
|
|||||||
|
|
||||||
-- | Make a default ViewData, using day 0 as today's date.
|
-- | Make a default ViewData, using day 0 as today's date.
|
||||||
nullviewdata :: ViewData
|
nullviewdata :: ViewData
|
||||||
nullviewdata = viewdataWithDateAndParams nulldate "" "" ""
|
nullviewdata = viewdataWithDateAndParams nulldate "" ""
|
||||||
|
|
||||||
-- | Make a ViewData using the given date and request parameters, and defaults elsewhere.
|
-- | Make a ViewData using the given date and request parameters, and defaults elsewhere.
|
||||||
viewdataWithDateAndParams :: Day -> Text -> Text -> Text -> ViewData
|
viewdataWithDateAndParams :: Day -> Text -> Text -> ViewData
|
||||||
viewdataWithDateAndParams d q a p =
|
viewdataWithDateAndParams d q a =
|
||||||
let (querymatcher,queryopts) = parseQuery d q
|
let (querymatcher,queryopts) = parseQuery d q
|
||||||
(acctsmatcher,acctsopts) = parseQuery d a
|
(acctsmatcher,acctsopts) = parseQuery d a
|
||||||
in VD {
|
in VD {
|
||||||
@ -179,7 +175,6 @@ viewdataWithDateAndParams d q a p =
|
|||||||
,qopts = queryopts
|
,qopts = queryopts
|
||||||
,am = acctsmatcher
|
,am = acctsmatcher
|
||||||
,aopts = acctsopts
|
,aopts = acctsopts
|
||||||
,showpostings = p == "1"
|
|
||||||
,showsidebar = True
|
,showsidebar = True
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -196,16 +191,15 @@ getViewData = do
|
|||||||
(j, merr) <- getCurrentJournal app copts{reportopts_=ropts{no_elide_=True}} today
|
(j, merr) <- getCurrentJournal app copts{reportopts_=ropts{no_elide_=True}} today
|
||||||
lastmsg <- getLastMessage
|
lastmsg <- getLastMessage
|
||||||
let msg = maybe lastmsg (Just . toHtml) merr
|
let msg = maybe lastmsg (Just . toHtml) merr
|
||||||
q <- getParameterOrNull "q"
|
q <- fromMaybe "" <$> lookupGetParam "q"
|
||||||
a <- getParameterOrNull "a"
|
a <- fromMaybe "" <$> lookupGetParam "a"
|
||||||
p <- getParameterOrNull "p"
|
|
||||||
-- sidebar visibility: show it, unless there is a showsidebar cookie
|
-- sidebar visibility: show it, unless there is a showsidebar cookie
|
||||||
-- set to "0", or a ?sidebar=0 query parameter.
|
-- set to "0", or a ?sidebar=0 query parameter.
|
||||||
msidebarparam <- lookupGetParam "sidebar"
|
msidebarparam <- lookupGetParam "sidebar"
|
||||||
msidebarcookie <- reqCookies <$> getRequest >>= return . lookup "showsidebar"
|
msidebarcookie <- reqCookies <$> getRequest >>= return . lookup "showsidebar"
|
||||||
let showsidebar = maybe (msidebarcookie /= Just "0") (/="0") msidebarparam
|
let showsidebar = maybe (msidebarcookie /= Just "0") (/="0") msidebarparam
|
||||||
|
|
||||||
return (viewdataWithDateAndParams today q a p){
|
return (viewdataWithDateAndParams today q a){
|
||||||
opts=opts
|
opts=opts
|
||||||
,msg=msg
|
,msg=msg
|
||||||
,here=here
|
,here=here
|
||||||
@ -230,13 +224,9 @@ getViewData = do
|
|||||||
else case ej' of
|
else case ej' of
|
||||||
Right j' -> do liftIO $ writeIORef (appJournal app) j'
|
Right j' -> do liftIO $ writeIORef (appJournal app) j'
|
||||||
return (j',Nothing)
|
return (j',Nothing)
|
||||||
Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-}
|
Left e -> do setMessage "error while reading"
|
||||||
return (j, Just e)
|
return (j, Just e)
|
||||||
|
|
||||||
-- | Get the named request parameter, or the empty string if not present.
|
|
||||||
getParameterOrNull :: Text -> Handler Text
|
|
||||||
getParameterOrNull = fmap (fromMaybe "") . lookupGetParam
|
|
||||||
|
|
||||||
-- | Get the message that was set by the last request, in a
|
-- | Get the message that was set by the last request, in a
|
||||||
-- referentially transparent manner (allowing multiple reads).
|
-- referentially transparent manner (allowing multiple reads).
|
||||||
getLastMessage :: Handler (Maybe Html)
|
getLastMessage :: Handler (Maybe Html)
|
||||||
|
@ -10,11 +10,11 @@ import Import
|
|||||||
import Control.Monad.State.Strict (evalStateT)
|
import Control.Monad.State.Strict (evalStateT)
|
||||||
import Data.Either (lefts, rights)
|
import Data.Either (lefts, rights)
|
||||||
import Data.List (sort)
|
import Data.List (sort)
|
||||||
import qualified Data.List as L (head) -- qualified keeps dev & prod builds warning-free
|
import Data.Maybe (fromMaybe, maybeToList)
|
||||||
import Data.Maybe (fromMaybe)
|
|
||||||
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 Data.Void (Void)
|
||||||
|
import Safe (headMay)
|
||||||
import Text.Megaparsec
|
import Text.Megaparsec
|
||||||
import Text.Megaparsec.Char
|
import Text.Megaparsec.Char
|
||||||
|
|
||||||
@ -23,18 +23,16 @@ 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.
|
||||||
|
-- XXX Variable postings fields
|
||||||
data AddForm = AddForm
|
data AddForm = AddForm
|
||||||
{ addFormDate :: Day
|
{ addFormDate :: Day
|
||||||
, addFormDescription :: Maybe Text
|
, addFormDescription :: Maybe Text
|
||||||
-- , addFormPostings :: [(AccountName, String)]
|
|
||||||
, addFormJournalFile :: Maybe Text
|
, addFormJournalFile :: Maybe Text
|
||||||
}
|
} deriving Show
|
||||||
deriving Show
|
|
||||||
|
|
||||||
postAddForm :: Handler Html
|
postAddForm :: Handler Html
|
||||||
postAddForm = do
|
postAddForm = do
|
||||||
let showErrors errs = do
|
let showErrors errs = do
|
||||||
-- error $ show errs -- XXX uncomment to prevent redirect for debugging
|
|
||||||
setMessage [shamlet|
|
setMessage [shamlet|
|
||||||
Errors:<br>
|
Errors:<br>
|
||||||
$forall e<-errs
|
$forall e<-errs
|
||||||
@ -43,20 +41,18 @@ postAddForm = do
|
|||||||
-- 1. process the fixed fields with yesod-form
|
-- 1. process the fixed fields with yesod-form
|
||||||
|
|
||||||
VD{..} <- getViewData
|
VD{..} <- getViewData
|
||||||
let
|
let validateJournalFile :: Text -> Either FormMessage Text
|
||||||
validateJournalFile :: Text -> Either FormMessage Text
|
|
||||||
validateJournalFile f
|
validateJournalFile f
|
||||||
| T.unpack f `elem` journalFilePaths j = Right f
|
| T.unpack f `elem` journalFilePaths j = Right f
|
||||||
| otherwise = Left $ MsgInvalidEntry $ "the selected journal file \"" <> f <> "\"is unknown"
|
| otherwise = Left $ MsgInvalidEntry $ "the selected journal file \"" <> f <> "\"is unknown"
|
||||||
|
|
||||||
validateDate :: Text -> Handler (Either FormMessage Day)
|
validateDate :: Text -> Either FormMessage Day
|
||||||
validateDate s = return $
|
validateDate s = case fixSmartDateStrEither' today (T.strip s) of
|
||||||
case fixSmartDateStrEither' today (T.strip s) of
|
Right d -> Right d
|
||||||
Right d -> Right d
|
Left _ -> Left $ MsgInvalidEntry $ "could not parse date \"" <> s <> "\":"
|
||||||
Left _ -> Left $ MsgInvalidEntry $ "could not parse date \"" <> s <> "\":"
|
|
||||||
|
|
||||||
formresult <- runInputPostResult $ AddForm
|
formresult <- runInputPostResult $ AddForm
|
||||||
<$> ireq (checkMMap validateDate (T.pack . show) textField) "date"
|
<$> ireq (checkMMap (pure . validateDate) (T.pack . show) textField) "date"
|
||||||
<*> iopt textField "description"
|
<*> iopt textField "description"
|
||||||
<*> iopt (check validateJournalFile textField) "journal"
|
<*> iopt (check validateJournalFile textField) "journal"
|
||||||
|
|
||||||
@ -99,7 +95,7 @@ postAddForm = do
|
|||||||
| otherwise = amts' ++ [missingamt]
|
| otherwise = amts' ++ [missingamt]
|
||||||
errs = if not (null paramErrs) then paramErrs else (acctErrs ++ amtErrs)
|
errs = if not (null paramErrs) then paramErrs else (acctErrs ++ amtErrs)
|
||||||
etxn | not $ null errs = Left errs
|
etxn | not $ null errs = Left errs
|
||||||
| otherwise = either (\e -> Left [L.head $ lines e]) Right
|
| otherwise = either (Left . maybeToList . headMay . lines) Right
|
||||||
(balanceTransaction Nothing $ nulltransaction {
|
(balanceTransaction Nothing $ nulltransaction {
|
||||||
tdate=date
|
tdate=date
|
||||||
,tdescription=desc
|
,tdescription=desc
|
||||||
|
@ -75,7 +75,7 @@ sidebar vd@VD{..} =
|
|||||||
ropts = reportopts_ $ cliopts_ opts
|
ropts = reportopts_ $ cliopts_ opts
|
||||||
-- flip the default for items with zero amounts, show them by default
|
-- flip the default for items with zero amounts, show them by default
|
||||||
ropts' = ropts{empty_=not $ empty_ ropts}
|
ropts' = ropts{empty_=not $ empty_ ropts}
|
||||||
accounts = balanceReportAsHtml opts vd $ balanceReport ropts' am j
|
accounts = balanceReportAsHtml vd $ balanceReport ropts' am j
|
||||||
showmd = if showsidebar then "col-md-4" else "col-any-0" :: Text
|
showmd = if showsidebar then "col-md-4" else "col-any-0" :: Text
|
||||||
showsm = if showsidebar then "col-sm-4" else "" :: Text
|
showsm = if showsidebar then "col-sm-4" else "" :: Text
|
||||||
|
|
||||||
@ -169,19 +169,15 @@ helplink topic label = [hamlet|
|
|||||||
|]
|
|]
|
||||||
where u = manualurl <> if T.null topic then "" else T.cons '#' topic
|
where u = manualurl <> if T.null topic then "" else T.cons '#' topic
|
||||||
|
|
||||||
nulltemplate :: HtmlUrl AppRoute
|
|
||||||
nulltemplate = [hamlet||]
|
|
||||||
|
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
-- hledger report renderers
|
-- hledger report renderers
|
||||||
|
|
||||||
-- | Render a "BalanceReport" as html.
|
-- | Render a "BalanceReport" as html.
|
||||||
balanceReportAsHtml :: WebOpts -> ViewData -> BalanceReport -> HtmlUrl AppRoute
|
balanceReportAsHtml :: ViewData -> BalanceReport -> HtmlUrl AppRoute
|
||||||
balanceReportAsHtml _ vd@VD{..} (items',total) =
|
balanceReportAsHtml VD{..} (items, total) =
|
||||||
[hamlet|
|
[hamlet|
|
||||||
$forall i <- items
|
$forall i <- items
|
||||||
^{itemAsHtml vd i}
|
^{itemAsHtml i}
|
||||||
<tr .total>
|
<tr .total>
|
||||||
<td>
|
<td>
|
||||||
<td>
|
<td>
|
||||||
@ -190,9 +186,8 @@ balanceReportAsHtml _ vd@VD{..} (items',total) =
|
|||||||
where
|
where
|
||||||
l = ledgerFromJournal Any j
|
l = ledgerFromJournal Any j
|
||||||
inacctmatcher = inAccountQuery qopts
|
inacctmatcher = inAccountQuery qopts
|
||||||
items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher
|
itemAsHtml :: BalanceReportItem -> HtmlUrl AppRoute
|
||||||
itemAsHtml :: ViewData -> BalanceReportItem -> HtmlUrl AppRoute
|
itemAsHtml (acct, adisplay, aindent, abal) = [hamlet|
|
||||||
itemAsHtml _ (acct, adisplay, aindent, abal) = [hamlet|
|
|
||||||
<tr .#{inacctclass}>
|
<tr .#{inacctclass}>
|
||||||
<td .acct>
|
<td .acct>
|
||||||
<div .ff-wrapper>
|
<div .ff-wrapper>
|
||||||
@ -218,9 +213,6 @@ accountQuery = ("inacct:" <>) . quoteIfSpaced
|
|||||||
accountOnlyQuery :: AccountName -> Text
|
accountOnlyQuery :: AccountName -> Text
|
||||||
accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
|
accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
|
||||||
|
|
||||||
accountUrl :: AppRoute -> AccountName -> (AppRoute, [(Text, Text)])
|
|
||||||
accountUrl r a = (r, [("q", accountQuery a)])
|
|
||||||
|
|
||||||
numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
|
numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
|
||||||
numberTransactionsReportItems [] = []
|
numberTransactionsReportItems [] = []
|
||||||
numberTransactionsReportItems items = number 0 nulldate items
|
numberTransactionsReportItems items = number 0 nulldate items
|
||||||
|
@ -20,16 +20,12 @@ getJournalR :: Handler Html
|
|||||||
getJournalR = do
|
getJournalR = do
|
||||||
vd@VD{..} <- getViewData
|
vd@VD{..} <- getViewData
|
||||||
let -- XXX like registerReportAsHtml
|
let -- XXX like registerReportAsHtml
|
||||||
inacct = inAccount qopts
|
title = case inAccount qopts of
|
||||||
-- injournal = isNothing inacct
|
|
||||||
filtering = m /= Any
|
|
||||||
-- showlastcolumn = if injournal && not filtering then False else True
|
|
||||||
title = case inacct of
|
|
||||||
Nothing -> "General Journal" <> s2
|
Nothing -> "General Journal" <> s2
|
||||||
Just (a,inclsubs) -> "Transactions in " <> a <> s1 <> s2
|
Just (a,inclsubs) -> "Transactions in " <> a <> s1 <> s2
|
||||||
where s1 = if inclsubs then "" else " (excluding subaccounts)"
|
where s1 = if inclsubs then "" else " (excluding subaccounts)"
|
||||||
where
|
where
|
||||||
s2 = if filtering then ", filtered" else ""
|
s2 = if m /= Any then ", filtered" else ""
|
||||||
maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
|
maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
|
||||||
hledgerLayout vd "journal" [hamlet|
|
hledgerLayout vd "journal" [hamlet|
|
||||||
<div .row>
|
<div .row>
|
||||||
@ -57,7 +53,6 @@ journalTransactionsReportAsHtml _ vd (_,items) = [hamlet|
|
|||||||
^{itemAsHtml vd i}
|
^{itemAsHtml vd i}
|
||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
-- .#{datetransition}
|
|
||||||
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
|
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
|
||||||
itemAsHtml VD{..} (_, _, _, _, (torig, _, split, _, amt, _)) = [hamlet|
|
itemAsHtml VD{..} (_, _, _, _, (torig, _, split, _, amt, _)) = [hamlet|
|
||||||
<tr .title #transaction-#{tindex torig}>
|
<tr .title #transaction-#{tindex torig}>
|
||||||
|
@ -5,14 +5,14 @@ module Handler.RegisterR where
|
|||||||
|
|
||||||
import Import
|
import Import
|
||||||
|
|
||||||
|
import Data.Time
|
||||||
import Data.List (intersperse)
|
import Data.List (intersperse)
|
||||||
import Data.Maybe (fromMaybe, isJust)
|
import Data.Maybe (fromMaybe, isJust)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Safe (headMay)
|
import Safe (headMay)
|
||||||
|
|
||||||
import Handler.AddForm
|
import Handler.AddForm (postAddForm)
|
||||||
import Handler.Common
|
import Handler.Common
|
||||||
import Handler.Utils
|
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
import Hledger.Query
|
import Hledger.Query
|
||||||
@ -25,25 +25,19 @@ import Hledger.Web.WebOptions
|
|||||||
getRegisterR :: Handler Html
|
getRegisterR :: Handler Html
|
||||||
getRegisterR = do
|
getRegisterR = do
|
||||||
vd@VD{..} <- getViewData
|
vd@VD{..} <- getViewData
|
||||||
-- staticRootUrl <- (staticRoot . settings) <$> getYesod
|
let title = a <> s1 <> s2
|
||||||
let -- injournal = isNothing inacct
|
|
||||||
filtering = m /= Any
|
|
||||||
title = a <> s1 <> s2
|
|
||||||
where
|
where
|
||||||
(a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts
|
(a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts
|
||||||
s1 = if inclsubs then "" else " (excluding subaccounts)"
|
s1 = if inclsubs then "" else " (excluding subaccounts)"
|
||||||
s2 = if filtering then ", filtered" else ""
|
s2 = if m /= Any then ", filtered" else ""
|
||||||
maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
|
hledgerLayout vd "register" $ do
|
||||||
hledgerLayout vd "register" [hamlet|
|
_ <- [hamlet|<h2 #contenttitle>#{title}|]
|
||||||
<h2 #contenttitle>#{title}
|
registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
|
||||||
<!-- p>Transactions affecting this account, with running balance. -->
|
|
||||||
^{maincontent}
|
|
||||||
|]
|
|
||||||
|
|
||||||
postRegisterR :: Handler Html
|
postRegisterR :: Handler Html
|
||||||
postRegisterR = postAddForm
|
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 :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
|
registerReportHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
|
||||||
registerReportHtml opts vd r = [hamlet|
|
registerReportHtml opts vd r = [hamlet|
|
||||||
<div .hidden-xs>
|
<div .hidden-xs>
|
||||||
@ -51,7 +45,7 @@ registerReportHtml opts vd r = [hamlet|
|
|||||||
^{registerItemsHtml opts vd r}
|
^{registerItemsHtml opts vd r}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
-- Generate html for a transaction list from an "TransactionsReport".
|
-- | Generate html for a transaction list from an "TransactionsReport".
|
||||||
registerItemsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
|
registerItemsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
|
||||||
registerItemsHtml _ vd (balancelabel,items) = [hamlet|
|
registerItemsHtml _ vd (balancelabel,items) = [hamlet|
|
||||||
<div .table-responsive>
|
<div .table-responsive>
|
||||||
@ -72,10 +66,8 @@ registerItemsHtml _ vd (balancelabel,items) = [hamlet|
|
|||||||
insomeacct = isJust $ inAccount $ qopts vd
|
insomeacct = isJust $ inAccount $ qopts vd
|
||||||
balancelabel' = if insomeacct then balancelabel else "Total"
|
balancelabel' = if insomeacct then balancelabel else "Total"
|
||||||
|
|
||||||
-- filtering = m /= Any
|
|
||||||
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
|
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
|
||||||
itemAsHtml VD{..} (n, newd, newm, _, (torig, tacct, split, acct, amt, bal)) = [hamlet|
|
itemAsHtml VD{..} (n, newd, newm, _, (torig, tacct, split, acct, amt, bal)) = [hamlet|
|
||||||
|
|
||||||
<tr ##{tindex torig} .item.#{evenodd}.#{firstposting}.#{datetransition} title="#{show torig}" style="vertical-align:top;">
|
<tr ##{tindex torig} .item.#{evenodd}.#{firstposting}.#{datetransition} title="#{show torig}" style="vertical-align:top;">
|
||||||
<td .date>
|
<td .date>
|
||||||
<a href="@{JournalR}#transaction-#{tindex torig}">#{date}
|
<a href="@{JournalR}#transaction-#{tindex torig}">#{date}
|
||||||
@ -86,22 +78,16 @@ registerItemsHtml _ vd (balancelabel,items) = [hamlet|
|
|||||||
\#{mixedAmountAsHtml amt}
|
\#{mixedAmountAsHtml amt}
|
||||||
<td .balance style="text-align:right;">#{mixedAmountAsHtml bal}
|
<td .balance style="text-align:right;">#{mixedAmountAsHtml bal}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
where
|
where
|
||||||
evenodd = if even n then "even" else "odd" :: Text
|
evenodd = if even n then "even" else "odd" :: Text
|
||||||
datetransition | newm = "newmonth"
|
datetransition | newm = "newmonth"
|
||||||
| newd = "newday"
|
| newd = "newday"
|
||||||
| otherwise = "" :: Text
|
| otherwise = "" :: Text
|
||||||
(firstposting, date, desc) = (False, show $ tdate tacct, tdescription tacct)
|
(firstposting, date, desc) = (False, show $ tdate tacct, tdescription tacct)
|
||||||
-- acctquery = (here, [("q", pack $ accountQuery acct)])
|
|
||||||
showamt = not split || not (isZeroMixedAmount amt)
|
showamt = not split || not (isZeroMixedAmount amt)
|
||||||
|
|
||||||
-- | Generate javascript/html for a register balance line chart based on
|
-- | Generate javascript/html for a register balance line chart based on
|
||||||
-- the provided "TransactionsReportItem"s.
|
-- the provided "TransactionsReportItem"s.
|
||||||
-- registerChartHtml :: forall t (t1 :: * -> *) t2 t3 t4 t5.
|
|
||||||
-- Data.Foldable.Foldable t1 =>
|
|
||||||
-- t1 (Transaction, t2, t3, t4, t5, MixedAmount)
|
|
||||||
-- -> t -> Text.Blaze.Internal.HtmlM ()
|
|
||||||
registerChartHtml :: [(CommoditySymbol, (String, [TransactionsReportItem]))] -> HtmlUrl AppRoute
|
registerChartHtml :: [(CommoditySymbol, (String, [TransactionsReportItem]))] -> HtmlUrl AppRoute
|
||||||
registerChartHtml percommoditytxnreports =
|
registerChartHtml percommoditytxnreports =
|
||||||
-- have to make sure plot is not called when our container (maincontent)
|
-- have to make sure plot is not called when our container (maincontent)
|
||||||
@ -125,7 +111,6 @@ registerChartHtml percommoditytxnreports =
|
|||||||
#{dayToJsTimestamp $ triDate i},
|
#{dayToJsTimestamp $ triDate i},
|
||||||
#{simpleMixedAmountQuantity $ triCommodityBalance c i}
|
#{simpleMixedAmountQuantity $ triCommodityBalance c i}
|
||||||
],
|
],
|
||||||
/* [] */
|
|
||||||
],
|
],
|
||||||
label: '#{shownull $ T.unpack c}',
|
label: '#{shownull $ T.unpack c}',
|
||||||
color: #{colorForCommodity c},
|
color: #{colorForCommodity c},
|
||||||
@ -168,7 +153,6 @@ registerChartHtml percommoditytxnreports =
|
|||||||
};
|
};
|
||||||
});
|
});
|
||||||
|]
|
|]
|
||||||
-- [#{dayToJsTimestamp $ ltrace "\ndate" $ triDate i}, #{ltrace "balancequantity" $ simpleMixedAmountQuantity $ triCommodityBalance c i}, '#{ltrace "balance" $ show $ triCommodityBalance c i}, '#{ltrace "amount" $ show $ triCommodityAmount c i}''],
|
|
||||||
where
|
where
|
||||||
charttitle = case maybe "" (fst.snd) $ headMay percommoditytxnreports of
|
charttitle = case maybe "" (fst.snd) $ headMay percommoditytxnreports of
|
||||||
"" -> ""
|
"" -> ""
|
||||||
@ -177,3 +161,9 @@ registerChartHtml percommoditytxnreports =
|
|||||||
commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)]
|
commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)]
|
||||||
simpleMixedAmountQuantity = maybe 0 aquantity . headMay . amounts
|
simpleMixedAmountQuantity = maybe 0 aquantity . headMay . amounts
|
||||||
shownull c = if null c then " " else c
|
shownull c = if null c then " " else c
|
||||||
|
|
||||||
|
dayToJsTimestamp :: Day -> Integer
|
||||||
|
dayToJsTimestamp d =
|
||||||
|
read (formatTime defaultTimeLocale "%s" t) * 1000 -- XXX read
|
||||||
|
where
|
||||||
|
t = UTCTime d (secondsToDiffTime 0)
|
||||||
|
@ -5,4 +5,4 @@ module Handler.RootR where
|
|||||||
import Import
|
import Import
|
||||||
|
|
||||||
getRootR :: Handler Html
|
getRootR :: Handler Html
|
||||||
getRootR = redirect defaultroute where defaultroute = JournalR
|
getRootR = redirect JournalR
|
||||||
|
@ -1,15 +1,11 @@
|
|||||||
{-# LANGUAGE OverloadedStrings, QuasiQuotes, RecordWildCards #-}
|
|
||||||
-- | /sidebar
|
-- | /sidebar
|
||||||
|
|
||||||
module Handler.SidebarR where
|
module Handler.SidebarR where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
|
|
||||||
import Handler.Common
|
import Handler.Common (sidebar)
|
||||||
|
|
||||||
-- | Render just the accounts sidebar, useful when opening the sidebar.
|
-- | Render just the accounts sidebar, useful when opening the sidebar.
|
||||||
getSidebarR :: Handler Html
|
getSidebarR :: Handler Html
|
||||||
getSidebarR = do
|
getSidebarR = withUrlRenderer . sidebar =<< getViewData
|
||||||
vd <- getViewData
|
|
||||||
withUrlRenderer [hamlet|^{sidebar vd}|]
|
|
||||||
|
|
||||||
|
@ -1,16 +0,0 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
|
||||||
-- | Web handler utilities. More of these are in Foundation.hs, where
|
|
||||||
-- they can be used in the default template.
|
|
||||||
|
|
||||||
module Handler.Utils where
|
|
||||||
|
|
||||||
import Data.Time.Calendar
|
|
||||||
import Data.Time.Clock
|
|
||||||
import Data.Time.Format
|
|
||||||
|
|
||||||
numbered :: [a] -> [(Int,a)]
|
|
||||||
numbered = zip [1..]
|
|
||||||
|
|
||||||
dayToJsTimestamp :: Day -> Integer
|
|
||||||
dayToJsTimestamp d = read (formatTime defaultTimeLocale "%s" t) * 1000 -- XXX read
|
|
||||||
where t = UTCTime d (secondsToDiffTime 0)
|
|
@ -128,7 +128,6 @@ library
|
|||||||
Handler.RegisterR
|
Handler.RegisterR
|
||||||
Handler.RootR
|
Handler.RootR
|
||||||
Handler.SidebarR
|
Handler.SidebarR
|
||||||
Handler.Utils
|
|
||||||
Hledger.Web
|
Hledger.Web
|
||||||
Hledger.Web.Main
|
Hledger.Web.Main
|
||||||
Hledger.Web.WebOptions
|
Hledger.Web.WebOptions
|
||||||
@ -189,7 +188,7 @@ executable hledger-web
|
|||||||
Paths_hledger_web
|
Paths_hledger_web
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
app
|
app
|
||||||
ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans
|
ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates -Wredundant-constraints -fwarn-tabs
|
||||||
cpp-options: -DVERSION="1.9.99"
|
cpp-options: -DVERSION="1.9.99"
|
||||||
build-depends:
|
build-depends:
|
||||||
HUnit
|
HUnit
|
||||||
|
@ -123,7 +123,6 @@ library:
|
|||||||
- Handler.RegisterR
|
- Handler.RegisterR
|
||||||
- Handler.RootR
|
- Handler.RootR
|
||||||
- Handler.SidebarR
|
- Handler.SidebarR
|
||||||
- Handler.Utils
|
|
||||||
- Hledger.Web
|
- Hledger.Web
|
||||||
- Hledger.Web.Main
|
- Hledger.Web.Main
|
||||||
- Hledger.Web.WebOptions
|
- Hledger.Web.WebOptions
|
||||||
|
Loading…
Reference in New Issue
Block a user