module Settings where
import Prelude
import Control.Applicative
import Data.Aeson
import Data.ByteString (ByteString)
import Data.Default (def)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Yaml
import Language.Haskell.TH.Syntax (Q, Exp)
import Text.Hamlet
import Yesod.Default.Config
import Yesod.Default.Util
widgetFileSettings :: WidgetFileSettings
widgetFileSettings = def
{ wfsHamletSettings = defaultHamletSettings
{ hamletNewlines = AlwaysNewlines
}
}
widgetFile :: String -> Q Exp
widgetFile = (if development then widgetFileReload
else widgetFileNoReload)
widgetFileSettings
data RetagEntry = RetagEntry
{ retagName :: Text
, retagIcon :: Text
, retagAdd :: [String]
, retagRemove :: [String]
} deriving Show
instance ToJSON RetagEntry where
toJSON r = object [ "name" .= retagName r
, "icon" .= retagIcon r
, "add" .= retagAdd r
, "remove" .= retagRemove r
]
instance FromJSON RetagEntry where
parseJSON (Object o) = RetagEntry <$> o .: "name"
<*> o .: "icon"
<*> o .:? "add" .!= []
<*> o .:? "remove" .!= []
parseJSON _ = fail "Retag is not an object"
data Extra = Extra
{ extraHashedPwd :: ByteString
, extraFolders :: [(Text, String)]
, extraRetag :: [RetagEntry]
, extraFromAddresses :: [Text]
, extraSentBox :: Maybe FilePath
, extraMessageIDDomain :: Text
, extraGoogleClientId :: Maybe Text
, extraSourceLink :: Text
} deriving Show
parseExtra :: DefaultEnv -> Object -> Parser Extra
parseExtra _ o = do
pwd <- encodeUtf8 <$> o .: "hashed-password"
fdl <- o .: "folders" >>= mapM parseFolder
retag <- o .: "retag"
from <- o .:? "from-address" .!= "<test@example.com>"
fromlst <- o .:? "from-addresses"
let f = fromMaybe [from] fromlst
sent <- o .:? "sent-box"
dom <- o .:? "message-id-domain" .!= ""
gcid <- o .:? "google-client-id"
sl <- o .:? "source-link" .!= "https://bitbucket.org/wuzzeb/notmuch-web/src"
return $ Extra pwd fdl retag f sent dom gcid sl
parseFolder :: Object -> Parser (Text, String)
parseFolder o = (,) <$> o .: "name"
<*> o .: "search"
development :: Bool
development =
#if DEVELOPMENT
True
#else
False
#endif
production :: Bool
production = not development