slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

web: Remove dead code

Browse Source
This commit is contained in:
Jakub Zárybnický 2018-06-09 10:57:22 +02:00
parent ee97e476c8
commit 7404813239
10 changed files with 47 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
hledger-web/Foundation.hs
View File

@ -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)

22
hledger-web/Handler/AddForm.hs
View File

@ -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
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

20
hledger-web/Handler/Common.hs
View File

@ -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

9
hledger-web/Handler/JournalR.hs
View File

@ -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}>

40
hledger-web/Handler/RegisterR.hs
View File

@ -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)

2
hledger-web/Handler/RootR.hs
View File

@ -5,4 +5,4 @@ module Handler.RootR where
import Import
getRootR :: Handler Html
getRootR = redirect defaultroute where defaultroute = JournalR
getRootR = redirect JournalR

8
hledger-web/Handler/SidebarR.hs
View File

@ -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

16
hledger-web/Handler/Utils.hs
View File

@ -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)

3
hledger-web/hledger-web.cabal
View File

@ -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

1
hledger-web/package.yaml
View File

@ -123,7 +123,6 @@ library:
- Handler.RegisterR
- Handler.RootR
- Handler.SidebarR
- Handler.Utils
- Hledger.Web
- Hledger.Web.Main
- Hledger.Web.WebOptions