{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-}
module Matterhorn.Config
( Config(..)
, PasswordSource(..)
, findConfig
, defaultConfig
, configConnectionType
)
where
import Prelude ()
import Matterhorn.Prelude
import qualified Paths_matterhorn as Paths
import Brick.Keybindings
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class ( lift )
import Data.Char ( isDigit, isAlpha )
import Data.List ( isPrefixOf )
import Data.List.Split ( splitOn )
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Graphics.Vty as Vty
import System.Directory ( makeAbsolute, getHomeDirectory )
import System.Environment ( getExecutablePath )
import System.FilePath ( (</>), takeDirectory, splitPath, joinPath )
import System.Process ( readProcess )
import Network.Mattermost.Types (ConnectionType(..))
import Network.URI ( isIPv4address, isIPv6address )
import Matterhorn.Config.Schema
import Matterhorn.FilePaths
import Matterhorn.IOUtil
import Matterhorn.Types
defaultPort :: Int
defaultPort :: Int
defaultPort = Int
443
bundledSyntaxPlaceholderName :: String
bundledSyntaxPlaceholderName :: String
bundledSyntaxPlaceholderName = String
"BUNDLED_SYNTAX"
userSyntaxPlaceholderName :: String
userSyntaxPlaceholderName :: String
userSyntaxPlaceholderName = String
"USER_SYNTAX"
defaultSkylightingPaths :: IO [FilePath]
defaultSkylightingPaths :: IO [String]
defaultSkylightingPaths = do
String
xdg <- IO String
xdgSyntaxDir
[String]
dataDirs <- IO [String]
xdgDataDirs
String
adjacent <- IO String
getBundledSyntaxPath
String
cabalDataFiles <- String -> IO String
Paths.getDataFileName String
syntaxDirName
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String
xdg, String
adjacent, String
cabalDataFiles] forall a. Semigroup a => a -> a -> a
<> [String]
dataDirs
getBundledSyntaxPath :: IO FilePath
getBundledSyntaxPath :: IO String
getBundledSyntaxPath = do
String
selfPath <- IO String
getExecutablePath
let distDir :: String
distDir = String
"dist-newstyle/"
pathBits :: [String]
pathBits = String -> [String]
splitPath String
selfPath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if String
distDir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
pathBits
then
([String] -> String
joinPath forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= String
distDir) [String]
pathBits) String -> String -> String
</> String
syntaxDirName
else
String -> String
takeDirectory String
selfPath String -> String -> String
</> String
syntaxDirName
fromIni :: IniParser Config
fromIni :: IniParser Config
fromIni = do
forall a. Text -> SectionParser a -> IniParser a
section Text
"mattermost" forall a b. (a -> b) -> a -> b
$ do
Maybe Text
configUser <- forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"user" forall e. Text -> Either e Text
stringField
Maybe Text
configHost <- forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"host" Text -> Either String Text
hostField
Maybe Text
configTeam <- forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"team" forall e. Text -> Either e Text
stringField
Int
configPort <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"port" forall a. (Num a, Read a, Typeable a) => Text -> Either String a
number (Config -> Int
configPort Config
defaultConfig)
Maybe Text
configUrlPath <- forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"urlPath" forall e. Text -> Either e Text
stringField
Int
configChannelListWidth <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"channelListWidth" forall a. (Num a, Read a, Typeable a) => Text -> Either String a
number
(Config -> Int
configChannelListWidth Config
defaultConfig)
CPUUsagePolicy
configCpuUsagePolicy <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"cpuUsagePolicy" Text -> Either String CPUUsagePolicy
cpuUsagePolicy
(Config -> CPUUsagePolicy
configCpuUsagePolicy Config
defaultConfig)
Int
configLogMaxBufferSize <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"logMaxBufferSize" forall a. (Num a, Read a, Typeable a) => Text -> Either String a
number
(Config -> Int
configLogMaxBufferSize Config
defaultConfig)
Maybe Text
configTimeFormat <- forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"timeFormat" forall e. Text -> Either e Text
stringField
Maybe Text
configDateFormat <- forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"dateFormat" forall e. Text -> Either e Text
stringField
Maybe Text
configTheme <- forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"theme" forall e. Text -> Either e Text
stringField
Maybe Text
configThemeCustomizationFile <- forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"themeCustomizationFile" forall e. Text -> Either e Text
stringField
Maybe Text
configAspellDictionary <- forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"aspellDictionary" forall e. Text -> Either e Text
stringField
Maybe Text
configURLOpenCommand <- forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"urlOpenCommand" forall e. Text -> Either e Text
stringField
Bool
configURLOpenCommandInteractive <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"urlOpenCommandIsInteractive" Bool
False
Bool
configSmartBacktick <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"smartbacktick"
(Config -> Bool
configSmartBacktick Config
defaultConfig)
Bool
configSmartEditing <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"smartediting"
(Config -> Bool
configSmartEditing Config
defaultConfig)
Bool
configShowOlderEdits <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showOlderEdits"
(Config -> Bool
configShowOlderEdits Config
defaultConfig)
BackgroundInfo
configShowBackground <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"showBackgroundActivity" Text -> Either String BackgroundInfo
backgroundField
(Config -> BackgroundInfo
configShowBackground Config
defaultConfig)
Bool
configShowMessagePreview <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showMessagePreview"
(Config -> Bool
configShowMessagePreview Config
defaultConfig)
Bool
configShowChannelList <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showChannelList"
(Config -> Bool
configShowChannelList Config
defaultConfig)
Bool
configShowExpandedChannelTopics <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showExpandedChannelTopics"
(Config -> Bool
configShowExpandedChannelTopics Config
defaultConfig)
Bool
configShowTypingIndicator <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showTypingIndicator"
(Config -> Bool
configShowTypingIndicator Config
defaultConfig)
Bool
configSendTypingNotifications <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"sendTypingNotifications"
(Config -> Bool
configSendTypingNotifications Config
defaultConfig)
Bool
configEnableAspell <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"enableAspell"
(Config -> Bool
configEnableAspell Config
defaultConfig)
[String]
configSyntaxDirs <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"syntaxDirectories" Text -> Either String [String]
syntaxDirsField []
Maybe Text
configActivityNotifyCommand <- Text -> SectionParser (Maybe Text)
fieldMb Text
"activityNotifyCommand"
NotificationVersion
configActivityNotifyVersion <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"activityNotifyVersion"
Text -> Either String NotificationVersion
notifyVersion (Config -> NotificationVersion
configActivityNotifyVersion Config
defaultConfig)
Bool
configShowMessageTimestamps <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showMessageTimestamps"
(Config -> Bool
configShowMessageTimestamps Config
defaultConfig)
Bool
configActivityBell <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"activityBell"
(Config -> Bool
configActivityBell Config
defaultConfig)
Int
configTruncateVerbatimBlocksInt <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"truncateVerbatimBlockHeight" forall a. (Num a, Read a, Typeable a) => Text -> Either String a
number
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Config -> Maybe Int
configTruncateVerbatimBlocks Config
defaultConfig)
ChannelListSorting
configChannelListSorting <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"channelListSorting"
Text -> Either String ChannelListSorting
parseChannelListSorting (Config -> ChannelListSorting
configChannelListSorting Config
defaultConfig)
TeamListSorting
configTeamListSorting <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"teamListSorting"
Text -> Either String TeamListSorting
parseTeamListSorting (Config -> TeamListSorting
configTeamListSorting Config
defaultConfig)
let configTruncateVerbatimBlocks :: Maybe Int
configTruncateVerbatimBlocks = case Int
configTruncateVerbatimBlocksInt of
Int
i | Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 -> forall a. Maybe a
Nothing
| Bool
otherwise -> forall a. a -> Maybe a
Just Int
i
Bool
configHyperlinkingMode <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"hyperlinkURLs"
(Config -> Bool
configHyperlinkingMode Config
defaultConfig)
Bool
configShowLastOpenThread <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showLastOpenThread"
(Config -> Bool
configShowLastOpenThread Config
defaultConfig)
Maybe PasswordSource
configPass <- (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PasswordSource
PasswordCommand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> SectionParser Text
field Text
"passcmd") forall e t a. Parser e t a -> Parser e t a -> Parser e t a
<!>
(forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PasswordSource
PasswordString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> SectionParser Text
field Text
"pass") forall e t a. Parser e t a -> Parser e t a -> Parser e t a
<!>
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
ChannelListOrientation
configChannelListOrientation <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"channelListOrientation"
Text -> Either String ChannelListOrientation
channelListOrientationField
(Config -> ChannelListOrientation
configChannelListOrientation Config
defaultConfig)
ThreadOrientation
configThreadOrientation <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"threadOrientation"
Text -> Either String ThreadOrientation
threadOrientationField
(Config -> ThreadOrientation
configThreadOrientation Config
defaultConfig)
Maybe TokenSource
configToken <- (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TokenSource
TokenCommand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> SectionParser Text
field Text
"tokencmd") forall e t a. Parser e t a -> Parser e t a -> Parser e t a
<!>
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Maybe OTPTokenSource
configOTPToken <- (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> OTPTokenSource
OTPTokenCommand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> SectionParser Text
field Text
"otptokencmd") forall e t a. Parser e t a -> Parser e t a -> Parser e t a
<!>
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Bool
configUnsafeUseHTTP <-
Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"unsafeUseUnauthenticatedConnection" Bool
False
Bool
configValidateServerCertificate <-
Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"validateServerCertificate" Bool
True
Int
configDirectChannelExpirationDays <- forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"directChannelExpirationDays" forall a. (Num a, Read a, Typeable a) => Text -> Either String a
number
(Config -> Int
configDirectChannelExpirationDays Config
defaultConfig)
Maybe String
configDefaultAttachmentPath <- forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"defaultAttachmentPath" forall e. Text -> Either e String
filePathField
Bool
configMouseMode <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"enableMouseMode"
(Config -> Bool
configMouseMode Config
defaultConfig)
let configAbsPath :: Maybe a
configAbsPath = forall a. Maybe a
Nothing
configUserKeys :: KeyConfig KeyEvent
configUserKeys = forall k.
Ord k =>
KeyEvents k
-> [(k, [Binding])] -> [(k, BindingState)] -> KeyConfig k
newKeyConfig KeyEvents KeyEvent
allEvents [] []
forall (m :: * -> *) a. Monad m => a -> m a
return Config { Bool
Int
[String]
Maybe Int
Maybe String
Maybe Text
Maybe OTPTokenSource
Maybe TokenSource
Maybe PasswordSource
KeyConfig KeyEvent
ThreadOrientation
ChannelListOrientation
BackgroundInfo
CPUUsagePolicy
TeamListSorting
ChannelListSorting
NotificationVersion
forall a. Maybe a
configDefaultAttachmentPath :: Maybe String
configSyntaxDirs :: [String]
configUserKeys :: KeyConfig KeyEvent
configAbsPath :: Maybe String
configValidateServerCertificate :: Bool
configUnsafeUseHTTP :: Bool
configAspellDictionary :: Maybe Text
configActivityNotifyCommand :: Maybe Text
configURLOpenCommandInteractive :: Bool
configURLOpenCommand :: Maybe Text
configThemeCustomizationFile :: Maybe Text
configTheme :: Maybe Text
configDateFormat :: Maybe Text
configTimeFormat :: Maybe Text
configOTPToken :: Maybe OTPTokenSource
configToken :: Maybe TokenSource
configPass :: Maybe PasswordSource
configUrlPath :: Maybe Text
configTeam :: Maybe Text
configHost :: Maybe Text
configUser :: Maybe Text
configUserKeys :: KeyConfig KeyEvent
configAbsPath :: forall a. Maybe a
configMouseMode :: Bool
configMouseMode :: Bool
configDefaultAttachmentPath :: Maybe String
configDirectChannelExpirationDays :: Int
configDirectChannelExpirationDays :: Int
configValidateServerCertificate :: Bool
configUnsafeUseHTTP :: Bool
configOTPToken :: Maybe OTPTokenSource
configToken :: Maybe TokenSource
configThreadOrientation :: ThreadOrientation
configThreadOrientation :: ThreadOrientation
configChannelListOrientation :: ChannelListOrientation
configChannelListOrientation :: ChannelListOrientation
configPass :: Maybe PasswordSource
configShowLastOpenThread :: Bool
configShowLastOpenThread :: Bool
configHyperlinkingMode :: Bool
configHyperlinkingMode :: Bool
configTruncateVerbatimBlocks :: Maybe Int
configTeamListSorting :: TeamListSorting
configTeamListSorting :: TeamListSorting
configChannelListSorting :: ChannelListSorting
configChannelListSorting :: ChannelListSorting
configTruncateVerbatimBlocks :: Maybe Int
configActivityBell :: Bool
configActivityBell :: Bool
configShowMessageTimestamps :: Bool
configShowMessageTimestamps :: Bool
configActivityNotifyVersion :: NotificationVersion
configActivityNotifyVersion :: NotificationVersion
configActivityNotifyCommand :: Maybe Text
configSyntaxDirs :: [String]
configEnableAspell :: Bool
configEnableAspell :: Bool
configSendTypingNotifications :: Bool
configSendTypingNotifications :: Bool
configShowTypingIndicator :: Bool
configShowTypingIndicator :: Bool
configShowExpandedChannelTopics :: Bool
configShowExpandedChannelTopics :: Bool
configShowChannelList :: Bool
configShowChannelList :: Bool
configShowMessagePreview :: Bool
configShowMessagePreview :: Bool
configShowBackground :: BackgroundInfo
configShowBackground :: BackgroundInfo
configShowOlderEdits :: Bool
configShowOlderEdits :: Bool
configSmartEditing :: Bool
configSmartEditing :: Bool
configSmartBacktick :: Bool
configSmartBacktick :: Bool
configURLOpenCommandInteractive :: Bool
configURLOpenCommand :: Maybe Text
configAspellDictionary :: Maybe Text
configThemeCustomizationFile :: Maybe Text
configTheme :: Maybe Text
configDateFormat :: Maybe Text
configTimeFormat :: Maybe Text
configLogMaxBufferSize :: Int
configLogMaxBufferSize :: Int
configCpuUsagePolicy :: CPUUsagePolicy
configCpuUsagePolicy :: CPUUsagePolicy
configChannelListWidth :: Int
configChannelListWidth :: Int
configUrlPath :: Maybe Text
configPort :: Int
configPort :: Int
configTeam :: Maybe Text
configHost :: Maybe Text
configUser :: Maybe Text
.. }
defaultBindings :: [(KeyEvent, [Binding])]
defaultBindings :: [(KeyEvent, [Binding])]
defaultBindings =
[ (KeyEvent
VtyRefreshEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'l' ])
, (KeyEvent
ShowHelpEvent , [ Int -> Binding
fn Int
1 ])
, (KeyEvent
EnterSelectModeEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
's' ])
, (KeyEvent
ReplyRecentEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'r' ])
, (KeyEvent
ToggleMessagePreviewEvent , [ forall a. ToBinding a => a -> Binding
meta Char
'p' ])
, (KeyEvent
InvokeEditorEvent , [ forall a. ToBinding a => a -> Binding
meta Char
'k' ])
, (KeyEvent
EnterFastSelectModeEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'g' ])
, (KeyEvent
QuitEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'q' ])
, (KeyEvent
NextChannelEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'n' ])
, (KeyEvent
PrevChannelEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'p' ])
, (KeyEvent
NextChannelEventAlternate , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KDown ])
, (KeyEvent
PrevChannelEventAlternate , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KUp ])
, (KeyEvent
NextUnreadChannelEvent , [ forall a. ToBinding a => a -> Binding
meta Char
'a' ])
, (KeyEvent
ShowAttachmentListEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'x' ])
, (KeyEvent
ChangeMessageEditorFocus , [ forall a. ToBinding a => a -> Binding
meta Char
'o' ])
, (KeyEvent
NextUnreadUserOrChannelEvent , [ ])
, (KeyEvent
LastChannelEvent , [ forall a. ToBinding a => a -> Binding
meta Char
's' ])
, (KeyEvent
EnterOpenURLModeEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'o' ])
, (KeyEvent
ClearUnreadEvent , [ forall a. ToBinding a => a -> Binding
meta Char
'l' ])
, (KeyEvent
ToggleMultiLineEvent , [ forall a. ToBinding a => a -> Binding
meta Char
'e' ])
, (KeyEvent
EnterFlaggedPostsEvent , [ forall a. ToBinding a => a -> Binding
meta Char
'8' ])
, (KeyEvent
ToggleChannelListVisibleEvent , [ Int -> Binding
fn Int
2 ])
, (KeyEvent
ToggleExpandedChannelTopicsEvent , [ Int -> Binding
fn Int
3 ])
, (KeyEvent
CycleChannelListSorting , [ Int -> Binding
fn Int
4 ])
, (KeyEvent
SelectNextTabEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'\t' ])
, (KeyEvent
SelectPreviousTabEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KBackTab ])
, (KeyEvent
SaveAttachmentEvent , [ forall a. ToBinding a => a -> Binding
bind Char
's' ])
, (KeyEvent
LoadMoreEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'b' ])
, (KeyEvent
ScrollUpEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KUp ])
, (KeyEvent
ScrollDownEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KDown ])
, (KeyEvent
ScrollLeftEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KLeft ])
, (KeyEvent
ScrollRightEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KRight ])
, (KeyEvent
ChannelListScrollUpEvent , [ forall a. ToBinding a => a -> Binding
ctrl Key
Vty.KUp ])
, (KeyEvent
ChannelListScrollDownEvent , [ forall a. ToBinding a => a -> Binding
ctrl Key
Vty.KDown ])
, (KeyEvent
PageUpEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KPageUp ])
, (KeyEvent
PageDownEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KPageDown ])
, (KeyEvent
PageLeftEvent , [ forall a. ToBinding a => a -> Binding
shift Key
Vty.KLeft ])
, (KeyEvent
PageRightEvent , [ forall a. ToBinding a => a -> Binding
shift Key
Vty.KRight ])
, (KeyEvent
ScrollTopEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KHome, forall a. ToBinding a => a -> Binding
meta Char
'<' ])
, (KeyEvent
ScrollBottomEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnd, forall a. ToBinding a => a -> Binding
meta Char
'>' ])
, (KeyEvent
SelectOldestMessageEvent , [ forall a. ToBinding a => a -> Binding
shift Key
Vty.KHome ])
, (KeyEvent
SelectUpEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'k', forall a. ToBinding a => a -> Binding
bind Key
Vty.KUp ])
, (KeyEvent
SelectDownEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'j', forall a. ToBinding a => a -> Binding
bind Key
Vty.KDown ])
, (KeyEvent
ActivateListItemEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnter ])
, (KeyEvent
SearchSelectUpEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'p', forall a. ToBinding a => a -> Binding
bind Key
Vty.KUp ])
, (KeyEvent
SearchSelectDownEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'n', forall a. ToBinding a => a -> Binding
bind Key
Vty.KDown ])
, (KeyEvent
ViewMessageEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'v' ])
, (KeyEvent
FillGapEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnter ])
, (KeyEvent
CopyPostLinkEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'l' ])
, (KeyEvent
FlagMessageEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'f' ])
, (KeyEvent
OpenThreadEvent , [ forall a. ToBinding a => a -> Binding
bind Char
't' ])
, (KeyEvent
PinMessageEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'p' ])
, (KeyEvent
OpenMessageInExternalEditorEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'O' ])
, (KeyEvent
YankMessageEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'y' ])
, (KeyEvent
YankWholeMessageEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'Y' ])
, (KeyEvent
DeleteMessageEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'd' ])
, (KeyEvent
EditMessageEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'e' ])
, (KeyEvent
ReplyMessageEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'r' ])
, (KeyEvent
ReactToMessageEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'a' ])
, (KeyEvent
OpenMessageURLEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'o' ])
, (KeyEvent
AttachmentListAddEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'a' ])
, (KeyEvent
AttachmentListDeleteEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'd' ])
, (KeyEvent
AttachmentOpenEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'o' ])
, (KeyEvent
CancelEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KEsc, forall a. ToBinding a => a -> Binding
ctrl Char
'c' ])
, (KeyEvent
EditorBolEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'a' ])
, (KeyEvent
EditorEolEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'e' ])
, (KeyEvent
EditorTransposeCharsEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
't' ])
, (KeyEvent
EditorDeleteCharacter , [ forall a. ToBinding a => a -> Binding
ctrl Char
'd' ])
, (KeyEvent
EditorKillToBolEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'u' ])
, (KeyEvent
EditorKillToEolEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'k' ])
, (KeyEvent
EditorPrevCharEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'b' ])
, (KeyEvent
EditorNextCharEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'f' ])
, (KeyEvent
EditorPrevWordEvent , [ forall a. ToBinding a => a -> Binding
meta Char
'b' ])
, (KeyEvent
EditorNextWordEvent , [ forall a. ToBinding a => a -> Binding
meta Char
'f' ])
, (KeyEvent
EditorDeleteNextWordEvent , [ forall a. ToBinding a => a -> Binding
meta Char
'd' ])
, (KeyEvent
EditorDeletePrevWordEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'w', forall a. ToBinding a => a -> Binding
meta Key
Vty.KBS ])
, (KeyEvent
EditorHomeEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KHome ])
, (KeyEvent
EditorEndEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnd ])
, (KeyEvent
EditorYankEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'y' ])
, (KeyEvent
FileBrowserBeginSearchEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'/' ])
, (KeyEvent
FileBrowserSelectEnterEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnter ])
, (KeyEvent
FileBrowserSelectCurrentEvent , [ forall a. ToBinding a => a -> Binding
bind Char
' ' ])
, (KeyEvent
FileBrowserListPageUpEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'b', forall a. ToBinding a => a -> Binding
bind Key
Vty.KPageUp ])
, (KeyEvent
FileBrowserListPageDownEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'f', forall a. ToBinding a => a -> Binding
bind Key
Vty.KPageDown ])
, (KeyEvent
FileBrowserListHalfPageUpEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'u' ])
, (KeyEvent
FileBrowserListHalfPageDownEvent , [ forall a. ToBinding a => a -> Binding
ctrl Char
'd' ])
, (KeyEvent
FileBrowserListTopEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'g', forall a. ToBinding a => a -> Binding
bind Key
Vty.KHome, forall a. ToBinding a => a -> Binding
meta Char
'<' ])
, (KeyEvent
FileBrowserListBottomEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'G', forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnd, forall a. ToBinding a => a -> Binding
meta Char
'>' ])
, (KeyEvent
FileBrowserListNextEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'j', forall a. ToBinding a => a -> Binding
ctrl Char
'n', forall a. ToBinding a => a -> Binding
bind Key
Vty.KDown ])
, (KeyEvent
FileBrowserListPrevEvent , [ forall a. ToBinding a => a -> Binding
bind Char
'k', forall a. ToBinding a => a -> Binding
ctrl Char
'p', forall a. ToBinding a => a -> Binding
bind Key
Vty.KUp ])
, (KeyEvent
FormSubmitEvent , [ forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnter ])
, (KeyEvent
NextTeamEvent , [ forall a. ToBinding a => a -> Binding
ctrl Key
Vty.KRight ])
, (KeyEvent
PrevTeamEvent , [ forall a. ToBinding a => a -> Binding
ctrl Key
Vty.KLeft ])
, (KeyEvent
MoveCurrentTeamLeftEvent , [ ])
, (KeyEvent
MoveCurrentTeamRightEvent , [ ])
]
channelListOrientationField :: Text -> Either String ChannelListOrientation
channelListOrientationField :: Text -> Either String ChannelListOrientation
channelListOrientationField Text
t =
case Text -> Text
T.toLower Text
t of
Text
"left" -> forall (m :: * -> *) a. Monad m => a -> m a
return ChannelListOrientation
ChannelListLeft
Text
"right" -> forall (m :: * -> *) a. Monad m => a -> m a
return ChannelListOrientation
ChannelListRight
Text
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Invalid value for channelListOrientation: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
t
threadOrientationField :: Text -> Either String ThreadOrientation
threadOrientationField :: Text -> Either String ThreadOrientation
threadOrientationField Text
t =
case Text -> Text
T.toLower Text
t of
Text
"left" -> forall (m :: * -> *) a. Monad m => a -> m a
return ThreadOrientation
ThreadLeft
Text
"right" -> forall (m :: * -> *) a. Monad m => a -> m a
return ThreadOrientation
ThreadRight
Text
"above" -> forall (m :: * -> *) a. Monad m => a -> m a
return ThreadOrientation
ThreadAbove
Text
"below" -> forall (m :: * -> *) a. Monad m => a -> m a
return ThreadOrientation
ThreadBelow
Text
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Invalid value for threadOrientation: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
t
syntaxDirsField :: Text -> Either String [FilePath]
syntaxDirsField :: Text -> Either String [String]
syntaxDirsField = forall l.
IsList l =>
Text -> (Text -> Either String (Item l)) -> Text -> Either String l
listWithSeparator Text
":" forall a. IsString a => Text -> Either String a
string
validHostnameFragmentChar :: Char -> Bool
validHostnameFragmentChar :: Char -> Bool
validHostnameFragmentChar Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'
isHostnameFragment :: String -> Bool
isHostnameFragment :: String -> Bool
isHostnameFragment String
"" = Bool
False
isHostnameFragment String
s = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validHostnameFragmentChar String
s
isHostname :: String -> Bool
isHostname :: String -> Bool
isHostname String
"" = Bool
False
isHostname String
s =
let parts :: [String]
parts = forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
s
h :: String
h = case [String]
parts of
(String
p:[String]
_) -> String
p
[] -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"BUG: isHostname: should always get at least one component: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [String]
parts
in forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
isHostnameFragment [String]
parts Bool -> Bool -> Bool
&& Bool -> Bool
not (String
"-" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
h)
hostField :: Text -> Either String Text
hostField :: Text -> Either String Text
hostField Text
t =
let s :: String
s = Text -> String
T.unpack Text
t
valid :: Bool
valid = forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ String -> Bool
isIPv4address String
s
, String -> Bool
isIPv6address String
s
, String -> Bool
isHostname String
s
]
in if Bool
valid
then forall a b. b -> Either a b
Right Text
t
else forall a b. a -> Either a b
Left String
"Invalid 'host' value, must be a hostname or IPv4/IPv6 address"
expandTilde :: FilePath -> FilePath -> FilePath
expandTilde :: String -> String -> String
expandTilde String
homeDir String
p =
let parts :: [String]
parts = String -> [String]
splitPath String
p
f :: String -> String
f String
part | String
part forall a. Eq a => a -> a -> Bool
== String
"~/" = String
homeDir forall a. Semigroup a => a -> a -> a
<> String
"/"
| Bool
otherwise = String
part
in [String] -> String
joinPath forall a b. (a -> b) -> a -> b
$ String -> String
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
parts
backgroundField :: Text -> Either String BackgroundInfo
backgroundField :: Text -> Either String BackgroundInfo
backgroundField Text
t =
case Text
t of
Text
"Disabled" -> forall a b. b -> Either a b
Right BackgroundInfo
Disabled
Text
"Active" -> forall a b. b -> Either a b
Right BackgroundInfo
Active
Text
"ActiveCount" -> forall a b. b -> Either a b
Right BackgroundInfo
ActiveCount
Text
_ -> forall a b. a -> Either a b
Left (String
"Invalid value " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
t
forall a. Semigroup a => a -> a -> a
<> String
"; must be one of: Disabled, Active, ActiveCount")
notifyVersion :: Text -> Either String NotificationVersion
notifyVersion :: Text -> Either String NotificationVersion
notifyVersion Text
t =
case Text
t of
Text
"1" -> forall a b. b -> Either a b
Right NotificationVersion
NotifyV1
Text
"2" -> forall a b. b -> Either a b
Right NotificationVersion
NotifyV2
Text
_ -> forall a b. a -> Either a b
Left (String
"Invalid value " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
t
forall a. Semigroup a => a -> a -> a
<> String
"; must be one of NotifyV1, NotifyV2")
parseChannelListSorting :: Text -> Either String ChannelListSorting
parseChannelListSorting :: Text -> Either String ChannelListSorting
parseChannelListSorting Text
t =
let validValues :: [(String, ChannelListSorting)]
validValues = [ (String
"default", ChannelListSorting
ChannelListSortDefault)
, (String
"unread-first", ChannelListSorting
ChannelListSortUnreadFirst)
]
in case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
t) [(String, ChannelListSorting)]
validValues of
Just ChannelListSorting
s -> forall a b. b -> Either a b
Right ChannelListSorting
s
Maybe ChannelListSorting
Nothing ->
forall a b. a -> Either a b
Left (String
"Invalid value " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
t forall a. Semigroup a => a -> a -> a
<> String
"; must be one of " forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, ChannelListSorting)]
validValues))
parseTeamListSorting :: Text -> Either String TeamListSorting
parseTeamListSorting :: Text -> Either String TeamListSorting
parseTeamListSorting Text
t =
let validValues :: [(String, TeamListSorting)]
validValues = [ (String
"default", TeamListSorting
TeamListSortDefault)
, (String
"unread-first", TeamListSorting
TeamListSortUnreadFirst)
]
in case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
t) [(String, TeamListSorting)]
validValues of
Just TeamListSorting
s -> forall a b. b -> Either a b
Right TeamListSorting
s
Maybe TeamListSorting
Nothing ->
forall a b. a -> Either a b
Left (String
"Invalid value " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
t forall a. Semigroup a => a -> a -> a
<> String
"; must be one of " forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, TeamListSorting)]
validValues))
cpuUsagePolicy :: Text -> Either String CPUUsagePolicy
cpuUsagePolicy :: Text -> Either String CPUUsagePolicy
cpuUsagePolicy Text
t =
case Text -> Text
T.toLower Text
t of
Text
"single" -> forall (m :: * -> *) a. Monad m => a -> m a
return CPUUsagePolicy
SingleCPU
Text
"multiple" -> forall (m :: * -> *) a. Monad m => a -> m a
return CPUUsagePolicy
MultipleCPUs
Text
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Invalid CPU usage policy value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
t
stringField :: Text -> Either e Text
stringField :: forall e. Text -> Either e Text
stringField Text
t =
case Text -> Bool
isQuoted Text
t of
Bool
True -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> Text
parseQuotedString Text
t
Bool
False -> forall a b. b -> Either a b
Right Text
t
filePathField :: Text -> Either e FilePath
filePathField :: forall e. Text -> Either e String
filePathField Text
t = let path :: String
path = Text -> String
T.unpack Text
t in forall a b. b -> Either a b
Right String
path
parseQuotedString :: Text -> Text
parseQuotedString :: Text -> Text
parseQuotedString Text
t =
let body :: Text
body = Int -> Text -> Text
T.drop Int
1 forall a b. (a -> b) -> a -> b
$ Text -> Text
T.init Text
t
unescapeQuotes :: Text -> Text
unescapeQuotes Text
s | Text -> Bool
T.null Text
s = Text
s
| Text
"\\\"" Text -> Text -> Bool
`T.isPrefixOf` Text
s = Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text -> Text
unescapeQuotes (Int -> Text -> Text
T.drop Int
2 Text
s)
| Bool
otherwise = (Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
s) forall a. Semigroup a => a -> a -> a
<> Text -> Text
unescapeQuotes (Int -> Text -> Text
T.drop Int
1 Text
s)
in Text -> Text
unescapeQuotes Text
body
isQuoted :: Text -> Bool
isQuoted :: Text -> Bool
isQuoted Text
t =
let quote :: Text
quote = Text
"\""
in (Text
quote Text -> Text -> Bool
`T.isPrefixOf` Text
t) Bool -> Bool -> Bool
&&
(Text
quote Text -> Text -> Bool
`T.isSuffixOf` Text
t)
addDefaultKeys :: Config -> Config
addDefaultKeys :: Config -> Config
addDefaultKeys Config
config =
Config
config { configUserKeys :: KeyConfig KeyEvent
configUserKeys = forall k.
Ord k =>
KeyEvents k
-> [(k, [Binding])] -> [(k, BindingState)] -> KeyConfig k
newKeyConfig KeyEvents KeyEvent
allEvents [(KeyEvent, [Binding])]
defaultBindings forall a. Monoid a => a
mempty }
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config -> Config
addDefaultKeys forall a b. (a -> b) -> a -> b
$
Config { configAbsPath :: Maybe String
configAbsPath = forall a. Maybe a
Nothing
, configUser :: Maybe Text
configUser = forall a. Maybe a
Nothing
, configHost :: Maybe Text
configHost = forall a. Maybe a
Nothing
, configTeam :: Maybe Text
configTeam = forall a. Maybe a
Nothing
, configPort :: Int
configPort = Int
defaultPort
, configUrlPath :: Maybe Text
configUrlPath = forall a. Maybe a
Nothing
, configPass :: Maybe PasswordSource
configPass = forall a. Maybe a
Nothing
, configToken :: Maybe TokenSource
configToken = forall a. Maybe a
Nothing
, configOTPToken :: Maybe OTPTokenSource
configOTPToken = forall a. Maybe a
Nothing
, configTimeFormat :: Maybe Text
configTimeFormat = forall a. Maybe a
Nothing
, configDateFormat :: Maybe Text
configDateFormat = forall a. Maybe a
Nothing
, configTheme :: Maybe Text
configTheme = forall a. Maybe a
Nothing
, configThemeCustomizationFile :: Maybe Text
configThemeCustomizationFile = forall a. Maybe a
Nothing
, configSmartBacktick :: Bool
configSmartBacktick = Bool
True
, configSmartEditing :: Bool
configSmartEditing = Bool
True
, configURLOpenCommand :: Maybe Text
configURLOpenCommand = forall a. Maybe a
Nothing
, configURLOpenCommandInteractive :: Bool
configURLOpenCommandInteractive = Bool
False
, configActivityNotifyCommand :: Maybe Text
configActivityNotifyCommand = forall a. Maybe a
Nothing
, configActivityNotifyVersion :: NotificationVersion
configActivityNotifyVersion = NotificationVersion
NotifyV1
, configActivityBell :: Bool
configActivityBell = Bool
False
, configTruncateVerbatimBlocks :: Maybe Int
configTruncateVerbatimBlocks = forall a. Maybe a
Nothing
, configShowMessageTimestamps :: Bool
configShowMessageTimestamps = Bool
True
, configShowBackground :: BackgroundInfo
configShowBackground = BackgroundInfo
Disabled
, configShowMessagePreview :: Bool
configShowMessagePreview = Bool
False
, configShowChannelList :: Bool
configShowChannelList = Bool
True
, configShowExpandedChannelTopics :: Bool
configShowExpandedChannelTopics = Bool
True
, configEnableAspell :: Bool
configEnableAspell = Bool
False
, configAspellDictionary :: Maybe Text
configAspellDictionary = forall a. Maybe a
Nothing
, configUnsafeUseHTTP :: Bool
configUnsafeUseHTTP = Bool
False
, configValidateServerCertificate :: Bool
configValidateServerCertificate = Bool
True
, configChannelListWidth :: Int
configChannelListWidth = Int
22
, configLogMaxBufferSize :: Int
configLogMaxBufferSize = Int
200
, configShowOlderEdits :: Bool
configShowOlderEdits = Bool
True
, configUserKeys :: KeyConfig KeyEvent
configUserKeys = forall k.
Ord k =>
KeyEvents k
-> [(k, [Binding])] -> [(k, BindingState)] -> KeyConfig k
newKeyConfig KeyEvents KeyEvent
allEvents [] []
, configShowTypingIndicator :: Bool
configShowTypingIndicator = Bool
False
, configSendTypingNotifications :: Bool
configSendTypingNotifications = Bool
False
, configHyperlinkingMode :: Bool
configHyperlinkingMode = Bool
True
, configShowLastOpenThread :: Bool
configShowLastOpenThread = Bool
False
, configSyntaxDirs :: [String]
configSyntaxDirs = []
, configDirectChannelExpirationDays :: Int
configDirectChannelExpirationDays = Int
7
, configCpuUsagePolicy :: CPUUsagePolicy
configCpuUsagePolicy = CPUUsagePolicy
MultipleCPUs
, configDefaultAttachmentPath :: Maybe String
configDefaultAttachmentPath = forall a. Maybe a
Nothing
, configChannelListOrientation :: ChannelListOrientation
configChannelListOrientation = ChannelListOrientation
ChannelListLeft
, configThreadOrientation :: ThreadOrientation
configThreadOrientation = ThreadOrientation
ThreadBelow
, configMouseMode :: Bool
configMouseMode = Bool
False
, configChannelListSorting :: ChannelListSorting
configChannelListSorting = ChannelListSorting
ChannelListSortDefault
, configTeamListSorting :: TeamListSorting
configTeamListSorting = TeamListSorting
TeamListSortDefault
}
findConfig :: Maybe FilePath -> IO (Either String ([String], Config))
findConfig :: Maybe String -> IO (Either String ([String], Config))
findConfig Maybe String
Nothing = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
Maybe String
cfg <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
locateConfig String
configFileName
([String]
warns, Config
config) <-
case Maybe String
cfg of
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], Config
defaultConfig)
Just String
path -> String -> ExceptT String IO ([String], Config)
getConfig String
path
Config
config' <- Config -> ExceptT String IO Config
fixupPaths Config
config
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
warns, Config
config')
findConfig (Just String
path) =
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do ([String]
warns, Config
config) <- String -> ExceptT String IO ([String], Config)
getConfig String
path
Config
config' <- Config -> ExceptT String IO Config
fixupPaths Config
config
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
warns, Config
config')
fixupPaths :: Config -> ExceptT String IO Config
fixupPaths :: Config -> ExceptT String IO Config
fixupPaths Config
initial = do
Config
new <- Config -> ExceptT String IO Config
fixupSyntaxDirs Config
initial
String
homeDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getHomeDirectory
let fixP :: String -> String
fixP = String -> String -> String
expandTilde String
homeDir
fixPText :: Text -> Text
fixPText = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
expandTilde String
homeDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Config
new { configThemeCustomizationFile :: Maybe Text
configThemeCustomizationFile = Text -> Text
fixPText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Maybe Text
configThemeCustomizationFile Config
new
, configSyntaxDirs :: [String]
configSyntaxDirs = String -> String
fixP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> [String]
configSyntaxDirs Config
new
, configURLOpenCommand :: Maybe Text
configURLOpenCommand = Text -> Text
fixPText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Maybe Text
configURLOpenCommand Config
new
, configActivityNotifyCommand :: Maybe Text
configActivityNotifyCommand = Text -> Text
fixPText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Maybe Text
configActivityNotifyCommand Config
new
, configDefaultAttachmentPath :: Maybe String
configDefaultAttachmentPath = String -> String
fixP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Maybe String
configDefaultAttachmentPath Config
new
}
fixupSyntaxDirs :: Config -> ExceptT String IO Config
fixupSyntaxDirs :: Config -> ExceptT String IO Config
fixupSyntaxDirs Config
c =
if Config -> [String]
configSyntaxDirs Config
c forall a. Eq a => a -> a -> Bool
== []
then do
[String]
dirs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
defaultSkylightingPaths
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Config
c { configSyntaxDirs :: [String]
configSyntaxDirs = [String]
dirs }
else do
[String]
newDirs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Config -> [String]
configSyntaxDirs Config
c) forall a b. (a -> b) -> a -> b
$ \String
dir ->
if | String
dir forall a. Eq a => a -> a -> Bool
== String
bundledSyntaxPlaceholderName -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getBundledSyntaxPath
| String
dir forall a. Eq a => a -> a -> Bool
== String
userSyntaxPlaceholderName -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
xdgSyntaxDir
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return String
dir
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Config
c { configSyntaxDirs :: [String]
configSyntaxDirs = [String]
newDirs }
keybindingsSectionName :: Text
keybindingsSectionName :: Text
keybindingsSectionName = Text
"keybindings"
getConfig :: FilePath -> ExceptT String IO ([String], Config)
getConfig :: String -> ExceptT String IO ([String], Config)
getConfig String
fp = do
String
absPath <- forall a. IO a -> ExceptT String IO a
convertIOException forall a b. (a -> b) -> a -> b
$ String -> IO String
makeAbsolute String
fp
Text
t <- (forall a. IO a -> ExceptT String IO a
convertIOException forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
absPath) forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchE`
(\String
e -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ String
"Could not read " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
absPath forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> String
e)
let t' :: Text
t' = if Text
"\n" Text -> Text -> Bool
`T.isSuffixOf` Text
t then Text
t else Text
t forall a. Semigroup a => a -> a -> a
<> Text
"\n"
case forall a. Text -> IniParser a -> Either Fatal ([Warning], a)
parseIniFile Text
t' IniParser Config
fromIni of
Left Fatal
err -> do
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ String
"Unable to parse " forall a. [a] -> [a] -> [a]
++ String
absPath forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ Fatal -> String
fatalString Fatal
err
Right ([Warning]
warns, Config
confNoKeys) -> do
let mKeys :: Maybe [(KeyEvent, BindingState)]
mKeys = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall k.
KeyEvents k
-> Text -> Text -> Either String (Maybe [(k, BindingState)])
keybindingsFromIni KeyEvents KeyEvent
allEvents Text
keybindingsSectionName Text
t'
kc :: KeyConfig KeyEvent
kc = forall k.
Ord k =>
KeyEvents k
-> [(k, [Binding])] -> [(k, BindingState)] -> KeyConfig k
newKeyConfig KeyEvents KeyEvent
allEvents [(KeyEvent, [Binding])]
defaultBindings (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe [(KeyEvent, BindingState)]
mKeys)
conf :: Config
conf = Config
confNoKeys { configUserKeys :: KeyConfig KeyEvent
configUserKeys = KeyConfig KeyEvent
kc }
Maybe Text
actualPass <- case Config -> Maybe PasswordSource
configPass Config
conf of
Just (PasswordCommand Text
cmdString) -> do
let (String
cmd, [String]
rest) = case Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.words Text
cmdString of
(String
a:[String]
as) -> (String
a, [String]
as)
[] -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"BUG: getConfig: got empty command string"
String
output <- forall a. IO a -> ExceptT String IO a
convertIOException (String -> [String] -> String -> IO String
readProcess String
cmd [String]
rest String
"") forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchE`
(\String
e -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ String
"Could not execute password command: " forall a. Semigroup a => a -> a -> a
<> String
e)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
output)
Just (PasswordString Text
pass) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
pass
Maybe PasswordSource
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe Text
actualToken <- case Config -> Maybe TokenSource
configToken Config
conf of
Just (TokenCommand Text
cmdString) -> do
let (String
cmd, [String]
rest) = case Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.words Text
cmdString of
(String
a:[String]
as) -> (String
a, [String]
as)
[] -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"BUG: getConfig: got empty command string"
String
output <- forall a. IO a -> ExceptT String IO a
convertIOException (String -> [String] -> String -> IO String
readProcess String
cmd [String]
rest String
"") forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchE`
(\String
e -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ String
"Could not execute token command: " forall a. Semigroup a => a -> a -> a
<> String
e)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
output)
Just (TokenString Text
_) -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"BUG: getConfig: token in the Config was already a TokenString"
Maybe TokenSource
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe Text
actualOTPToken <- case Config -> Maybe OTPTokenSource
configOTPToken Config
conf of
Just (OTPTokenCommand Text
cmdString) -> do
let (String
cmd, [String]
rest) = case Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.words Text
cmdString of
(String
a:[String]
as) -> (String
a, [String]
as)
[] -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"BUG: getConfig: got empty command string"
String
output <- forall a. IO a -> ExceptT String IO a
convertIOException (String -> [String] -> String -> IO String
readProcess String
cmd [String]
rest String
"") forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchE`
(\String
e -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ String
"Could not execute OTP token command: " forall a. Semigroup a => a -> a -> a
<> String
e)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
output)
Just (OTPTokenString Text
_) -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"BUG: getConfig: otptoken in the Config was already a OTPTokenString"
Maybe OTPTokenSource
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
let conf' :: Config
conf' = Config
conf
{ configPass :: Maybe PasswordSource
configPass = Text -> PasswordSource
PasswordString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
actualPass
, configToken :: Maybe TokenSource
configToken = Text -> TokenSource
TokenString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
actualToken
, configOTPToken :: Maybe OTPTokenSource
configOTPToken = Text -> OTPTokenSource
OTPTokenString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
actualOTPToken
, configAbsPath :: Maybe String
configAbsPath = forall a. a -> Maybe a
Just String
absPath
}
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map Warning -> String
warningString [Warning]
warns, Config
conf')
configConnectionType :: Config -> ConnectionType
configConnectionType :: Config -> ConnectionType
configConnectionType Config
config
| Config -> Bool
configUnsafeUseHTTP Config
config = ConnectionType
ConnectHTTP
| Bool
otherwise = Bool -> ConnectionType
ConnectHTTPS (Config -> Bool
configValidateServerCertificate Config
config)