-- This file is part of purebred -- Copyright (C) 2017-2018 Fraser Tweedale and Róman Joost -- -- purebred is free software: you can redistribute it and/or modify -- it under the terms of the GNU Affero General Public License as published by -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU Affero General Public License for more details. -- -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see <http://www.gnu.org/licenses/>. {- | To customise purebred configuration, create @~\/.config\/purebred\/purebred.hs@ and change the default config to your liking. For example, the following configuration adds some custom keybindings: @ import Data.Semigroup ((<>)) import Purebred scrollKeybindings :: ('Scrollable' w) => ['Keybinding' v w] scrollKeybindings = [ 'Keybinding' (EvKey (KChar 'j') []) ('scrollDown' ``chain`` 'continue') , Keybinding (EvKey (KChar 'k') []) ('scrollUp' \`chain\` continue) , Keybinding (EvKey (KChar 'd') []) ('scrollPageDown' \`chain\` continue) , Keybinding (EvKey (KChar 'u') []) ('scrollPageUp' \`chain\` continue) ] mailViewKeybindings = [ Keybinding (EvKey (KChar 'J') []) ('listDown' ``chain'`` 'displayMail' \`chain\` continue) , Keybinding (EvKey (KChar 'K') []) ('listUp' \`chain'` displayMail \`chain\` continue) , Keybinding (EvKey (KChar 'G') []) ('listJumpToEnd' \`chain\` continue) , Keybinding (EvKey (KChar 'g') []) ('listJumpToStart' \`chain\` continue) ] <> scrollKeybindings main = 'purebred' $ tweak 'defaultConfig' where tweak = over ('confMailView' . 'mvKeybindings') (mailViewKeybindings <>) . over ('confHelpView' . 'hvKeybindings') (scrollKeybindings <>) @ The invoke the program, just run @purebred@: But if recompilation is needed and you used @stack@ to build and install the program, it will not be able to find the libraries: > ftweedal% purebred > Configuration '/home/ftweedal/.config/purebred/purebred.hs' changed. Recompiling. > Error occurred while loading configuration file. > Launching custom binary /home/ftweedal/.cache/purebred/purebred-linux-x86_64 > > purebred-linux-x86_64: > /home/ftweedal/.config/purebred/purebred.hs:4:1: error: > Could not find module ‘Purebred’ > Use -v to see a list of the files searched for. > | > 4 | import Purebred > | ^^^^^^^^^^^^^^^ > > CallStack (from HasCallStack): > error, called at src/Purebred.hs:205:32 in purebred-0.1.0.0-8yyFpK6IBghCAYUvNAhJRk:Purebred To avoid this, don't use stack. But if you insist, you can run @stack exec purebred@ from the source tree. If you want to override the configuration file location, use the @PUREBRED_CONFIG_DIR@ environment variable. The configuration file, located in this directory, must always be name @purebred.hs@. The binary is normally cached in @~\/.cache\/purebred\/@. If you override the configuration directory, the configuration directory is also used as the cache directory, to avoid clobbering the cached binary for the other configurations. -} module Purebred ( module Types, module UI.Actions, module UI.Index.Keybindings, module UI.Mail.Keybindings, Event(..), Key(..), Modifier(..), List(..), Next, getDatabasePath, defaultConfig, solarizedDark, solarizedLight, (</>), module Control.Lens, genBoundary, Mailbox(..), AddrSpec(..), Domain(..), purebred) where import UI.App (theApp, initialState) import qualified Config.Dyre as Dyre import qualified Control.DeepSeq import Control.Monad ((>=>), void) import Options.Applicative hiding (str) import qualified Options.Applicative.Builder as Builder import Data.Semigroup ((<>)) import System.Environment (lookupEnv) import System.FilePath.Posix ((</>)) import System.Random (RandomGen, getStdGen, randomRs) import Data.Version (showVersion) import Paths_purebred (version) import UI.Index.Keybindings import UI.Mail.Keybindings import UI.Actions import Storage.Notmuch (getDatabasePath) import Config.Main (defaultConfig, solarizedDark, solarizedLight) import Types -- re-exports for configuration import Graphics.Vty.Input.Events (Event(..), Key(..), Modifier(..)) import Brick.Main (defaultMain) import Brick.Types (Next) import Brick.Widgets.List (List(..)) import Control.Lens ((&), over, set) import Data.MIME (Mailbox(..), AddrSpec(..), Domain(..)) newtype AppConfig = AppConfig { databaseFilepath :: Maybe String } appconfig :: Parser AppConfig appconfig = AppConfig <$> optional ( Builder.option Builder.str (long "database" <> metavar "DATABASE" <> help "Filepath to notmuch database") ) <* Builder.infoOption versionString (long "version" <> short 'v' <> help "Prints the Purebred version and exits") versionString :: String versionString = showVersion version optParser :: ParserInfo AppConfig optParser = info (appconfig <**> helper) (fullDesc <> progDesc "purebred" <> header ("a search based, terminal mail user agent - " <> versionString)) launch :: UserConfiguration -> IO () launch cfg = do -- set the user-specified database path *before* processing config, -- to avoid possible error in `notmuch config-get` opts <- execParser optParser let pre = maybe id (set (confNotmuch . nmDatabase) . pure) (databaseFilepath opts) -- Set the boundary generator (an INFINITE [Char]) /after/ deepseq'ing :) -- FIXME: seems like something that shouldn't be exposed in user config b <- genBoundary <$> getStdGen let post = set (confComposeView . cvBoundary) b cfg' <- post <$> processConfig (pre cfg) s <- initialState cfg' void $ defaultMain (theApp s) s -- | Process the user config into an internal configuration, then -- fully evaluates it. processConfig :: UserConfiguration -> IO InternalConfiguration processConfig = fmap Control.DeepSeq.force . ( (confNotmuch . nmDatabase) id >=> confEditor id >=> (confFileBrowserView . fbHomePath) id ) -- RFC2046 5.1.1 boundaryChars :: String boundaryChars = ['0'..'9'] <> ['a'..'z'] <> ['A'..'Z'] <> "'()+_,-./:=?" genBoundary :: RandomGen g => g -> String genBoundary = filter isBoundaryChar . randomRs (minimum boundaryChars, maximum boundaryChars) where isBoundaryChar = (`elem` boundaryChars) purebred :: UserConfiguration -> IO () purebred cfg = do configDir <- lookupEnv "PUREBRED_CONFIG_DIR" let dyreParams = Dyre.defaultParams { Dyre.projectName = "purebred" , Dyre.realMain = launch , Dyre.showError = const error , Dyre.configDir = pure <$> configDir -- if config dir specified, also use it as cache dir to avoid -- clobbering cached binaries for other configurations , Dyre.cacheDir = pure <$> configDir , Dyre.ghcOpts = ["-threaded"] } Dyre.wrapMain dyreParams cfg