File: Simple.hs

package info (click to toggle)
yi 0.7.1-5
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 7,532 kB
  • ctags: 1
  • sloc: haskell: 25,311; sh: 10; makefile: 9
file content (357 lines) | stat: -rw-r--r-- 12,487 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
{-# LANGUAGE Rank2Types, CPP, GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-} -- for good documentation, we want control over our export list, which occasionally gives us duplicate exports

{- | A simplified configuration interface for Yi. -}
module Yi.Config.Simple (
  -- $overview
  -- * The main interface
  ConfigM,
  configMain,
  Field,
  (%=),
  get,
  modify,
  -- * Frontend
  setFrontendPreferences,
  setFrontend,
  -- * Modes, commands, and keybindings
  globalBindKeys,
  modeBindKeys,
  modeBindKeysByName,
  addMode,
  modifyMode,
  modifyModeByName,
  -- * Evaluation of commands
  evaluator,
  ghciEvaluator,
  publishedActionsEvaluator,
  publishAction,
  publishedActions,
  -- * Appearance
  fontName,
  fontSize,
  scrollWheelAmount,
  scrollStyle,
  ScrollStyle(..),
  cursorStyle,
  CursorStyle(..),
  Side(..),
  scrollBarSide,
  autoHideScrollBar,
  autoHideTabBar,
  lineWrap,
  windowFill,
  theme,
  -- ** Layout
  layoutManagers,
  -- * Debugging
  debug,
  -- * Startup hooks
  runOnStartup,
  runAfterStartup,
  -- * Advanced
  -- $advanced
  startActions,
  initialActions,
  defaultKm,
  inputPreprocess,
  modes,
  regionStyle,
  killringAccumulate,
  bufferUpdateHandler,
  -- * Module exports
  -- we can't just export 'module Yi', because then we would get clashes with Yi.Config
  module Yi.Boot,
--  module Yi.Buffer.Misc,
  module Yi.Core,
  module Yi.Dired,
  module Yi.File,
  module Yi.Config,
  module Yi.Config.Default,
  module Yi.Layout,
  module Yi.Search,
  module Yi.Style,
  module Yi.Style.Library,
  module Yi.Misc,
  module Yi.Mode.Haskell,
#ifdef SCION
  module Yi.Scion,
#endif
 ) where

import Yi.Boot
--import Yi.Buffer.Misc hiding(modifyMode)
import Yi.Core hiding(modifyMode, (%=))
import Yi.Config.Default
import Yi.Config.Misc
import Yi.Config.Simple.Types
import Yi.Dired
import Yi.Eval
import Yi.File
import Yi.Layout
import Yi.Search
import Yi.Style
import Yi.Style.Library
import Yi.Misc
import Yi.Mode.Haskell
#ifdef SCION
import Yi.Scion
#endif

import Text.Printf(printf)
import Prelude hiding((.))

import Control.Monad.State hiding (modify, get)

-- we do explicit imports because we reuse a lot of the names
import Yi.Config(Config, UIConfig,
                 startFrontEndA, configUIA, startActionsA, initialActionsA, defaultKmA, 
                 configInputPreprocessA, modeTableA, debugModeA,
                 configRegionStyleA, configKillringAccumulateA, bufferUpdateHandlerA,
                 configVtyA, configFontNameA, configFontSizeA, configScrollWheelAmountA,
                 configScrollStyleA, configCursorStyleA, CursorStyle(..),
                 configLeftSideScrollBarA, configAutoHideScrollBarA, configAutoHideTabBarA,
                 configLineWrapA, configWindowFillA, configThemeA, layoutManagersA, configVarsA,
                )
import Data.Maybe(mapMaybe)

{- $overview
This module provides a simple configuration API, allowing users to start with an initial
configuration and imperatively (monadically) modify it. Some common actions (keybindings, 
selecting modes, choosing the frontend) have been given special commands ('globalBindKeys',
'setFrontendPreferences', 'addMode', and so on).

A simple configuration might look like the following:

@import Yi.Config.Simple
import qualified Yi.Mode.Haskell as Haskell
-- note: don't import "Yi", or else there will be name clashes

main = 'configMain' 'defaultEmacsConfig' $ do
  'setFrontendPreferences' ["pango", "vte", "vty"]
  'fontSize' '%=' 'Just' 10
  'modeBindKeys' Haskell.cleverMode ('metaCh' \'q\' '?>>!' 'reload')
  'globalBindKeys' ('metaCh' \'r\' '?>>!' 'reload')@

A lot of the fields here are specified with the 'Field' type. To write a field, use ('%='). To read, use 'get'. For modification, use ('modify'). For example, the functions @foo@ and @bar@ are equivalent:

@foo = 'modify' 'layoutManagers' 'reverse'
bar = do
 lms <- 'get' 'layoutManagers'
 'layoutManagers' '%=' 'reverse' lms@
-}



--------------- Main interface
-- newtype ConfigM a   (imported)

-- | Starts with the given initial config, makes the described modifications, then starts yi.
configMain :: Config -> ConfigM () -> IO ()
configMain c m = yi =<< execStateT (runConfigM m) c

-- type Field a (imported

-- | Set a field.
(%=) :: Field a -> a -> ConfigM ()
(%=) = putA

-- | Get a field.
get :: Field a -> ConfigM a
get = getA

-- | Modify a field.
modify :: Field a -> (a -> a) -> ConfigM ()
modify = modA


---------------------------------- Frontend
-- | Sets the frontend to the first frontend from the list which is installed.
--
-- Available frontends are a subset of: \"vte\", \"vty\", \"pango\", \"cocoa\", and \"batch\".
setFrontendPreferences :: [String] -> ConfigM ()
setFrontendPreferences fs = 
   case mapMaybe (\f -> lookup f availableFrontends) fs of
       (f:_) -> startFrontEndA %= f
       [] -> return ()

-- | Sets the frontend, if it is available.
setFrontend :: String -> ConfigM ()
setFrontend f = maybe (return ()) (startFrontEndA %=) (lookup f availableFrontends)

------------------------- Modes, commands, and keybindings
-- | Adds the given key bindings to the `global keymap'. The bindings will override existing bindings in the case of a clash.
globalBindKeys :: Keymap -> ConfigM ()
globalBindKeys a = modify (topKeymapA . defaultKmA) (||> a)

-- | @modeBindKeys mode keys@ adds the keybindings in @keys@ to all modes with the same name as @mode@.
--
-- As with 'modifyMode', a mode by the given name must already be registered, or the function will
-- have no effect, and issue a command-line warning.
modeBindKeys :: Mode syntax -> Keymap -> ConfigM ()
modeBindKeys mode keys = ensureModeRegistered "modeBindKeys" (modeName mode) $ modeBindKeysByName (modeName mode) keys

-- | @modeBindKeysByName name keys@ adds the keybindings in @keys@ to all modes with name @name@ (if it is registered). Consider using 'modeBindKeys' instead.
modeBindKeysByName :: String -> Keymap -> ConfigM ()
modeBindKeysByName name k = ensureModeRegistered "modeBindKeysByName" name $ modifyModeByName name (modeKeymapA ^: f) 
 where
  f :: (KeymapSet -> KeymapSet) -> (KeymapSet -> KeymapSet)
  f mkm km = topKeymapA ^: (||> k) $ mkm km
-- (modeKeymapA ^: ((topKeymap ^: (||> k)) .))

-- | Register the given mode. It will be preferred over any modes already defined.
addMode :: Mode syntax -> ConfigM ()
addMode m = modify modeTableA (AnyMode m :)

-- | @modifyMode mode f@ modifies all modes with the same name as @mode@, using the function @f@. 
--
-- Note that the @mode@ argument is only used by its 'modeName'. In particular, a mode by the given name
-- must already be registered, or this function will have no effect, and issue a command-line warning.
--
-- @'modifyMode' mode f = 'modifyModeByName' ('modeName' mode) f@
modifyMode :: Mode syntax -> (forall syntax'. Mode syntax' -> Mode syntax') -> ConfigM ()
modifyMode mode f = ensureModeRegistered "modifyMode" (modeName mode) $ modifyModeByName (modeName mode) f

-- | @modifyModeByName name f@ modifies the mode with name @name@ using the function @f@. Consider using 'modifyMode' instead.
modifyModeByName :: String -> (forall syntax. Mode syntax -> Mode syntax) -> ConfigM ()
modifyModeByName name f = ensureModeRegistered "modifyModeByName" name $ modify modeTableA (fmap (onMode g))
  where
      g :: forall syntax. Mode syntax -> Mode syntax
      g m | modeName m == name = f m
          | otherwise          = m

-- helper functions
warn :: String -> String -> ConfigM ()
warn caller msg = io $ putStrLn $ printf "Warning: %s: %s" caller msg
-- the putStrLn shouldn't be necessary, but it doesn't print anything if it's not there...

isModeRegistered :: String -> ConfigM Bool
isModeRegistered name = (Prelude.any (\(AnyMode mode) -> modeName mode == name)) <$> get modeTableA

-- ensure the given mode is registered, and if it is, then run the given action.
ensureModeRegistered :: String -> String -> ConfigM () -> ConfigM ()
ensureModeRegistered caller name m = do
  isRegistered <- isModeRegistered name
  if isRegistered
   then m
   else warn caller (printf "mode \"%s\" is not registered." name)   

--------------------- Appearance
-- | 'Just' the font name, or 'Nothing' for default.
fontName :: Field (Maybe String)
fontName = configFontNameA . configUIA

-- | 'Just' the font size, or 'Nothing' for default.
fontSize :: Field (Maybe Int)
fontSize = configFontSizeA . configUIA

-- | Amount to move the buffer when using the scroll wheel.
scrollWheelAmount :: Field Int
scrollWheelAmount = configScrollWheelAmountA . configUIA

-- | 'Just' the scroll style, or 'Nothing' for default.
scrollStyle :: Field (Maybe ScrollStyle)
scrollStyle = configScrollStyleA . configUIA

-- | See 'CursorStyle' for documentation.
cursorStyle :: Field CursorStyle
cursorStyle = configCursorStyleA . configUIA

data Side = LeftSide | RightSide

-- | Which side to display the scroll bar on.
scrollBarSide :: Field Side
scrollBarSide = fromBool . configLeftSideScrollBarA . configUIA 
  where
      fromBool :: Accessor Bool Side
      fromBool = accessor (\b -> if b then LeftSide else RightSide) (\s _ -> case s of { LeftSide -> True; RightSide -> False }) 

-- | Should the scroll bar autohide?
autoHideScrollBar :: Field Bool
autoHideScrollBar = configAutoHideScrollBarA . configUIA

-- | Should the tab bar autohide?
autoHideTabBar :: Field Bool
autoHideTabBar = configAutoHideTabBarA . configUIA

-- | Should lines be wrapped?
lineWrap :: Field Bool
lineWrap = configLineWrapA . configUIA

-- | The character with which to fill empty window space. Usually \'~\' for vi-like editors, \' \' for everything else.
windowFill :: Field Char
windowFill = configWindowFillA . configUIA

-- | UI colour theme.
theme :: Field Theme
theme = configThemeA . configUIA

---------- Layout
-- | List of registered layout managers. When cycling through layouts, this list will be consulted.
layoutManagers :: Field [AnyLayoutManager]
layoutManagers = layoutManagersA

------------------------ Debugging
-- | Produce a .yi.dbg file with debugging information?
debug :: Field Bool
debug = debugModeA

----------- Startup hooks
-- | Run when the editor is started (this is run after all actions which have already been registered)
runOnStartup :: Action -> ConfigM ()
runOnStartup action = runManyOnStartup [action]

-- | List version of 'runOnStartup'.
runManyOnStartup :: [Action] -> ConfigM ()
runManyOnStartup actions = modify startActions (++actions)

-- | Run after the startup actions have completed, or on reload (this is run after all actions which have already been registered)
runAfterStartup :: Action -> ConfigM ()
runAfterStartup action = runManyAfterStartup [action]

-- | List version of 'runAfterStartup'.
runManyAfterStartup :: [Action] -> ConfigM ()
runManyAfterStartup actions = modify initialActions (++actions)

------------------------ Advanced
{- $advanced

These fields are here for completeness -- that is, to expose all the functionality 
of the "Yi.Config" module. However, most users probably need not use these fields,
typically because they provide advanced functinality, or because a simpler interface
for the common case is available above.

-}

-- | Actions to run when the editor is started. Consider using 'runOnStartup' or 'runManyOnStartup' instead.
startActions :: Field [Action]
startActions = startActionsA

-- | Actions to run after startup or reload. Consider using 'runAfterStartup' or 'runManyAfterStartup' instead.
initialActions :: Field [Action]
initialActions = initialActionsA

-- | Default keymap to use.
defaultKm :: Field KeymapSet
defaultKm = defaultKmA

-- | ?
inputPreprocess :: Field (P Event Event)
inputPreprocess = configInputPreprocessA

-- | List of modes by order of preference. Consider using 'addMode', 'modeBindKeys', or 'modifyMode' instead.
modes :: Field [AnyMode]
modes = modeTableA

-- | Set to 'Exclusive' for an emacs-like behaviour. Consider starting with 'defaultEmacsConfig', 'defaultVimConfig', or 'defaultCuaConfig' to instead.
regionStyle :: Field RegionStyle
regionStyle = configRegionStyleA

-- | Set to 'True' for an emacs-like behaviour, where all deleted text is accumulated in a killring. Consider starting with 'defaultEmacsConfig', 'defaultVimConfig', or 'defaultCuaConfig' instead.
killringAccumulate :: Field Bool
killringAccumulate = configKillringAccumulateA

-- | ?
bufferUpdateHandler :: Field [[Update] -> BufferM ()]
bufferUpdateHandler = bufferUpdateHandlerA