From 009df13baf38676244ce96da38692bee2515ace8 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 9 Jul 2014 00:04:50 -0700 Subject: [PATCH] web: make the add form a modal dialog The add form has become a modal dialog, and been moved into the default template. This simplifies some things, for now. Eg it's easily accessible from any page. --- hledger-web/Foundation.hs | 241 ++++++++++++++++++ hledger-web/Handler/Common.hs | 125 --------- hledger-web/Handler/JournalR.hs | 6 +- hledger-web/Handler/Post.hs | 1 - hledger-web/Handler/SidebarR.hs | 1 - hledger-web/Handler/Utils.hs | 104 +------- hledger-web/static/hledger.js | 42 +-- .../templates/default-layout-wrapper.hamlet | 9 + 8 files changed, 261 insertions(+), 268 deletions(-) diff --git a/hledger-web/Foundation.hs b/hledger-web/Foundation.hs index 0adc8db02..a3e84c6cf 100644 --- a/hledger-web/Foundation.hs +++ b/hledger-web/Foundation.hs @@ -8,6 +8,7 @@ See a default Yesod app's comments for more details of each part. module Foundation where import Prelude +import Control.Applicative ((<$>)) import Data.IORef import Yesod import Yesod.Static @@ -31,6 +32,23 @@ import Hledger.Data.Types -- import Hledger.Web.Settings -- import Hledger.Web.Settings.StaticFiles +-- for addform +import Data.List +import Data.Maybe +import Data.Text as Text (Text,pack,unpack) +import Data.Time.Calendar +import System.FilePath (takeFileName) +#if BLAZE_HTML_0_4 +import Text.Blaze (preEscapedString) +#else +import Text.Blaze.Internal (preEscapedString) +#endif +import Text.JSON +import Hledger.Data.Journal +import Hledger.Query +import Hledger hiding (is) +import Hledger.Cli hiding (version) + -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -120,6 +138,8 @@ instance Yesod App where addScript $ StaticR hledger_js $(widgetFile "default-layout") + staticRootUrl <- (staticRoot . settings) <$> getYesod + vd@VD{..} <- getViewData giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This is done to provide an optimization for serving static files from @@ -159,3 +179,224 @@ getExtra = fmap (appExtra . settings) getYesod -- wiki: -- -- https://github.com/yesodweb/yesod/wiki/Sending-email + + +---------------------------------------------------------------------- +-- template and handler utilities + +-- view data, used by the add form and handlers + +-- | A bundle of data useful for hledger-web request handlers and templates. +data ViewData = VD { + opts :: WebOpts -- ^ the command-line options at startup + ,here :: AppRoute -- ^ the current route + ,msg :: Maybe Html -- ^ the current UI message if any, possibly from the current request + ,today :: Day -- ^ today's date (for queries containing relative dates) + ,j :: Journal -- ^ the up-to-date parsed unfiltered journal + ,q :: String -- ^ the current q parameter, the main query expression + ,m :: Query -- ^ a query 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) + ,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 + } + +-- | Make a default ViewData, using day 0 as today's date. +nullviewdata :: ViewData +nullviewdata = viewdataWithDateAndParams nulldate "" "" "" + +-- | Make a ViewData using the given date and request parameters, and defaults elsewhere. +viewdataWithDateAndParams :: Day -> String -> String -> String -> ViewData +viewdataWithDateAndParams d q a p = + let (querymatcher,queryopts) = parseQuery d q + (acctsmatcher,acctsopts) = parseQuery d a + in VD { + opts = defwebopts + ,j = nulljournal + ,here = RootR + ,msg = Nothing + ,today = d + ,q = q + ,m = querymatcher + ,qopts = queryopts + ,am = acctsmatcher + ,aopts = acctsopts + ,showpostings = p == "1" + ,showsidebar = False + } + +-- | Gather data used by handlers and templates in the current request. +getViewData :: Handler ViewData +getViewData = do + app <- getYesod + let opts@WebOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} = appOpts app + (j, err) <- getCurrentJournal app copts{reportopts_=ropts{no_elide_=True}} + msg <- getMessageOr err + Just here <- getCurrentRoute + today <- liftIO getCurrentDay + q <- getParameterOrNull "q" + a <- getParameterOrNull "a" + p <- getParameterOrNull "p" + cookies <- reqCookies <$> getRequest + let showsidebar = maybe False (=="1") $ lookup "showsidebar" cookies + return (viewdataWithDateAndParams today q a p){ + opts=opts + ,msg=msg + ,here=here + ,today=today + ,j=j + ,showsidebar=showsidebar + } + where + -- | Update our copy of the journal if the file changed. If there is an + -- error while reloading, keep the old one and return the error, and set a + -- ui message. + getCurrentJournal :: App -> CliOpts -> Handler (Journal, Maybe String) + getCurrentJournal app opts = do + -- XXX put this inside atomicModifyIORef' for thread safety + j <- liftIO $ readIORef $ appJournal app + (jE, changed) <- liftIO $ journalReloadIfChanged opts j + if not changed + then return (j,Nothing) + else case jE of + Right j' -> do liftIO $ writeIORef (appJournal app) j' + return (j',Nothing) + Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-} + return (j, Just e) + + -- | Get the named request parameter, or the empty string if not present. + getParameterOrNull :: String -> Handler String + getParameterOrNull p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p) + +-- | Get the message set by the last request, or the newer message provided, if any. +getMessageOr :: Maybe String -> Handler (Maybe Html) +getMessageOr mnewmsg = do + oldmsg <- getMessage + return $ maybe oldmsg (Just . toHtml) mnewmsg + +-- add form dialog, part of the default template + +-- | Add transaction form. +addform :: Text -> ViewData -> HtmlUrl AppRoute +addform _ vd@VD{..} = [hamlet| +