{-# LANGUAGE CPP, OverloadedStrings, 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)
#if !(MIN_VERSION_base(4,13,0))
import Data.Semigroup ((<>))
#endif
import Data.Text (Text)
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

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
"http://hledger.org"

manualurl :: Text
manualurl :: Text
manualurl = Text
hledgerorgurl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/manual"

-- | The default IP address to listen on. May be overridden with --host.
defhost :: String
defhost :: String
defhost = String
"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 :: String -> Int -> String
defbaseurl String
host Int
port =
  if Char
':' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
host then
    String
"http://[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
host String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]" String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Int
port Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
80 then String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
port else String
""
  else
    String
"http://" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
host String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Int
port Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
80 then String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
port else String
""

-- 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 :: String
staticDir = String
"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 :: AppConfig DefaultEnv Extra -> Text
staticRoot AppConfig DefaultEnv Extra
conf = case Extra -> Maybe Text
extraStaticRoot (Extra -> Maybe Text) -> Extra -> Maybe Text
forall a b. (a -> b) -> a -> b
$ AppConfig DefaultEnv Extra -> Extra
forall environment extra. AppConfig environment extra -> extra
appExtra AppConfig DefaultEnv Extra
conf of
                    Just Text
root -> Text
root
                    Maybe Text
Nothing -> [st|#{appRoot conf}/static|]

-- | Settings for 'widgetFile', such as which template languages to support and
-- default Hamlet settings.
widgetFileSettings :: 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 :: String -> Q Exp
widgetFile = (if Bool
development then WidgetFileSettings -> String -> Q Exp
widgetFileReload
                             else WidgetFileSettings -> String -> 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 -> String -> String
[Extra] -> String -> String
Extra -> String
(Int -> Extra -> String -> String)
-> (Extra -> String) -> ([Extra] -> String -> String) -> Show Extra
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Extra] -> String -> String
$cshowList :: [Extra] -> String -> String
show :: Extra -> String
$cshow :: Extra -> String
showsPrec :: Int -> Extra -> String -> String
$cshowsPrec :: Int -> Extra -> String -> String
Show

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