mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 18:29:36 +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 #-}
|
||||
-- | Define the web application's foundation, in the usual Yesod style.
|
||||
-- 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}">
|
||||
|]
|
||||
addScript $ StaticR js_bootstrap_min_js
|
||||
-- addScript $ StaticR js_typeahead_bundle_min_js
|
||||
addScript $ StaticR js_bootstrap_datepicker_min_js
|
||||
addScript $ StaticR js_jquery_url_js
|
||||
addScript $ StaticR js_jquery_cookie_js
|
||||
@ -131,15 +131,12 @@ instance Yesod App where
|
||||
instance RenderMessage App FormMessage where
|
||||
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
|
||||
|
||||
-- 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.
|
||||
data ViewData = VD {
|
||||
@ -153,7 +150,6 @@ data ViewData = VD {
|
||||
,qopts :: [QueryOpt] -- ^ query options parsed from the q parameter
|
||||
,am :: Query -- ^ a query parsed from the accounts sidebar query expr ("a" parameter)
|
||||
,aopts :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr
|
||||
,showpostings :: Bool -- ^ current p parameter, 1 or 0 shows/hides all postings where applicable
|
||||
,showsidebar :: Bool -- ^ current showsidebar cookie value
|
||||
} 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.
|
||||
nullviewdata :: ViewData
|
||||
nullviewdata = viewdataWithDateAndParams nulldate "" "" ""
|
||||
nullviewdata = viewdataWithDateAndParams nulldate "" ""
|
||||
|
||||
-- | Make a ViewData using the given date and request parameters, and defaults elsewhere.
|
||||
viewdataWithDateAndParams :: Day -> Text -> Text -> Text -> ViewData
|
||||
viewdataWithDateAndParams d q a p =
|
||||
viewdataWithDateAndParams :: Day -> Text -> Text -> ViewData
|
||||
viewdataWithDateAndParams d q a =
|
||||
let (querymatcher,queryopts) = parseQuery d q
|
||||
(acctsmatcher,acctsopts) = parseQuery d a
|
||||
in VD {
|
||||
@ -179,7 +175,6 @@ viewdataWithDateAndParams d q a p =
|
||||
,qopts = queryopts
|
||||
,am = acctsmatcher
|
||||
,aopts = acctsopts
|
||||
,showpostings = p == "1"
|
||||
,showsidebar = True
|
||||
}
|
||||
|
||||
@ -196,16 +191,15 @@ getViewData = do
|
||||
(j, merr) <- getCurrentJournal app copts{reportopts_=ropts{no_elide_=True}} today
|
||||
lastmsg <- getLastMessage
|
||||
let msg = maybe lastmsg (Just . toHtml) merr
|
||||
q <- getParameterOrNull "q"
|
||||
a <- getParameterOrNull "a"
|
||||
p <- getParameterOrNull "p"
|
||||
q <- fromMaybe "" <$> lookupGetParam "q"
|
||||
a <- fromMaybe "" <$> lookupGetParam "a"
|
||||
-- sidebar visibility: show it, unless there is a showsidebar cookie
|
||||
-- set to "0", or a ?sidebar=0 query parameter.
|
||||
msidebarparam <- lookupGetParam "sidebar"
|
||||
msidebarcookie <- reqCookies <$> getRequest >>= return . lookup "showsidebar"
|
||||
let showsidebar = maybe (msidebarcookie /= Just "0") (/="0") msidebarparam
|
||||
|
||||
return (viewdataWithDateAndParams today q a p){
|
||||
return (viewdataWithDateAndParams today q a){
|
||||
opts=opts
|
||||
,msg=msg
|
||||
,here=here
|
||||
@ -230,13 +224,9 @@ getViewData = do
|
||||
else case ej' of
|
||||
Right j' -> do liftIO $ writeIORef (appJournal app) j'
|
||||
return (j',Nothing)
|
||||
Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-}
|
||||
Left e -> do setMessage "error while reading"
|
||||
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
|
||||
-- referentially transparent manner (allowing multiple reads).
|
||||
getLastMessage :: Handler (Maybe Html)
|
||||
|
@ -10,11 +10,11 @@ import Import
|
||||
import Control.Monad.State.Strict (evalStateT)
|
||||
import Data.Either (lefts, rights)
|
||||
import Data.List (sort)
|
||||
import qualified Data.List as L (head) -- qualified keeps dev & prod builds warning-free
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Maybe (fromMaybe, maybeToList)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import Data.Void (Void)
|
||||
import Safe (headMay)
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
@ -23,18 +23,16 @@ 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.
|
||||
-- XXX Variable postings fields
|
||||
data AddForm = AddForm
|
||||
{ addFormDate :: Day
|
||||
, addFormDescription :: Maybe Text
|
||||
-- , addFormPostings :: [(AccountName, String)]
|
||||
, addFormJournalFile :: Maybe Text
|
||||
}
|
||||
deriving Show
|
||||
} deriving Show
|
||||
|
||||
postAddForm :: Handler Html
|
||||
postAddForm = do
|
||||
let showErrors errs = do
|
||||
-- error $ show errs -- XXX uncomment to prevent redirect for debugging
|
||||
setMessage [shamlet|
|
||||
Errors:<br>
|
||||
$forall e<-errs
|
||||
@ -43,20 +41,18 @@ postAddForm = do
|
||||
-- 1. process the fixed fields with yesod-form
|
||||
|
||||
VD{..} <- getViewData
|
||||
let
|
||||
validateJournalFile :: Text -> Either FormMessage Text
|
||||
let validateJournalFile :: Text -> Either FormMessage Text
|
||||
validateJournalFile f
|
||||
| T.unpack f `elem` journalFilePaths j = Right f
|
||||
| otherwise = Left $ MsgInvalidEntry $ "the selected journal file \"" <> f <> "\"is unknown"
|
||||
|
||||
validateDate :: Text -> Handler (Either FormMessage Day)
|
||||
validateDate s = return $
|
||||
case fixSmartDateStrEither' today (T.strip s) of
|
||||
Right d -> Right d
|
||||
Left _ -> Left $ MsgInvalidEntry $ "could not parse date \"" <> s <> "\":"
|
||||
validateDate :: Text -> Either FormMessage Day
|
||||
validateDate s = case fixSmartDateStrEither' today (T.strip s) of
|
||||
Right d -> Right d
|
||||
Left _ -> Left $ MsgInvalidEntry $ "could not parse date \"" <> s <> "\":"
|
||||
|
||||
formresult <- runInputPostResult $ AddForm
|
||||
<$> ireq (checkMMap validateDate (T.pack . show) textField) "date"
|
||||
<$> ireq (checkMMap (pure . validateDate) (T.pack . show) textField) "date"
|
||||
<*> iopt textField "description"
|
||||
<*> iopt (check validateJournalFile textField) "journal"
|
||||
|
||||
@ -99,7 +95,7 @@ postAddForm = do
|
||||
| otherwise = amts' ++ [missingamt]
|
||||
errs = if not (null paramErrs) then paramErrs else (acctErrs ++ amtErrs)
|
||||
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 {
|
||||
tdate=date
|
||||
,tdescription=desc
|
||||
|
@ -75,7 +75,7 @@ sidebar vd@VD{..} =
|
||||
ropts = reportopts_ $ cliopts_ opts
|
||||
-- flip the default for items with zero amounts, show them by default
|
||||
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
|
||||
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
|
||||
|
||||
nulltemplate :: HtmlUrl AppRoute
|
||||
nulltemplate = [hamlet||]
|
||||
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- hledger report renderers
|
||||
|
||||
-- | Render a "BalanceReport" as html.
|
||||
balanceReportAsHtml :: WebOpts -> ViewData -> BalanceReport -> HtmlUrl AppRoute
|
||||
balanceReportAsHtml _ vd@VD{..} (items',total) =
|
||||
balanceReportAsHtml :: ViewData -> BalanceReport -> HtmlUrl AppRoute
|
||||
balanceReportAsHtml VD{..} (items, total) =
|
||||
[hamlet|
|
||||
$forall i <- items
|
||||
^{itemAsHtml vd i}
|
||||
^{itemAsHtml i}
|
||||
<tr .total>
|
||||
<td>
|
||||
<td>
|
||||
@ -190,9 +186,8 @@ balanceReportAsHtml _ vd@VD{..} (items',total) =
|
||||
where
|
||||
l = ledgerFromJournal Any j
|
||||
inacctmatcher = inAccountQuery qopts
|
||||
items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher
|
||||
itemAsHtml :: ViewData -> BalanceReportItem -> HtmlUrl AppRoute
|
||||
itemAsHtml _ (acct, adisplay, aindent, abal) = [hamlet|
|
||||
itemAsHtml :: BalanceReportItem -> HtmlUrl AppRoute
|
||||
itemAsHtml (acct, adisplay, aindent, abal) = [hamlet|
|
||||
<tr .#{inacctclass}>
|
||||
<td .acct>
|
||||
<div .ff-wrapper>
|
||||
@ -218,9 +213,6 @@ accountQuery = ("inacct:" <>) . quoteIfSpaced
|
||||
accountOnlyQuery :: AccountName -> Text
|
||||
accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
|
||||
|
||||
accountUrl :: AppRoute -> AccountName -> (AppRoute, [(Text, Text)])
|
||||
accountUrl r a = (r, [("q", accountQuery a)])
|
||||
|
||||
numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
|
||||
numberTransactionsReportItems [] = []
|
||||
numberTransactionsReportItems items = number 0 nulldate items
|
||||
|
@ -20,16 +20,12 @@ getJournalR :: Handler Html
|
||||
getJournalR = do
|
||||
vd@VD{..} <- getViewData
|
||||
let -- XXX like registerReportAsHtml
|
||||
inacct = inAccount qopts
|
||||
-- injournal = isNothing inacct
|
||||
filtering = m /= Any
|
||||
-- showlastcolumn = if injournal && not filtering then False else True
|
||||
title = case inacct of
|
||||
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 filtering then ", filtered" else ""
|
||||
s2 = if m /= Any then ", filtered" else ""
|
||||
maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
|
||||
hledgerLayout vd "journal" [hamlet|
|
||||
<div .row>
|
||||
@ -57,7 +53,6 @@ journalTransactionsReportAsHtml _ vd (_,items) = [hamlet|
|
||||
^{itemAsHtml vd i}
|
||||
|]
|
||||
where
|
||||
-- .#{datetransition}
|
||||
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
|
||||
itemAsHtml VD{..} (_, _, _, _, (torig, _, split, _, amt, _)) = [hamlet|
|
||||
<tr .title #transaction-#{tindex torig}>
|
||||
|
@ -5,14 +5,14 @@ module Handler.RegisterR where
|
||||
|
||||
import Import
|
||||
|
||||
import Data.Time
|
||||
import Data.List (intersperse)
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
import qualified Data.Text as T
|
||||
import Safe (headMay)
|
||||
|
||||
import Handler.AddForm
|
||||
import Handler.AddForm (postAddForm)
|
||||
import Handler.Common
|
||||
import Handler.Utils
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Query
|
||||
@ -25,25 +25,19 @@ import Hledger.Web.WebOptions
|
||||
getRegisterR :: Handler Html
|
||||
getRegisterR = do
|
||||
vd@VD{..} <- getViewData
|
||||
-- staticRootUrl <- (staticRoot . settings) <$> getYesod
|
||||
let -- injournal = isNothing inacct
|
||||
filtering = m /= Any
|
||||
title = a <> s1 <> s2
|
||||
let title = a <> s1 <> s2
|
||||
where
|
||||
(a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts
|
||||
s1 = if inclsubs then "" else " (excluding subaccounts)"
|
||||
s2 = if filtering then ", filtered" else ""
|
||||
maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
|
||||
hledgerLayout vd "register" [hamlet|
|
||||
<h2 #contenttitle>#{title}
|
||||
<!-- p>Transactions affecting this account, with running balance. -->
|
||||
^{maincontent}
|
||||
|]
|
||||
s2 = if m /= Any then ", filtered" else ""
|
||||
hledgerLayout vd "register" $ do
|
||||
_ <- [hamlet|<h2 #contenttitle>#{title}|]
|
||||
registerReportHtml opts vd $ 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 :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
|
||||
registerReportHtml opts vd r = [hamlet|
|
||||
<div .hidden-xs>
|
||||
@ -51,7 +45,7 @@ registerReportHtml opts vd r = [hamlet|
|
||||
^{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 _ vd (balancelabel,items) = [hamlet|
|
||||
<div .table-responsive>
|
||||
@ -72,10 +66,8 @@ registerItemsHtml _ vd (balancelabel,items) = [hamlet|
|
||||
insomeacct = isJust $ inAccount $ qopts vd
|
||||
balancelabel' = if insomeacct then balancelabel else "Total"
|
||||
|
||||
-- filtering = m /= Any
|
||||
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
|
||||
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;">
|
||||
<td .date>
|
||||
<a href="@{JournalR}#transaction-#{tindex torig}">#{date}
|
||||
@ -86,22 +78,16 @@ registerItemsHtml _ vd (balancelabel,items) = [hamlet|
|
||||
\#{mixedAmountAsHtml amt}
|
||||
<td .balance style="text-align:right;">#{mixedAmountAsHtml bal}
|
||||
|]
|
||||
|
||||
where
|
||||
evenodd = if even n then "even" else "odd" :: Text
|
||||
datetransition | newm = "newmonth"
|
||||
| newd = "newday"
|
||||
| otherwise = "" :: Text
|
||||
(firstposting, date, desc) = (False, show $ tdate tacct, tdescription tacct)
|
||||
-- acctquery = (here, [("q", pack $ accountQuery acct)])
|
||||
showamt = not split || not (isZeroMixedAmount amt)
|
||||
|
||||
-- | Generate javascript/html for a register balance line chart based on
|
||||
-- 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 percommoditytxnreports =
|
||||
-- have to make sure plot is not called when our container (maincontent)
|
||||
@ -125,7 +111,6 @@ registerChartHtml percommoditytxnreports =
|
||||
#{dayToJsTimestamp $ triDate i},
|
||||
#{simpleMixedAmountQuantity $ triCommodityBalance c i}
|
||||
],
|
||||
/* [] */
|
||||
],
|
||||
label: '#{shownull $ T.unpack 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
|
||||
charttitle = case maybe "" (fst.snd) $ headMay percommoditytxnreports of
|
||||
"" -> ""
|
||||
@ -177,3 +161,9 @@ registerChartHtml percommoditytxnreports =
|
||||
commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)]
|
||||
simpleMixedAmountQuantity = maybe 0 aquantity . headMay . amounts
|
||||
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
|
||||
|
||||
getRootR :: Handler Html
|
||||
getRootR = redirect defaultroute where defaultroute = JournalR
|
||||
getRootR = redirect JournalR
|
||||
|
@ -1,15 +1,11 @@
|
||||
{-# LANGUAGE OverloadedStrings, QuasiQuotes, RecordWildCards #-}
|
||||
-- | /sidebar
|
||||
|
||||
module Handler.SidebarR where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Common
|
||||
import Handler.Common (sidebar)
|
||||
|
||||
-- | Render just the accounts sidebar, useful when opening the sidebar.
|
||||
getSidebarR :: Handler Html
|
||||
getSidebarR = do
|
||||
vd <- getViewData
|
||||
withUrlRenderer [hamlet|^{sidebar vd}|]
|
||||
|
||||
getSidebarR = withUrlRenderer . sidebar =<< getViewData
|
||||
|
@ -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.RootR
|
||||
Handler.SidebarR
|
||||
Handler.Utils
|
||||
Hledger.Web
|
||||
Hledger.Web.Main
|
||||
Hledger.Web.WebOptions
|
||||
@ -189,7 +188,7 @@ executable hledger-web
|
||||
Paths_hledger_web
|
||||
hs-source-dirs:
|
||||
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"
|
||||
build-depends:
|
||||
HUnit
|
||||
|
@ -123,7 +123,6 @@ library:
|
||||
- Handler.RegisterR
|
||||
- Handler.RootR
|
||||
- Handler.SidebarR
|
||||
- Handler.Utils
|
||||
- Hledger.Web
|
||||
- Hledger.Web.Main
|
||||
- Hledger.Web.WebOptions
|
||||
|
Loading…
Reference in New Issue
Block a user