{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Vgrep.Environment.Config where
import Control.Lens.Compat
import Control.Monad.IO.Class
import Data.Maybe
import Data.Monoid
import Graphics.Vty.Attributes
( Attr
, blue
, bold
, defAttr
, green
, standout
, withBackColor
, withForeColor
, withStyle
)
import Vgrep.Command
import Vgrep.Environment.Config.Monoid
import Vgrep.Environment.Config.Sources
import qualified Vgrep.Key as Key
import Vgrep.KeybindingMap (KeybindingMap (..))
import qualified Vgrep.KeybindingMap as KeybindingMap
data Config = Config
{ Config -> Colors
_colors :: Colors
, Config -> Int
_tabstop :: Int
, Config -> String
_editor :: String
, Config -> Keybindings
_keybindings :: Keybindings
} deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)
data Colors = Colors
{ Colors -> Attr
_lineNumbers :: Attr
, Colors -> Attr
_lineNumbersHl :: Attr
, Colors -> Attr
_normal :: Attr
, Colors -> Attr
_normalHl :: Attr
, :: Attr
, Colors -> Attr
_selected :: Attr
} deriving (Colors -> Colors -> Bool
(Colors -> Colors -> Bool)
-> (Colors -> Colors -> Bool) -> Eq Colors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Colors -> Colors -> Bool
$c/= :: Colors -> Colors -> Bool
== :: Colors -> Colors -> Bool
$c== :: Colors -> Colors -> Bool
Eq, Int -> Colors -> ShowS
[Colors] -> ShowS
Colors -> String
(Int -> Colors -> ShowS)
-> (Colors -> String) -> ([Colors] -> ShowS) -> Show Colors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Colors] -> ShowS
$cshowList :: [Colors] -> ShowS
show :: Colors -> String
$cshow :: Colors -> String
showsPrec :: Int -> Colors -> ShowS
$cshowsPrec :: Int -> Colors -> ShowS
Show)
data Keybindings = Keybindings
{ Keybindings -> KeybindingMap
_resultsKeybindings :: KeybindingMap
, :: KeybindingMap
, Keybindings -> KeybindingMap
_globalKeybindings :: KeybindingMap
} deriving (Keybindings -> Keybindings -> Bool
(Keybindings -> Keybindings -> Bool)
-> (Keybindings -> Keybindings -> Bool) -> Eq Keybindings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Keybindings -> Keybindings -> Bool
$c/= :: Keybindings -> Keybindings -> Bool
== :: Keybindings -> Keybindings -> Bool
$c== :: Keybindings -> Keybindings -> Bool
Eq, Int -> Keybindings -> ShowS
[Keybindings] -> ShowS
Keybindings -> String
(Int -> Keybindings -> ShowS)
-> (Keybindings -> String)
-> ([Keybindings] -> ShowS)
-> Show Keybindings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Keybindings] -> ShowS
$cshowList :: [Keybindings] -> ShowS
show :: Keybindings -> String
$cshow :: Keybindings -> String
showsPrec :: Int -> Keybindings -> ShowS
$cshowsPrec :: Int -> Keybindings -> ShowS
Show)
makeLenses ''Config
fromConfigMonoid :: ConfigMonoid -> Config
fromConfigMonoid :: ConfigMonoid -> Config
fromConfigMonoid ConfigMonoid{First Int
First String
KeybindingsMonoid
ColorsMonoid
_mkeybindings :: ConfigMonoid -> KeybindingsMonoid
_meditor :: ConfigMonoid -> First String
_mtabstop :: ConfigMonoid -> First Int
_mcolors :: ConfigMonoid -> ColorsMonoid
_mkeybindings :: KeybindingsMonoid
_meditor :: First String
_mtabstop :: First Int
_mcolors :: ColorsMonoid
..} = Config :: Colors -> Int -> String -> Keybindings -> Config
Config
{ _colors :: Colors
_colors = ColorsMonoid -> Colors
fromColorsMonoid ColorsMonoid
_mcolors
, _tabstop :: Int
_tabstop = Int -> First Int -> Int
forall a. a -> First a -> a
fromFirst (Config -> Int
_tabstop Config
defaultConfig) First Int
_mtabstop
, _editor :: String
_editor = String -> First String -> String
forall a. a -> First a -> a
fromFirst (Config -> String
_editor Config
defaultConfig) First String
_meditor
, _keybindings :: Keybindings
_keybindings = KeybindingsMonoid -> Keybindings
fromKeybindingsMonoid KeybindingsMonoid
_mkeybindings }
fromColorsMonoid :: ColorsMonoid -> Colors
fromColorsMonoid :: ColorsMonoid -> Colors
fromColorsMonoid ColorsMonoid{First Attr
_mselected :: ColorsMonoid -> First Attr
_mfileHeaders :: ColorsMonoid -> First Attr
_mnormalHl :: ColorsMonoid -> First Attr
_mnormal :: ColorsMonoid -> First Attr
_mlineNumbersHl :: ColorsMonoid -> First Attr
_mlineNumbers :: ColorsMonoid -> First Attr
_mselected :: First Attr
_mfileHeaders :: First Attr
_mnormalHl :: First Attr
_mnormal :: First Attr
_mlineNumbersHl :: First Attr
_mlineNumbers :: First Attr
..} = Colors :: Attr -> Attr -> Attr -> Attr -> Attr -> Attr -> Colors
Colors
{ _lineNumbers :: Attr
_lineNumbers = Attr -> First Attr -> Attr
forall a. a -> First a -> a
fromFirst (Colors -> Attr
_lineNumbers Colors
defaultColors) First Attr
_mlineNumbers
, _lineNumbersHl :: Attr
_lineNumbersHl = Attr -> First Attr -> Attr
forall a. a -> First a -> a
fromFirst (Colors -> Attr
_lineNumbersHl Colors
defaultColors) First Attr
_mlineNumbersHl
, _normal :: Attr
_normal = Attr -> First Attr -> Attr
forall a. a -> First a -> a
fromFirst (Colors -> Attr
_normal Colors
defaultColors) First Attr
_mnormal
, _normalHl :: Attr
_normalHl = Attr -> First Attr -> Attr
forall a. a -> First a -> a
fromFirst (Colors -> Attr
_normalHl Colors
defaultColors) First Attr
_mnormalHl
, _fileHeaders :: Attr
_fileHeaders = Attr -> First Attr -> Attr
forall a. a -> First a -> a
fromFirst (Colors -> Attr
_fileHeaders Colors
defaultColors) First Attr
_mfileHeaders
, _selected :: Attr
_selected = Attr -> First Attr -> Attr
forall a. a -> First a -> a
fromFirst (Colors -> Attr
_selected Colors
defaultColors) First Attr
_mselected }
fromFirst :: a -> First a -> a
fromFirst :: a -> First a -> a
fromFirst a
a = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
a (Maybe a -> a) -> (First a -> Maybe a) -> First a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. First a -> Maybe a
forall a. First a -> Maybe a
getFirst
fromKeybindingsMonoid :: KeybindingsMonoid -> Keybindings
fromKeybindingsMonoid :: KeybindingsMonoid -> Keybindings
fromKeybindingsMonoid KeybindingsMonoid{Maybe KeybindingMap
_mglobalKeybindings :: KeybindingsMonoid -> Maybe KeybindingMap
_mpagerKeybindings :: KeybindingsMonoid -> Maybe KeybindingMap
_mresultsKeybindings :: KeybindingsMonoid -> Maybe KeybindingMap
_mglobalKeybindings :: Maybe KeybindingMap
_mpagerKeybindings :: Maybe KeybindingMap
_mresultsKeybindings :: Maybe KeybindingMap
..} = Keybindings :: KeybindingMap -> KeybindingMap -> KeybindingMap -> Keybindings
Keybindings
{ _resultsKeybindings :: KeybindingMap
_resultsKeybindings = KeybindingMap -> Maybe KeybindingMap -> KeybindingMap
forall a. a -> Maybe a -> a
fromMaybe KeybindingMap
forall a. Monoid a => a
mempty Maybe KeybindingMap
_mresultsKeybindings KeybindingMap -> KeybindingMap -> KeybindingMap
forall a. Semigroup a => a -> a -> a
<> Keybindings -> KeybindingMap
_resultsKeybindings Keybindings
defaultKeybindings
, _pagerKeybindings :: KeybindingMap
_pagerKeybindings = KeybindingMap -> Maybe KeybindingMap -> KeybindingMap
forall a. a -> Maybe a -> a
fromMaybe KeybindingMap
forall a. Monoid a => a
mempty Maybe KeybindingMap
_mpagerKeybindings KeybindingMap -> KeybindingMap -> KeybindingMap
forall a. Semigroup a => a -> a -> a
<> Keybindings -> KeybindingMap
_pagerKeybindings Keybindings
defaultKeybindings
, _globalKeybindings :: KeybindingMap
_globalKeybindings = KeybindingMap -> Maybe KeybindingMap -> KeybindingMap
forall a. a -> Maybe a -> a
fromMaybe KeybindingMap
forall a. Monoid a => a
mempty Maybe KeybindingMap
_mglobalKeybindings KeybindingMap -> KeybindingMap -> KeybindingMap
forall a. Semigroup a => a -> a -> a
<> Keybindings -> KeybindingMap
_globalKeybindings Keybindings
defaultKeybindings }
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Colors -> Int -> String -> Keybindings -> Config
Config
{ _colors :: Colors
_colors = Colors
defaultColors
, _tabstop :: Int
_tabstop = Int
8
, _editor :: String
_editor = String
"vi"
, _keybindings :: Keybindings
_keybindings = Keybindings
defaultKeybindings }
defaultColors :: Colors
defaultColors :: Colors
defaultColors = Colors :: Attr -> Attr -> Attr -> Attr -> Attr -> Attr -> Colors
Colors
{ _lineNumbers :: Attr
_lineNumbers = Attr
defAttr Attr -> Color -> Attr
`withForeColor` Color
blue
, _lineNumbersHl :: Attr
_lineNumbersHl = Attr
defAttr Attr -> Color -> Attr
`withForeColor` Color
blue
Attr -> Style -> Attr
`withStyle` Style
bold
, _normal :: Attr
_normal = Attr
defAttr
, _normalHl :: Attr
_normalHl = Attr
defAttr Attr -> Style -> Attr
`withStyle` Style
bold
, _fileHeaders :: Attr
_fileHeaders = Attr
defAttr Attr -> Color -> Attr
`withBackColor` Color
green
, _selected :: Attr
_selected = Attr
defAttr Attr -> Style -> Attr
`withStyle` Style
standout }
defaultKeybindings :: Keybindings
defaultKeybindings :: Keybindings
defaultKeybindings = Keybindings :: KeybindingMap -> KeybindingMap -> KeybindingMap -> Keybindings
Keybindings
{ _resultsKeybindings :: KeybindingMap
_resultsKeybindings = [(Chord, Command)] -> KeybindingMap
KeybindingMap.fromList
[ (Key -> Chord
Key.key Key
Key.Up, Command
ResultsUp)
, (Key -> Chord
Key.key Key
Key.Down, Command
ResultsDown)
, (Key -> Chord
Key.key Key
Key.PageUp, Command
ResultsPageUp)
, (Key -> Chord
Key.key Key
Key.PageDown, Command
ResultsPageDown)
, (Key -> Chord
Key.key Key
Key.Enter, Command
PagerGotoResult)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'k'), Command
ResultsUp)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'j'), Command
ResultsDown)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'b') Chord -> Mod -> Chord
`Key.withModifier` Mod
Key.Ctrl, Command
ResultsPageUp)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'f') Chord -> Mod -> Chord
`Key.withModifier` Mod
Key.Ctrl, Command
ResultsPageDown)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'f'), Command
DisplayResultsOnly)
, (Key -> Chord
Key.key Key
Key.Tab, Command
SplitFocusPager) ]
, _pagerKeybindings :: KeybindingMap
_pagerKeybindings = [(Chord, Command)] -> KeybindingMap
KeybindingMap.fromList
[ (Key -> Chord
Key.key Key
Key.Up, Command
PagerUp)
, (Key -> Chord
Key.key Key
Key.Down, Command
PagerDown)
, (Key -> Chord
Key.key Key
Key.PageUp, Command
PagerPageUp)
, (Key -> Chord
Key.key Key
Key.PageDown, Command
PagerPageDown)
, (Key -> Chord
Key.key Key
Key.Left, Command
PagerScrollLeft)
, (Key -> Chord
Key.key Key
Key.Right, Command
PagerScrollRight)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'k'), Command
PagerUp)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'j'), Command
PagerDown)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'h'), Command
PagerScrollLeft)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'l'), Command
PagerScrollRight)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'u') Chord -> Mod -> Chord
`Key.withModifier` Mod
Key.Ctrl, Command
PagerHalfPageUp)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'd') Chord -> Mod -> Chord
`Key.withModifier` Mod
Key.Ctrl, Command
PagerHalfPageDown)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'b') Chord -> Mod -> Chord
`Key.withModifier` Mod
Key.Ctrl, Command
PagerPageUp)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'f') Chord -> Mod -> Chord
`Key.withModifier` Mod
Key.Ctrl, Command
PagerPageDown)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'f'), Command
DisplayPagerOnly)
, (Key -> Chord
Key.key Key
Key.Tab, Command
SplitFocusResults)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'q'), Command
DisplayResultsOnly) ]
, _globalKeybindings :: KeybindingMap
_globalKeybindings = [(Chord, Command)] -> KeybindingMap
KeybindingMap.fromList
[ (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'e'), Command
OpenFileInEditor)
, (Key -> Chord
Key.key (Char -> Key
Key.Char Char
'q'), Command
Exit) ]
}
loadConfig
:: MonadIO io
=> ConfigMonoid
-> io Config
loadConfig :: ConfigMonoid -> io Config
loadConfig ConfigMonoid
configFromArgs = do
[ConfigMonoid]
configs <- [io ConfigMonoid] -> io [ConfigMonoid]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ ConfigMonoid -> io ConfigMonoid
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigMonoid
configFromArgs
, io ConfigMonoid
forall (io :: * -> *). MonadIO io => io ConfigMonoid
configFromFile
, io ConfigMonoid
forall (io :: * -> *). MonadIO io => io ConfigMonoid
editorConfigFromEnv ]
Config -> io Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConfigMonoid -> Config
fromConfigMonoid ([ConfigMonoid] -> ConfigMonoid
forall a. Monoid a => [a] -> a
mconcat [ConfigMonoid]
configs))