{-# 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 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 = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe [st|#{appRoot conf}/static|] (Maybe Text -> Text) -> (Extra -> Maybe Text) -> Extra -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extra -> Maybe Text
extraStaticRoot (Extra -> Text) -> Extra -> Text
forall a b. (a -> b) -> a -> b
$ AppConfig DefaultEnv Extra -> Extra
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 = 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"