{-# 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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
packagemajorversion Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/hledger.html"
defhost :: String
defhost :: [Char]
defhost = [Char]
"127.0.0.1"
defport :: Int
defport :: Int
defport = Int
5000
defbaseurl :: String -> Int -> String
defbaseurl :: [Char] -> Int -> [Char]
defbaseurl [Char]
host Int
port =
if Char
':' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
host
then
[Char]
"http://[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
host [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Int
port Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
80 then [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
port else [Char]
""
else
[Char]
"http://" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
host [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Int
port Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
80 then [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
port else [Char]
""
staticDir :: FilePath
staticDir :: [Char]
staticDir = [Char]
"static"
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 (AppConfig DefaultEnv Extra -> Text
forall environment extra. AppConfig environment extra -> Text
appRoot AppConfig DefaultEnv Extra
conf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/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
widgetFileSettings :: WidgetFileSettings
widgetFileSettings :: WidgetFileSettings
widgetFileSettings = WidgetFileSettings
forall a. Default a => a
def
{ wfsHamletSettings = defaultHamletSettings
{ hamletNewlines = AlwaysNewlines
}
}
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 =
{ :: Text
, :: Maybe Text
, :: Maybe Text
} deriving Int -> Extra -> [Char] -> [Char]
[Extra] -> [Char] -> [Char]
Extra -> [Char]
(Int -> Extra -> [Char] -> [Char])
-> (Extra -> [Char]) -> ([Extra] -> [Char] -> [Char]) -> Show Extra
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Extra -> [Char] -> [Char]
showsPrec :: Int -> Extra -> [Char] -> [Char]
$cshow :: Extra -> [Char]
show :: Extra -> [Char]
$cshowList :: [Extra] -> [Char] -> [Char]
showList :: [Extra] -> [Char] -> [Char]
Show
parseExtra :: DefaultEnv -> Object -> Parser Extra
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 -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"copyright"
Parser (Maybe Text -> Maybe Text -> Extra)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Extra)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"analytics"
Parser (Maybe Text -> Extra) -> Parser (Maybe Text) -> Parser Extra
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"staticRoot"