{-|
Web app 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 in App.hs.
-}

{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}

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 Yesod.Default.Config
import Yesod.Default.Util

import Hledger.Cli.Version (packagemajorversion)

development :: Bool
development :: Bool
development =
#if DEVELOPMENT
  True
#else
  Bool
False
#endif

production :: Bool
production :: Bool
production = Bool -> Bool
not Bool
development

hledgerorgurl :: Text
hledgerorgurl :: Text
hledgerorgurl = Text
"https://hledger.org"

manualurl :: Text
manualurl :: Text
manualurl = Text
hledgerorgurl forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
packagemajorversion forall a. Semigroup a => a -> a -> a
<> Text
"/hledger.html"

-- | The default IP address to listen on. May be overridden with --host.
defhost :: String
defhost :: [Char]
defhost = [Char]
"127.0.0.1"

-- | The default TCP port to listen on. May be overridden with --port.
defport :: Int
defport :: Int
defport = Int
5000

defbaseurl :: String -> Int -> String
defbaseurl :: [Char] -> Int -> [Char]
defbaseurl [Char]
host Int
port =
  if Char
':' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
host
  then  -- ipv6 address
    [Char]
"http://[" forall a. [a] -> [a] -> [a]
++ [Char]
host forall a. [a] -> [a] -> [a]
++ [Char]
"]" forall a. [a] -> [a] -> [a]
++ if Int
port forall a. Eq a => a -> a -> Bool
/= Int
80 then [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
port else [Char]
""
  else
    [Char]
"http://" forall a. [a] -> [a] -> [a]
++ [Char]
host forall a. [a] -> [a] -> [a]
++ if Int
port forall a. Eq a => a -> a -> Bool
/= Int
80 then [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
port else [Char]
""

-- Static file settings. Changing these requires a recompile.

-- | The file path on your machine where static files can be found.
-- StaticFiles.hs uses this (must be separate for TH reasons).
staticDir :: FilePath
staticDir :: [Char]
staticDir = [Char]
"static"

-- | The base URL for 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.
--
-- If you change the resource pattern for StaticR in App.hs,
-- (or staticDir above), you will have to make a corresponding change here.
--
-- To see how this value is used, see urlRenderOverride in App.hs
--
-- XXX Does not respect --file-url #2139
staticRoot :: AppConfig DefaultEnv Extra -> Text
staticRoot :: AppConfig DefaultEnv Extra -> Text
staticRoot AppConfig DefaultEnv Extra
conf = forall a. a -> Maybe a -> a
fromMaybe (forall environment extra. AppConfig environment extra -> Text
appRoot AppConfig DefaultEnv Extra
conf forall a. Semigroup a => a -> a -> a
<> Text
"/static") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extra -> Maybe Text
extraStaticRoot forall a b. (a -> b) -> a -> b
$ forall environment extra. AppConfig environment extra -> extra
appExtra AppConfig DefaultEnv Extra
conf

-- | Settings for 'widgetFile', such as which template languages to support and
-- default Hamlet settings.
widgetFileSettings :: WidgetFileSettings
widgetFileSettings :: WidgetFileSettings
widgetFileSettings = forall a. Default a => a
def
    { wfsHamletSettings :: HamletSettings
wfsHamletSettings = HamletSettings
defaultHamletSettings
        { hamletNewlines :: NewlineStyle
hamletNewlines = NewlineStyle
AlwaysNewlines
        }
    }

-- The rest of this file contains settings which rarely need changing by a
-- user.

widgetFile :: String -> Q Exp
widgetFile :: [Char] -> Q Exp
widgetFile = (if Bool
development then WidgetFileSettings -> [Char] -> Q Exp
widgetFileReload
                             else WidgetFileSettings -> [Char] -> Q Exp
widgetFileNoReload)
              WidgetFileSettings
widgetFileSettings

data Extra = Extra
    { Extra -> Text
extraCopyright  :: Text
    , Extra -> Maybe Text
extraAnalytics  :: Maybe Text -- ^ Google Analytics
    , Extra -> Maybe Text
extraStaticRoot :: Maybe Text
    } deriving Int -> Extra -> ShowS
[Extra] -> ShowS
Extra -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Extra] -> ShowS
$cshowList :: [Extra] -> ShowS
show :: Extra -> [Char]
$cshow :: Extra -> [Char]
showsPrec :: Int -> Extra -> ShowS
$cshowsPrec :: Int -> Extra -> ShowS
Show

parseExtra :: DefaultEnv -> Object -> Parser Extra
parseExtra :: DefaultEnv -> Object -> Parser Extra
parseExtra DefaultEnv
_ Object
o = Text -> Maybe Text -> Maybe Text -> Extra
Extra
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"copyright"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"analytics"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"staticRoot"