web: Clean up imports

This commit is contained in:
Jakub Zárybnický 2018-06-08 21:58:55 +02:00
parent c26674466a
commit 50e97e05fd
16 changed files with 101 additions and 190 deletions

View File

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

View File

@ -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|
<span class="input-lg" style="position:relative; top:-8px; left:8px;">#{p}
<input name=journal type=radio value=#{p} class="form-control" style="width:auto; display:inline;">
|]

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1,8 +1,6 @@
{-# LANGUAGE CPP #-}
module Settings.Development where
import Prelude
development :: Bool
development =
#if DEVELOPMENT

View File

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

View File

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

View File

@ -1 +0,0 @@
Hello: Hello

View File

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