From b60da5138630351ade38d5be4e6005304e3e647d Mon Sep 17 00:00:00 2001 From: Ryan Desfosses Date: Wed, 21 May 2014 07:30:54 -0400 Subject: [PATCH] made the following changes to resolve deprecated warnings: replaced hamletToRepHtml with giveUrlRenderer updated type RepHtml to Html replaced settingsPort with setPort --- hledger-web/Foundation.hs | 2 +- hledger-web/Handler/JournalEditR.hs | 4 ++-- hledger-web/Handler/JournalEntriesR.hs | 4 ++-- hledger-web/Handler/JournalR.hs | 4 ++-- hledger-web/Handler/Post.hs | 8 ++++---- hledger-web/Handler/RegisterR.hs | 4 ++-- hledger-web/Handler/RootR.hs | 2 +- hledger-web/Hledger/Web/Main.hs | 10 +++++----- hledger/hledger.cabal | 18 ++++++++++++++++++ 9 files changed, 37 insertions(+), 19 deletions(-) diff --git a/hledger-web/Foundation.hs b/hledger-web/Foundation.hs index ebedca187..05348014e 100644 --- a/hledger-web/Foundation.hs +++ b/hledger-web/Foundation.hs @@ -115,7 +115,7 @@ instance Yesod App where addScript $ StaticR hledger_js $(widgetFile "default-layout") - hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet") + giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This is done to provide an optimization for serving static files from -- a separate domain. Please see the staticRoot setting in Settings.hs diff --git a/hledger-web/Handler/JournalEditR.hs b/hledger-web/Handler/JournalEditR.hs index 6ef40517a..4d890c6dd 100644 --- a/hledger-web/Handler/JournalEditR.hs +++ b/hledger-web/Handler/JournalEditR.hs @@ -10,12 +10,12 @@ import Handler.Utils -- | The journal editform, no sidebar. -getJournalEditR :: Handler RepHtml +getJournalEditR :: Handler Html getJournalEditR = do vd <- getViewData defaultLayout $ do setTitle "hledger-web journal edit form" toWidget $ editform vd -postJournalEditR :: Handler RepHtml +postJournalEditR :: Handler Html postJournalEditR = handlePost diff --git a/hledger-web/Handler/JournalEntriesR.hs b/hledger-web/Handler/JournalEntriesR.hs index 56fb8f6db..127d137cc 100644 --- a/hledger-web/Handler/JournalEntriesR.hs +++ b/hledger-web/Handler/JournalEntriesR.hs @@ -16,7 +16,7 @@ import Hledger.Web.Options -- | The journal entries view, with sidebar. -getJournalEntriesR :: Handler RepHtml +getJournalEntriesR :: Handler Html getJournalEntriesR = do vd@VD{..} <- getViewData staticRootUrl <- (staticRoot . settings) <$> getYesod @@ -41,6 +41,6 @@ getJournalEntriesR = do ^{importform} |] -postJournalEntriesR :: Handler RepHtml +postJournalEntriesR :: Handler Html postJournalEntriesR = handlePost diff --git a/hledger-web/Handler/JournalR.hs b/hledger-web/Handler/JournalR.hs index 1cbd10e29..7c9276e47 100644 --- a/hledger-web/Handler/JournalR.hs +++ b/hledger-web/Handler/JournalR.hs @@ -14,7 +14,7 @@ import Hledger.Cli.Options import Hledger.Web.Options -- | The formatted journal view, with sidebar. -getJournalR :: Handler RepHtml +getJournalR :: Handler Html getJournalR = do vd@VD{..} <- getViewData staticRootUrl <- (staticRoot . settings) <$> getYesod @@ -48,6 +48,6 @@ getJournalR = do ^{importform} |] -postJournalR :: Handler RepHtml +postJournalR :: Handler Html postJournalR = handlePost diff --git a/hledger-web/Handler/Post.hs b/hledger-web/Handler/Post.hs index dae62f597..f46403538 100644 --- a/hledger-web/Handler/Post.hs +++ b/hledger-web/Handler/Post.hs @@ -20,7 +20,7 @@ import Hledger.Cli -- | Handle a post from any of the edit forms. -handlePost :: Handler RepHtml +handlePost :: Handler Html handlePost = do action <- lookupPostParam "action" case action of Just "add" -> handleAdd @@ -29,7 +29,7 @@ handlePost = do _ -> invalidArgs ["invalid action"] -- | Handle a post from the transaction add form. -handleAdd :: Handler RepHtml +handleAdd :: Handler Html handleAdd = do VD{..} <- getViewData -- get form input values. M means a Maybe value. @@ -91,7 +91,7 @@ handleAdd = do redirect (RegisterR, [("add","1")]) -- | Handle a post from the journal edit form. -handleEdit :: Handler RepHtml +handleEdit :: Handler Html handleEdit = do VD{..} <- getViewData -- get form input values, or validation errors. @@ -137,7 +137,7 @@ handleEdit = do jE -- | Handle a post from the journal import form. -handleImport :: Handler RepHtml +handleImport :: Handler Html handleImport = do setMessage "can't handle file upload yet" redirect JournalR diff --git a/hledger-web/Handler/RegisterR.hs b/hledger-web/Handler/RegisterR.hs index 2b91cf4bd..9addca3b2 100644 --- a/hledger-web/Handler/RegisterR.hs +++ b/hledger-web/Handler/RegisterR.hs @@ -16,7 +16,7 @@ import Hledger.Cli.Options import Hledger.Web.Options -- | The main journal/account register view, with accounts sidebar. -getRegisterR :: Handler RepHtml +getRegisterR :: Handler Html getRegisterR = do vd@VD{..} <- getViewData staticRootUrl <- (staticRoot . settings) <$> getYesod @@ -46,5 +46,5 @@ getRegisterR = do ^{importform} |] -postRegisterR :: Handler RepHtml +postRegisterR :: Handler Html postRegisterR = handlePost diff --git a/hledger-web/Handler/RootR.hs b/hledger-web/Handler/RootR.hs index 2d9c64044..5437efd9e 100644 --- a/hledger-web/Handler/RootR.hs +++ b/hledger-web/Handler/RootR.hs @@ -4,5 +4,5 @@ module Handler.RootR where import Import -getRootR :: Handler RepHtml +getRootR :: Handler Html getRootR = redirect defaultroute where defaultroute = RegisterR diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index 3eba8f72c..af0100a6e 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -16,8 +16,8 @@ import Yesod.Default.Config --(fromArgs) import Settings -- (parseExtra) import Application (makeApplication) import Data.String -import Data.Conduit.Network -import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort) +import Data.Conduit.Network hiding (setPort) +import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort) import Network.Wai.Handler.Launch (runUrlPort) -- import Prelude hiding (putStrLn) @@ -61,19 +61,19 @@ web opts j = do let j' = filterJournalTransactions (queryFromOpts d $ reportopts_ $ cliopts_ opts) j p = port_ opts u = base_url_ opts - staticRoot = pack <$> static_root_ opts + staticRoot' = pack <$> static_root_ opts _ <- printf "Starting web app on port %d with base url %s\n" p u app <- makeApplication opts j' AppConfig{appEnv = Development ,appPort = p ,appRoot = pack u ,appHost = fromString "*4" - ,appExtra = Extra "" Nothing staticRoot + ,appExtra = Extra "" Nothing staticRoot' } if server_ opts then do putStrLn "Press ctrl-c to quit" hFlush stdout - runSettings defaultSettings{settingsPort=p} app + runSettings (setPort p defaultSettings) app else do putStrLn "Starting web browser if possible" putStrLn "Web app will auto-exit after a few minutes with no browsers (or press ctrl-c)" diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 4b3c57a55..1a7a4f4b6 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -197,3 +197,21 @@ test-suite tests , wizards == 1.0.* if impl(ghc >= 7.4) build-depends: pretty-show >= 1.6.4 + +benchmark bench + type: exitcode-stdio-1.0 +-- hs-source-dirs: src + main-is: ../tools/simplebench.hs + ghc-options: -Wall + default-language: Haskell2010 + build-depends: hledger-lib, + hledger, + base >= 4.3 && < 5, + old-locale, + time, + html, + tabular >= 0.2 && < 0.3, + process, + filepath, + directory +