web: Remove dead code

hledger-web/Foundation.hs

@@ -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 :: Day -> Text -> Text -> ViewData
-viewdataWithDateAndParams d q a p =
+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"
+      q          <- fromMaybe "" <$> lookupGetParam "q"
-      a          <- getParameterOrNull "a"
+      a          <- fromMaybe "" <$> lookupGetParam "a"
-      p          <- getParameterOrNull "p"
       -- 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)

hledger-web/Handler/AddForm.hs

@@ -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, maybeToList)
-import Data.Maybe (fromMaybe)
 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
+  let validateJournalFile :: Text -> Either FormMessage Text
-      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 :: 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
-    <$> 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

hledger-web/Handler/Common.hs

@@ -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 :: ViewData -> BalanceReport -> HtmlUrl AppRoute
-balanceReportAsHtml _ vd@VD{..} (items',total) =
+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 :: BalanceReportItem -> HtmlUrl AppRoute
-   itemAsHtml :: ViewData -> BalanceReportItem -> HtmlUrl AppRoute
+   itemAsHtml (acct, adisplay, aindent, abal) = [hamlet|
-   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

hledger-web/Handler/JournalR.hs

@@ -20,16 +20,12 @@ getJournalR :: Handler Html
 getJournalR = do
   vd@VD{..} <- getViewData
   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
                 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}>

hledger-web/Handler/RegisterR.hs

@@ -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 title = a <> s1 <> s2
-  let -- injournal = isNothing inacct
-      filtering = m /= Any
-      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 ""
+          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 = 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)

hledger-web/Handler/RootR.hs

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

hledger-web/Handler/SidebarR.hs

@@ -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
+getSidebarR = withUrlRenderer . sidebar =<< getViewData
-  vd <- getViewData
-  withUrlRenderer [hamlet|^{sidebar vd}|]
-

hledger-web/Handler/Utils.hs

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

hledger-web/hledger-web.cabal

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

hledger-web/package.yaml

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