-- | Configuration for Hablog

{-# LANGUAGE OverloadedStrings #-}

module Web.Hablog.Config where

import Data.Text.Lazy (Text)

-- | Data type to set the theme for your Hablog blog
data Theme = Theme
  { Theme -> FilePath
bgTheme   :: FilePath -- ^ General theme for hablog. a file path for a css file
  , Theme -> FilePath
codeTheme :: FilePath -- ^ Theme for code. a file path for a highlight.js css file
  }
  deriving (Int -> Theme -> ShowS
[Theme] -> ShowS
Theme -> FilePath
(Int -> Theme -> ShowS)
-> (Theme -> FilePath) -> ([Theme] -> ShowS) -> Show Theme
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Theme] -> ShowS
$cshowList :: [Theme] -> ShowS
show :: Theme -> FilePath
$cshow :: Theme -> FilePath
showsPrec :: Int -> Theme -> ShowS
$cshowsPrec :: Int -> Theme -> ShowS
Show, ReadPrec [Theme]
ReadPrec Theme
Int -> ReadS Theme
ReadS [Theme]
(Int -> ReadS Theme)
-> ReadS [Theme]
-> ReadPrec Theme
-> ReadPrec [Theme]
-> Read Theme
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Theme]
$creadListPrec :: ReadPrec [Theme]
readPrec :: ReadPrec Theme
$creadPrec :: ReadPrec Theme
readList :: ReadS [Theme]
$creadList :: ReadS [Theme]
readsPrec :: Int -> ReadS Theme
$creadsPrec :: Int -> ReadS Theme
Read)

-- | Configuration for Hablog
data Config = Config
  { Config -> Text
blogTitle  :: Text
  , Config -> Theme
blogTheme  :: Theme
  , Config -> Text
blogDomain :: Text
  }
  deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> FilePath
(Int -> Config -> ShowS)
-> (Config -> FilePath) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> FilePath
$cshow :: Config -> FilePath
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, ReadPrec [Config]
ReadPrec Config
Int -> ReadS Config
ReadS [Config]
(Int -> ReadS Config)
-> ReadS [Config]
-> ReadPrec Config
-> ReadPrec [Config]
-> Read Config
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Config]
$creadListPrec :: ReadPrec [Config]
readPrec :: ReadPrec Config
$creadPrec :: ReadPrec Config
readList :: ReadS [Config]
$creadList :: ReadS [Config]
readsPrec :: Int -> ReadS Config
$creadsPrec :: Int -> ReadS Config
Read)

-- | Requires the needed values for runTLS
data TLSConfig = TLSConfig
  { TLSConfig -> Int
blogTLSPort :: Int
  , TLSConfig -> FilePath
blogCert    :: FilePath
  , TLSConfig -> FilePath
blogKey     :: FilePath
  }
  deriving (Int -> TLSConfig -> ShowS
[TLSConfig] -> ShowS
TLSConfig -> FilePath
(Int -> TLSConfig -> ShowS)
-> (TLSConfig -> FilePath)
-> ([TLSConfig] -> ShowS)
-> Show TLSConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TLSConfig] -> ShowS
$cshowList :: [TLSConfig] -> ShowS
show :: TLSConfig -> FilePath
$cshow :: TLSConfig -> FilePath
showsPrec :: Int -> TLSConfig -> ShowS
$cshowsPrec :: Int -> TLSConfig -> ShowS
Show, ReadPrec [TLSConfig]
ReadPrec TLSConfig
Int -> ReadS TLSConfig
ReadS [TLSConfig]
(Int -> ReadS TLSConfig)
-> ReadS [TLSConfig]
-> ReadPrec TLSConfig
-> ReadPrec [TLSConfig]
-> Read TLSConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TLSConfig]
$creadListPrec :: ReadPrec [TLSConfig]
readPrec :: ReadPrec TLSConfig
$creadPrec :: ReadPrec TLSConfig
readList :: ReadS [TLSConfig]
$creadList :: ReadS [TLSConfig]
readsPrec :: Int -> ReadS TLSConfig
$creadsPrec :: Int -> ReadS TLSConfig
Read)

-- | A default configuration
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Text -> Theme -> Text -> Config
Config
  { blogTitle :: Text
blogTitle = Text
defaultTitle
  , blogTheme :: Theme
blogTheme = (FilePath, Theme) -> Theme
forall a b. (a, b) -> b
snd (FilePath, Theme)
defaultTheme
  , blogDomain :: Text
blogDomain = Text
defaultDomain
  }

-- | "Hablog"
defaultTitle :: Text
defaultTitle :: Text
defaultTitle = "Hablog"

defaultDomain :: Text
defaultDomain :: Text
defaultDomain = "localhost"

-- | The default HTTP port is 80
defaultPort :: Int
defaultPort :: Int
defaultPort = 80

-- | The default HTTPS port is 443
defaultTLSPort :: Int
defaultTLSPort :: Int
defaultTLSPort = 443

-- | The default is the dark theme
defaultTheme :: (String, Theme)
defaultTheme :: (FilePath, Theme)
defaultTheme = ("dark", Theme
darkTheme)

darkTheme :: Theme
darkTheme :: Theme
darkTheme = FilePath -> FilePath -> Theme
Theme "/static/css/dark.css" "/static/highlight/styles/hybrid.css"

lightTheme :: Theme
lightTheme :: Theme
lightTheme  = FilePath -> FilePath -> Theme
Theme "/static/css/light.css" "/static/highlight/styles/docco.css"


themes :: [(String, Theme)]
themes :: [(FilePath, Theme)]
themes =
  [("dark",  Theme
darkTheme)
  ,("light", Theme
lightTheme)
  ]