From 50e97e05fd268946d777f4f2250be4d0cc305e3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20Z=C3=A1rybnick=C3=BD?= Date: Fri, 8 Jun 2018 21:58:55 +0200 Subject: [PATCH] web: Clean up imports --- hledger-web/Application.hs | 44 ++++--------- hledger-web/Foundation.hs | 91 +++++++-------------------- hledger-web/Handler/AddForm.hs | 24 +++---- hledger-web/Handler/Common.hs | 13 ++-- hledger-web/Handler/JournalR.hs | 6 +- hledger-web/Handler/RegisterR.hs | 7 +-- hledger-web/Handler/Utils.hs | 4 -- hledger-web/Hledger/Web.hs | 12 ++-- hledger-web/Hledger/Web/Main.hs | 30 +++++---- hledger-web/Hledger/Web/WebOptions.hs | 16 ++--- hledger-web/Settings.hs | 14 ++--- hledger-web/Settings/Development.hs | 2 - hledger-web/Settings/StaticFiles.hs | 13 ++-- hledger-web/hledger-web.cabal | 3 +- hledger-web/messages/en.msg | 1 - hledger-web/package.yaml | 11 ++-- 16 files changed, 101 insertions(+), 190 deletions(-) delete mode 100644 hledger-web/messages/en.msg diff --git a/hledger-web/Application.hs b/hledger-web/Application.hs index a8185e4ee..ab072754d 100644 --- a/hledger-web/Application.hs +++ b/hledger-web/Application.hs @@ -6,42 +6,29 @@ module Application , makeFoundation ) where -import Data.Default -import Data.IORef import Import -import Yesod.Default.Config -import Yesod.Default.Main -import Yesod.Default.Handlers -import Network.Wai.Middleware.RequestLogger (logStdoutDev, logStdout) -import Network.HTTP.Conduit (newManager) -import Prelude (head) --- adapt to http-conduit 1.x or 2.x when cabal macros are available, otherwise assume 2.x -#ifdef MIN_VERSION_http_conduit -#if MIN_VERSION_http_conduit(2,0,0) -#define http_conduit_2 -#endif -#else -#define http_conduit_2 -#endif -#ifdef http_conduit_2 +import Data.Default (def) +import Data.IORef (newIORef, writeIORef) +import Network.Wai.Middleware.RequestLogger (logStdoutDev, logStdout) import Network.HTTP.Client (defaultManagerSettings) -#else -import Network.HTTP.Conduit (def) -#endif +import Network.HTTP.Conduit (newManager) +import Yesod.Default.Config +import Yesod.Default.Main (defaultDevelApp) +import Yesod.Default.Handlers (getFaviconR, getRobotsR) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! -import Handler.RootR -import Handler.JournalR -import Handler.RegisterR -import Handler.SidebarR +import Handler.RootR (getRootR) +import Handler.JournalR (getJournalR, postJournalR) +import Handler.RegisterR (getRegisterR, postRegisterR) +import Handler.SidebarR (getSidebarR) -import Hledger.Web.WebOptions (WebOpts(..), defwebopts) import Hledger.Data (Journal, nulljournal) import Hledger.Read (readJournalFile) import Hledger.Utils (error') import Hledger.Cli.CliOptions (defcliopts, journalFilePathFromOpts) +import Hledger.Web.WebOptions (WebOpts(..), defwebopts) -- This line actually creates our YesodDispatch instance. It is the second half -- of the call to mkYesodData which occurs in Foundation.hs. Please see the @@ -65,12 +52,7 @@ makeApplication opts j conf = do makeFoundation :: AppConfig DefaultEnv Extra -> WebOpts -> IO App makeFoundation conf opts = do - manager <- newManager -#ifdef http_conduit_2 - defaultManagerSettings -#else - def -#endif + manager <- newManager defaultManagerSettings s <- staticSite jref <- newIORef nulljournal return $ App conf s manager opts jref diff --git a/hledger-web/Foundation.hs b/hledger-web/Foundation.hs index 32cb56f69..56b68dabd 100644 --- a/hledger-web/Foundation.hs +++ b/hledger-web/Foundation.hs @@ -1,53 +1,36 @@ {-# 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. -Define the web application's foundation, in the usual Yesod style. -See a default Yesod app's comments for more details of each part. - --} module Foundation where -import Prelude -import Data.IORef +import Data.IORef (IORef, readIORef, writeIORef) +import Data.List (isPrefixOf, sort, nub) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Calendar (Day) +import Network.HTTP.Conduit (Manager) +import Text.Blaze (Markup) +import Text.Blaze.Internal (preEscapedString) +import Text.Blaze.Html.Renderer.String (renderHtml) +import Text.Hamlet (hamletFile) +import Text.JSON import Yesod import Yesod.Static import Yesod.Default.Config -#ifndef DEVELOPMENT -import Yesod.Default.Util (addStaticContentExternal) -#endif -import Network.HTTP.Conduit (Manager) --- import qualified Settings + import Settings.StaticFiles import Settings (staticRoot, widgetFile, Extra (..)) #ifndef DEVELOPMENT import Settings (staticDir) import Text.Jasmine (minifym) +import Yesod.Default.Util (addStaticContentExternal) #endif -import Text.Blaze.Html.Renderer.String (renderHtml) -import Text.Hamlet (hamletFile) +import Hledger +import Hledger.Cli import Hledger.Web.WebOptions -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 -#if BLAZE_HTML_0_4 -import Text.Blaze (preEscapedString, Markup) -#else -import Text.Blaze (Markup) -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 @@ -62,8 +45,6 @@ data App = App , appJournal :: IORef Journal } --- Set up i18n messages. See the message folder. -mkMessage "App" "messages" "en" -- This is where we define all of the routes in our application. For a full -- explanation of the syntax, please see: @@ -100,11 +81,6 @@ type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget) instance Yesod App where approot = ApprootMaster $ appRoot . settings --- -- Store session data on the client in encrypted cookies, --- -- default session idle timeout is 120 minutes --- makeSessionBackend _ = fmap Just $ defaultClientSessionBackend --- (120 * 60) --- ".hledger-web_client_session_key.aes" -- don't use session data makeSessionBackend _ = return Nothing @@ -118,13 +94,6 @@ instance Yesod App where -- default-layout-wrapper is the entire page. Since the final -- value passed to hamletToRepHtml cannot be a widget, this allows -- you to use normal widget features in default-layout. - - -- pc <- widgetToPageContent $ do - -- $(widgetFile "normalize") - -- addStylesheet $ StaticR css_bootstrap_css - -- $(widgetFile "default-layout") - -- hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet") - pc <- widgetToPageContent $ do addStylesheet $ StaticR css_bootstrap_min_css addStylesheet $ StaticR css_bootstrap_datepicker_standalone_min_css @@ -150,13 +119,6 @@ instance Yesod App where staticRootUrl <- (staticRoot . settings) <$> getYesod withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") - -- TODO outdated, still needed ? - -- This is done to provide an optimization for serving static files from - -- a separate domain. Please see the staticRoot setting in Settings.hs - -- urlRenderOverride y (StaticR s) = - -- Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s - urlParamRenderOverride _ _ _ = Nothing - #ifndef DEVELOPMENT -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows @@ -165,9 +127,6 @@ instance Yesod App where addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute []) #endif - -- Place Javascript at bottom of the body tag so the rest of the page loads first - jsLoader _ = BottomOfBody - -- This instance is required to use forms. You can modify renderMessage to -- achieve customized and internationalized form validation messages. instance RenderMessage App FormMessage where @@ -177,13 +136,6 @@ instance RenderMessage App FormMessage where getExtra :: Handler Extra getExtra = fmap (appExtra . settings) getYesod --- Note: previous versions of the scaffolding included a deliver function to --- send emails. Unfortunately, there are too many different options for us to --- give a reasonable default. Instead, the information is available on the --- wiki: --- --- https://github.com/yesodweb/yesod/wiki/Sending-email - ---------------------------------------------------------------------- -- template and handler utilities @@ -215,8 +167,8 @@ 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 (pack q) - (acctsmatcher,acctsopts) = parseQuery d (pack a) + let (querymatcher,queryopts) = parseQuery d (T.pack q) + (acctsmatcher,acctsopts) = parseQuery d (T.pack a) in VD { opts = defwebopts ,j = nulljournal @@ -284,7 +236,7 @@ getViewData = do -- | Get the named request parameter, or the empty string if not present. getParameterOrNull :: String -> Handler String - getParameterOrNull p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p) + getParameterOrNull p = T.unpack `fmap` fromMaybe "" <$> lookupGetParam (T.pack p) -- | Get the message that was set by the last request, in a -- referentially transparent manner (allowing multiple reads). @@ -391,4 +343,3 @@ journalradio journalfilepaths = [hamlet| #{p} |] - diff --git a/hledger-web/Handler/AddForm.hs b/hledger-web/Handler/AddForm.hs index 00ed77c1d..aa4d11372 100644 --- a/hledger-web/Handler/AddForm.hs +++ b/hledger-web/Handler/AddForm.hs @@ -8,22 +8,18 @@ module Handler.AddForm where import Import import Control.Monad.State.Strict (evalStateT) -import Data.Either (lefts,rights) import Data.List (sort) +import Data.Either (lefts, rights) import qualified Data.List as L (head) -- qualified keeps dev & prod builds warning-free -import Data.Text (append, pack, unpack) import qualified Data.Text as T import Data.Time.Calendar import Data.Void (Void) import Text.Megaparsec import Text.Megaparsec.Char -import Hledger.Utils -import Hledger.Data -import Hledger.Read +import Hledger 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. data AddForm = AddForm @@ -49,20 +45,20 @@ postAddForm = do let validateJournalFile :: Text -> Either FormMessage Text validateJournalFile f - | unpack f `elem` journalFilePaths j = Right f - | otherwise = Left $ MsgInvalidEntry $ pack "the selected journal file \"" `append` f `append` "\"is unknown" + | T.unpack f `elem` journalFilePaths j = Right f + | otherwise = Left $ MsgInvalidEntry $ T.pack "the selected journal file \"" <> f <> "\"is unknown" validateDate :: Text -> Handler (Either FormMessage Day) validateDate s = return $ - case fixSmartDateStrEither' today $ T.pack $ strip $ unpack s of + case fixSmartDateStrEither' today $ T.pack $ strip $ T.unpack s of Right d -> Right d - Left _ -> Left $ MsgInvalidEntry $ pack "could not parse date \"" `append` s `append` pack "\":" -- ++ show e) + Left _ -> Left $ MsgInvalidEntry $ "could not parse date \"" <> s <> "\":" formresult <- runInputPostResult $ AddForm - <$> ireq (checkMMap validateDate (pack . show) textField) "date" + <$> ireq (checkMMap validateDate (T.pack . show) textField) "date" <*> iopt textField "description" <*> iopt (check validateJournalFile textField) "journal" - + ok <- case formresult of FormMissing -> showErrors ["there is no form data"::String] >> return False FormFailure errs -> showErrors errs >> return False @@ -72,8 +68,8 @@ postAddForm = do ,addFormDescription=mdesc ,addFormJournalFile=mjournalfile } = dat - desc = maybe "" unpack mdesc - journalfile = maybe (journalFilePath j) unpack mjournalfile + desc = maybe "" T.unpack mdesc + journalfile = maybe (journalFilePath j) T.unpack mjournalfile -- 2. the fixed fields look good; now process the posting fields adhocly, -- getting either errors or a balanced transaction diff --git a/hledger-web/Handler/Common.hs b/hledger-web/Handler/Common.hs index 3ebd62621..ec2520632 100644 --- a/hledger-web/Handler/Common.hs +++ b/hledger-web/Handler/Common.hs @@ -6,22 +6,17 @@ module Handler.Common where import Import --- import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Calendar +import Data.Time.Calendar (Day, toGregorian) import System.FilePath (takeFileName) -#if BLAZE_HTML_0_4 -import Text.Blaze (preEscapedString) -#else import Text.Blaze.Internal (preEscapedString) -#endif -import Text.Printf +import Text.Printf (printf) -import Hledger.Utils +import Hledger.Cli.CliOptions import Hledger.Data import Hledger.Query import Hledger.Reports -import Hledger.Cli.CliOptions +import Hledger.Utils import Hledger.Web.WebOptions ------------------------------------------------------------------------------- diff --git a/hledger-web/Handler/JournalR.hs b/hledger-web/Handler/JournalR.hs index 572af8518..2499e34b6 100644 --- a/hledger-web/Handler/JournalR.hs +++ b/hledger-web/Handler/JournalR.hs @@ -3,18 +3,18 @@ module Handler.JournalR where --- import Data.Text (Text) -import qualified Data.Text as T import Import +import qualified Data.Text as T + import Handler.AddForm import Handler.Common +import Hledger.Cli.CliOptions import Hledger.Data import Hledger.Query import Hledger.Reports import Hledger.Utils -import Hledger.Cli.CliOptions import Hledger.Web.WebOptions -- | The formatted journal view, with sidebar. diff --git a/hledger-web/Handler/RegisterR.hs b/hledger-web/Handler/RegisterR.hs index 3ae2079d9..633964826 100644 --- a/hledger-web/Handler/RegisterR.hs +++ b/hledger-web/Handler/RegisterR.hs @@ -5,11 +5,10 @@ module Handler.RegisterR where import Import -import Data.List -import Data.Maybe --- import Data.Text (Text) +import Data.List (intersperse) +import Data.Maybe (fromMaybe, isJust) import qualified Data.Text as T -import Safe +import Safe (headMay) import Handler.AddForm import Handler.Common diff --git a/hledger-web/Handler/Utils.hs b/hledger-web/Handler/Utils.hs index 8bf1d66ba..683148add 100644 --- a/hledger-web/Handler/Utils.hs +++ b/hledger-web/Handler/Utils.hs @@ -4,13 +4,9 @@ module Handler.Utils where -import Prelude import Data.Time.Calendar import Data.Time.Clock import Data.Time.Format -#if !(MIN_VERSION_time(1,5,0)) -import System.Locale (defaultTimeLocale) -#endif numbered :: [a] -> [(Int,a)] numbered = zip [1..] diff --git a/hledger-web/Hledger/Web.hs b/hledger-web/Hledger/Web.hs index 783229801..c6e211f9b 100644 --- a/hledger-web/Hledger/Web.hs +++ b/hledger-web/Hledger/Web.hs @@ -2,12 +2,12 @@ Re-export the modules of the hledger-web program. -} -module Hledger.Web ( - module Hledger.Web.WebOptions, - module Hledger.Web.Main, - tests_Hledger_Web - ) -where +module Hledger.Web + ( module Hledger.Web.WebOptions + , module Hledger.Web.Main + , tests_Hledger_Web + ) where + import Test.HUnit import Hledger.Web.WebOptions diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index 0cdc3a053..02252b308 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -7,28 +7,26 @@ Released under GPL version 3 or later. -} -module Hledger.Web.Main -where +module Hledger.Web.Main where --- yesod scaffold imports -import Yesod.Default.Config --(fromArgs) --- import Yesod.Default.Main (defaultMain) -import Settings -- (parseExtra) -import Application (makeApplication) -import Data.String +import Control.Monad ((<=<), when) +import Data.Default (def) +import Data.String (fromString) +import qualified Data.Text as T import Network.Wai.Handler.Warp (runSettings, defaultSettings, setHost, setPort) import Network.Wai.Handler.Launch (runHostPortUrl) --- -import Control.Monad -import Data.Text (pack) +import Prelude hiding (putStrLn) import System.Exit (exitSuccess) import System.IO (hFlush, stdout) -import Text.Printf -import Prelude hiding (putStrLn) +import Text.Printf (printf) +import Yesod.Default.Config (AppConfig(..), DefaultEnv(Development)) + +import Application (makeApplication) +import Settings (Extra(..)) import Hledger -import Hledger.Utils.UTF8IOCompat (putStrLn) import Hledger.Cli hiding (progname,prognameandversion) +import Hledger.Utils.UTF8IOCompat (putStrLn) import Hledger.Web.WebOptions @@ -74,11 +72,11 @@ web opts j = do h = host_ opts p = port_ opts u = base_url_ opts - staticRoot = pack <$> file_url_ opts + staticRoot = T.pack <$> file_url_ opts appconfig = AppConfig{appEnv = Development ,appHost = fromString h ,appPort = p - ,appRoot = pack u + ,appRoot = T.pack u ,appExtra = Extra "" Nothing staticRoot } app <- makeApplication opts j' appconfig diff --git a/hledger-web/Hledger/Web/WebOptions.hs b/hledger-web/Hledger/Web/WebOptions.hs index c5a4b6f74..79e2a3957 100644 --- a/hledger-web/Hledger/Web/WebOptions.hs +++ b/hledger-web/Hledger/Web/WebOptions.hs @@ -1,13 +1,13 @@ {-# LANGUAGE CPP #-} -module Hledger.Web.WebOptions -where -import Prelude -import Data.Default -import Data.Maybe -import System.Environment +module Hledger.Web.WebOptions where -import Hledger.Cli hiding (progname,version,prognameandversion) -import Settings +import Data.Default (def) +import Data.Maybe (fromMaybe) +import System.Environment (getArgs) + +import Settings (defhost, defport, defbaseurl) + +import Hledger.Cli hiding (progname, version) progname, version :: String progname = "hledger-web" diff --git a/hledger-web/Settings.hs b/hledger-web/Settings.hs index 923c7e683..c1b6becad 100644 --- a/hledger-web/Settings.hs +++ b/hledger-web/Settings.hs @@ -6,16 +6,16 @@ -- declared in the Foundation.hs file. module Settings where -import Prelude -import Text.Shakespeare.Text (st) -import Language.Haskell.TH.Syntax -import Yesod.Default.Config -import Yesod.Default.Util +import Data.Default (def) import Data.Text (Text) import Data.Yaml -import Settings.Development -import Data.Default (def) +import Language.Haskell.TH.Syntax (Q, Exp) import Text.Hamlet +import Text.Shakespeare.Text (st) +import Yesod.Default.Config +import Yesod.Default.Util + +import Settings.Development hledgerorgurl, manualurl :: String diff --git a/hledger-web/Settings/Development.hs b/hledger-web/Settings/Development.hs index 3d42292b5..905912c6c 100644 --- a/hledger-web/Settings/Development.hs +++ b/hledger-web/Settings/Development.hs @@ -1,8 +1,6 @@ {-# LANGUAGE CPP #-} module Settings.Development where -import Prelude - development :: Bool development = #if DEVELOPMENT diff --git a/hledger-web/Settings/StaticFiles.hs b/hledger-web/Settings/StaticFiles.hs index 505565c53..291b38351 100644 --- a/hledger-web/Settings/StaticFiles.hs +++ b/hledger-web/Settings/StaticFiles.hs @@ -1,12 +1,11 @@ {-# LANGUAGE TemplateHaskell #-} module Settings.StaticFiles where -import Prelude (IO, putStrLn, (++), (>>), return) import System.IO (stdout, hFlush) -import Yesod.Static -import qualified Yesod.Static as Static +import Yesod.Static (Static, embed, publicFiles, staticDevel) + import Settings (staticDir) -import Settings.Development +import Settings.Development (development) -- | use this to create your static file serving site -- staticSite :: IO Static.Static @@ -20,14 +19,14 @@ import Settings.Development -- $(staticFiles Settings.staticDir) -staticSite :: IO Static.Static +staticSite :: IO Static staticSite = if development then (do putStrLn ("Using web files from: " ++ staticDir ++ "/") >> hFlush stdout - Static.staticDevel staticDir) + staticDevel staticDir) else (do -- putStrLn "Using built-in web files" >> hFlush stdout - return $(Static.embed staticDir)) + return $(embed staticDir)) $(publicFiles staticDir) diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index 256543344..1dde646e2 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -38,7 +38,6 @@ extra-source-files: hledger-web.1 hledger-web.info hledger-web.txt - messages/en.msg README static/css/bootstrap-datepicker.standalone.min.css static/css/bootstrap-theme.css @@ -139,7 +138,7 @@ library Settings.StaticFiles other-modules: Paths_hledger_web - 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 cpp-options: -DVERSION="1.9.99" build-depends: HUnit diff --git a/hledger-web/messages/en.msg b/hledger-web/messages/en.msg deleted file mode 100644 index e928c34ba..000000000 --- a/hledger-web/messages/en.msg +++ /dev/null @@ -1 +0,0 @@ -Hello: Hello diff --git a/hledger-web/package.yaml b/hledger-web/package.yaml index 5043a431e..def0d9c34 100644 --- a/hledger-web/package.yaml +++ b/hledger-web/package.yaml @@ -30,7 +30,6 @@ extra-source-files: - config/robots.txt - config/routes - config/settings.yml -- messages/*.msg - static/css/*.css - static/css/*.map - static/fonts/*.eot @@ -107,11 +106,11 @@ when: ghc-options: - -Wall -- -fno-warn-unused-do-bind -- -fno-warn-name-shadowing -- -fno-warn-missing-signatures -- -fno-warn-type-defaults -- -fno-warn-orphans +- -Wcompat +- -Wincomplete-uni-patterns +- -Wincomplete-record-updates +- -Wredundant-constraints +- -fwarn-tabs library: cpp-options: -DVERSION="1.9.99"