{-# LANGUAGE OverloadedStrings #-}
module Config.Main where
import qualified Brick.AttrMap as A
import qualified Brick.Widgets.List as L
import qualified Brick.Widgets.Dialog as D
import Data.Monoid ((<>))
import Brick.Util (fg, on, bg)
import qualified Brick.Widgets.Edit as E
import qualified Graphics.Vty as V
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import Control.Monad.Except (runExceptT)
import System.Environment (lookupEnv)
import System.Directory (getHomeDirectory)
import Data.Maybe (fromMaybe)
import Data.List.NonEmpty (fromList)
import System.Exit (ExitCode(..))
import Data.MIME (contentTypeTextPlain, defaultCharsets, matchContentType)
import UI.FileBrowser.Keybindings
(fileBrowserKeybindings, manageSearchPathKeybindings)
import UI.GatherHeaders.Keybindings
(gatherFromKeybindings,
gatherToKeybindings,
gatherSubjectKeybindings)
import UI.Index.Keybindings
(browseThreadsKeybindings, searchThreadsKeybindings, manageThreadTagsKeybindings)
import UI.Mail.Keybindings
(displayMailKeybindings, mailViewManageMailTagsKeybindings,
mailAttachmentsKeybindings, openWithKeybindings,
pipeToKeybindings, findWordEditorKeybindings,
saveToDiskKeybindings, mailviewComposeToKeybindings)
import UI.Help.Keybindings (helpKeybindings)
import UI.ComposeEditor.Keybindings
(listOfAttachmentsKeybindings, composeFromKeybindings,
composeToKeybindings, composeSubjectKeybindings, confirmKeybindings,
composeCcKeybindings, composeBccKeybindings)
import Error
import Types
import Purebred.System.Process
import Purebred.Types.IFC (sanitiseText, untaint)
import Storage.Notmuch (getDatabasePath)
sendmail ::
FilePath
-> B.Builder
-> IO (Either Error ())
sendmail bin m = do
result <- runExceptT $ tryReadProcessStderr config
pure $ case result of
Left e -> Left $ SendMailError (show e)
Right (ExitFailure _, stderr) -> Left $ SendMailError (untaint decode stderr)
Right (ExitSuccess, _) -> Right ()
where
config = setStdin (byteStringInput (B.toLazyByteString m)) $ proc bin ["-t", "-v"]
decode = T.unpack . sanitiseText . decodeLenient . L.toStrict
solarizedDark :: A.AttrMap
solarizedDark =
A.attrMap
V.defAttr
[ (listAttr, fg V.brightBlue)
, (listSelectedAttr, bg V.yellow)
, (listNewMailAttr, fg V.white)
, (listSelectedNewmailAttr, fg V.white)
, (listToggledAttr, bg V.yellow `V.withStyle` V.reverseVideo)
, (listSelectedToggledAttr, bg V.red `V.withStyle` V.reverseVideo)
, (mailTagAttr, fg V.cyan)
, (mailTagToggledAttr, bg V.brightBlue)
, (mailAuthorsAttr, fg V.brightBlue)
, (mailNewmailAuthorsAttr, fg V.white)
, (mailSelectedNewmailAuthorsAttr, fg V.white)
, (mailToggledAuthorsAttr, V.yellow `on` V.brightBlue)
, (E.editFocusedAttr, V.white `on` V.brightBlack)
, (editorAttr, V.brightBlue `on` V.brightBlack)
, (editorLabelAttr, V.brightYellow `on` V.brightBlack)
, (editorErrorAttr, fg V.red)
, (statusbarErrorAttr, bg V.red)
, (statusbarAttr, V.black `on` V.brightYellow)
, (headerKeyAttr, fg V.cyan)
, (headerValueAttr, fg V.brightCyan)
, (helpTitleAttr, fg V.cyan `V.withStyle` V.bold)
, (D.dialogAttr, V.yellow `on` V.white)
, (D.buttonAttr, V.black `on` V.white)
, (D.buttonSelectedAttr, bg V.green)
, (textMatchHighlightAttr, V.white `on` V.green)
, (currentTextMatchHighlightAttr, V.green `on` V.white)
, (defaultAttr, V.defAttr)
, (mailbodySourceAttr, fg V.blue)
]
listStateSelectedAttr :: A.AttrName
listStateSelectedAttr = "selected"
listStateNewmailAttr :: A.AttrName
listStateNewmailAttr = "newmail"
listStateToggledAttr :: A.AttrName
listStateToggledAttr = "toggled"
defaultAttr :: A.AttrName
defaultAttr = "default"
mailViewAttr :: A.AttrName
mailViewAttr = "mailview"
statusbarAttr :: A.AttrName
statusbarAttr = "statusbar"
statusbarErrorAttr :: A.AttrName
statusbarErrorAttr = statusbarAttr <> "error"
editorAttr :: A.AttrName
editorAttr = E.editAttr
editorFocusedAttr :: A.AttrName
editorFocusedAttr = E.editFocusedAttr
editorErrorAttr :: A.AttrName
editorErrorAttr = editorAttr <> "error"
editorLabelAttr :: A.AttrName
editorLabelAttr = editorAttr <> "label"
listAttr :: A.AttrName
listAttr = L.listAttr
listSelectedAttr :: A.AttrName
listSelectedAttr = L.listAttr <> listStateSelectedAttr
listNewMailAttr :: A.AttrName
listNewMailAttr = L.listAttr <> listStateNewmailAttr
listSelectedNewmailAttr :: A.AttrName
listSelectedNewmailAttr = L.listSelectedAttr <> listStateNewmailAttr
listToggledAttr :: A.AttrName
listToggledAttr = L.listAttr <> listStateToggledAttr
listSelectedToggledAttr :: A.AttrName
listSelectedToggledAttr = listStateSelectedAttr <> listToggledAttr
mailAttr :: A.AttrName
mailAttr = "mail"
mailTagAttr :: A.AttrName
mailTagAttr = mailAttr <> "tag"
mailTagToggledAttr :: A.AttrName
mailTagToggledAttr = mailTagAttr <> listStateToggledAttr
mailAuthorsAttr :: A.AttrName
mailAuthorsAttr = mailAttr <> "authors"
mailNewmailAuthorsAttr :: A.AttrName
mailNewmailAuthorsAttr = mailAuthorsAttr <> listStateNewmailAttr
mailToggledAuthorsAttr :: A.AttrName
mailToggledAuthorsAttr = mailAuthorsAttr <> listStateToggledAttr
mailSelectedAuthorsAttr :: A.AttrName
mailSelectedAuthorsAttr = mailAuthorsAttr <> listStateSelectedAttr
mailSelectedNewmailAuthorsAttr :: A.AttrName
mailSelectedNewmailAuthorsAttr = mailAuthorsAttr <> listStateSelectedAttr <> listStateNewmailAttr
mailSelectedToggledAuthorsAttr :: A.AttrName
mailSelectedToggledAuthorsAttr = mailSelectedAuthorsAttr <> listStateToggledAttr
headerAttr :: A.AttrName
headerAttr = "header"
headerKeyAttr :: A.AttrName
headerKeyAttr = headerAttr <> "key"
headerValueAttr :: A.AttrName
headerValueAttr = headerAttr <> "value"
helpAttr :: A.AttrName
helpAttr = "help"
helpTitleAttr :: A.AttrName
helpTitleAttr = helpAttr <> "title"
helpKeybindingAttr :: A.AttrName
helpKeybindingAttr = helpAttr <> "keybinding"
textMatchHighlightAttr :: A.AttrName
textMatchHighlightAttr = "match"
currentTextMatchHighlightAttr :: A.AttrName
currentTextMatchHighlightAttr = textMatchHighlightAttr <> "current"
mailbodyAttr :: A.AttrName
mailbodyAttr = "mailbody"
mailbodySourceAttr :: A.AttrName
mailbodySourceAttr = mailbodyAttr <> "source"
defaultConfig :: UserConfiguration
defaultConfig =
Configuration
{ _confTheme = solarizedDark
, _confNotmuch = NotmuchSettings
{ _nmSearch = "tag:inbox"
, _nmDatabase = getDatabasePath
, _nmNewTag = "unread"
, _nmDraftTag = "draft"
, _nmSentTag = "sent"
, _nmHasNewMailSearch = "tag:inbox and tag:unread"
, _nmHasNewMailCheckDelay = Just (Seconds 3)
}
, _confEditor = fromMaybe "vi" <$> lookupEnv "EDITOR"
, _confMailView = MailViewSettings
{ _mvIndexRows = 10
, _mvTextWidth = 82
, _mvPreferredContentType = contentTypeTextPlain
, _mvHeadersToShow = (`elem` ["subject", "to", "from", "cc", "date"])
, _mvKeybindings = displayMailKeybindings
, _mvManageMailTagsKeybindings = mailViewManageMailTagsKeybindings
, _mvMailListOfAttachmentsKeybindings = mailAttachmentsKeybindings
, _mvOpenWithKeybindings = openWithKeybindings
, _mvPipeToKeybindings = pipeToKeybindings
, _mvFindWordEditorKeybindings = findWordEditorKeybindings
, _mvSaveToDiskKeybindings = saveToDiskKeybindings
, _mvToKeybindings = mailviewComposeToKeybindings
, _mvMailcap =
[ ( matchContentType "text" (Just "html")
, MailcapHandler (Shell (fromList "elinks -force-html")) CopiousOutput DiscardTempfile)
, ( const True
, MailcapHandler (Process (fromList "xdg-open") []) IgnoreOutput KeepTempfile)
]
}
, _confIndexView = IndexViewSettings
{ _ivBrowseThreadsKeybindings = browseThreadsKeybindings
, _ivSearchThreadsKeybindings = searchThreadsKeybindings
, _ivManageThreadTagsKeybindings = manageThreadTagsKeybindings
, _ivFromKeybindings = gatherFromKeybindings
, _ivToKeybindings = gatherToKeybindings
, _ivSubjectKeybindings = gatherSubjectKeybindings
}
, _confComposeView = ComposeViewSettings
{ _cvFromKeybindings = composeFromKeybindings
, _cvToKeybindings = composeToKeybindings
, _cvCcKeybindings = composeCcKeybindings
, _cvBccKeybindings = composeBccKeybindings
, _cvSubjectKeybindings = composeSubjectKeybindings
, _cvSendMailCmd = sendmail "/usr/sbin/sendmail"
, _cvListOfAttachmentsKeybindings = listOfAttachmentsKeybindings
, _cvIdentities = []
, _cvConfirmKeybindings = confirmKeybindings
}
, _confHelpView = HelpViewSettings
{ _hvKeybindings = helpKeybindings
}
, _confDefaultView = Threads
, _confFileBrowserView = FileBrowserSettings
{ _fbKeybindings = fileBrowserKeybindings
, _fbSearchPathKeybindings = manageSearchPathKeybindings
, _fbHomePath = getHomeDirectory
}
, _confCharsets = defaultCharsets
, _confExtra = ()
}