9c56ed1104
The hledger-web tests have been cleaned up and now allow more testing of command line options like (though still not everything). Note tests now run the app listening on its default host and port, 127.0.0.1 and 5000, instead of "any IPv4 or IPv6 hostname" and 3000. This would seem to mean hledger-web tests can conflict more with things running on port 5000, eg a normal hledger-web instance, but I haven't been able to reproduce it.
109 lines
3.5 KiB
Haskell
109 lines
3.5 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
|
|
-- | Settings are centralized, as much as possible, into this file. This
|
|
-- includes database connection settings, static file locations, etc.
|
|
-- In addition, you can configure a number of different aspects of Yesod
|
|
-- by overriding methods in the Yesod typeclass. That instance is
|
|
-- declared in the Foundation.hs file.
|
|
module Hledger.Web.Settings where
|
|
|
|
import Data.Default (def)
|
|
import Data.Maybe (fromMaybe)
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import Data.Yaml
|
|
import Language.Haskell.TH.Syntax (Q, Exp)
|
|
import Text.Hamlet
|
|
import Text.Shakespeare.Text (st)
|
|
import Yesod.Default.Config
|
|
import Yesod.Default.Util
|
|
|
|
import Hledger.Cli.Version (packagemajorversion)
|
|
|
|
development :: Bool
|
|
development =
|
|
#if DEVELOPMENT
|
|
True
|
|
#else
|
|
False
|
|
#endif
|
|
|
|
production :: Bool
|
|
production = not development
|
|
|
|
hledgerorgurl :: Text
|
|
hledgerorgurl = "https://hledger.org"
|
|
|
|
manualurl :: Text
|
|
manualurl = hledgerorgurl <> "/" <> T.pack packagemajorversion <> "/hledger.html"
|
|
|
|
-- | The default IP address to listen on. May be overridden with --host.
|
|
defhost :: String
|
|
defhost = "127.0.0.1"
|
|
|
|
-- | The default TCP port to listen on. May be overridden with --port.
|
|
defport :: Int
|
|
defport = 5000
|
|
|
|
defbaseurl :: String -> Int -> String
|
|
defbaseurl host port =
|
|
if ':' `elem` host
|
|
then -- ipv6 address
|
|
"http://[" ++ host ++ "]" ++ if port /= 80 then ":" ++ show port else ""
|
|
else
|
|
"http://" ++ host ++ if port /= 80 then ":" ++ show port else ""
|
|
|
|
-- Static setting below. Changing these requires a recompile
|
|
|
|
-- | The location of static files on your system. This is a file system
|
|
-- path. The default value works properly with your scaffolded site.
|
|
staticDir :: FilePath
|
|
staticDir = "static"
|
|
|
|
-- | The base URL for your static files. As you can see by the default
|
|
-- value, this can simply be "static" appended to your application root.
|
|
-- A powerful optimization can be serving static files from a separate
|
|
-- domain name. This allows you to use a web server optimized for static
|
|
-- files, more easily set expires and cache values, and avoid possibly
|
|
-- costly transference of cookies on static files. For more information,
|
|
-- please see:
|
|
-- http://code.google.com/speed/page-speed/docs/request.html#ServeFromCookielessDomain
|
|
--
|
|
-- If you change the resource pattern for StaticR in Foundation.hs, you will
|
|
-- have to make a corresponding change here.
|
|
--
|
|
-- To see how this value is used, see urlRenderOverride in Foundation.hs
|
|
staticRoot :: AppConfig DefaultEnv Extra -> Text
|
|
staticRoot conf = fromMaybe [st|#{appRoot conf}/static|] . extraStaticRoot $ appExtra conf
|
|
|
|
-- | Settings for 'widgetFile', such as which template languages to support and
|
|
-- default Hamlet settings.
|
|
widgetFileSettings :: WidgetFileSettings
|
|
widgetFileSettings = def
|
|
{ wfsHamletSettings = defaultHamletSettings
|
|
{ hamletNewlines = AlwaysNewlines
|
|
}
|
|
}
|
|
|
|
-- The rest of this file contains settings which rarely need changing by a
|
|
-- user.
|
|
|
|
widgetFile :: String -> Q Exp
|
|
widgetFile = (if development then widgetFileReload
|
|
else widgetFileNoReload)
|
|
widgetFileSettings
|
|
|
|
data Extra = Extra
|
|
{ extraCopyright :: Text
|
|
, extraAnalytics :: Maybe Text -- ^ Google Analytics
|
|
, extraStaticRoot :: Maybe Text
|
|
} deriving Show
|
|
|
|
parseExtra :: DefaultEnv -> Object -> Parser Extra
|
|
parseExtra _ o = Extra
|
|
<$> o .: "copyright"
|
|
<*> o .:? "analytics"
|
|
<*> o .:? "staticRoot"
|