My custom yi.hs below, which I release into the public domain, applies
the f (g x) --> f $ g x code transformation (which I call "dollarify")
to the parenthesised expression at the point, or the selected syntax
tree node (e.g. select a do block and it will try to dollarify each
line).
It also turns ((foo bar)) into (foo bar) (i.e. removes redundant
parentheses).
The transformation runs when modePrettify is called in the haskell
mode (for emacs keybindings, that's M-q). Feel free to copy all or
part of it.
Known problems:
==========
* It does a conservative scan and probably misses expressions inside
ifs and things like that. I avoided using the precise Haskell mode
because it's experimental.
* It doesn't understand the difference between types and values, so it
will blindly dollarify types
* It doesn't know when GHC will reject the dollarify transformation (I
know this still happens with some uses of Data.Generics, probably due
to non-Haskell-98 types). So it's the responsibility of the user to
know where it cannot be used.
There are probably more bugs. Comments/patches welcome.
{-# LANGUAGE PatternGuards #-}
import Control.Applicative ((<*>), (<$>))
import Data.List (sortBy)
import Data.Maybe (fromMaybe)
import Yi hiding (Block)
-- Preamble
import Yi.Prelude
import Prelude (filter, maybe, reverse, takeWhile, uncurry)
import Yi.Buffer.HighLevel (getSelectRegionB, nextPointB)
-- Import the desired keymap "template":
import Yi.Keymap.Emacs (keymap)
-- import Yi.Keymap.Cua (keymap)
-- import Yi.Keymap.Vim (keymap)
import Yi.Lexer.Alex (posnOfs, Tok(..))
import Yi.Lexer.Haskell (isComment, TT, Token(..))
import Yi.Mode.Haskell
import Yi.Syntax.Paren (Expr, Tree(..))
import Yi.Syntax.Tree (getAllSubTrees, getFirstOffset, getLastOffset,
getLastPath)
import Yi.UI.Vty (start)
-- import Yi.UI.Gtk (start)
-- import Yi.UI.Cocoa (start)
-- import Yi.UI.Pango (start)
myConfig = defaultEmacsConfig -- replace with defaultVimConfig or
defaultCuaConfig
defaultUIConfig = configUI myConfig
-- Change the below to your needs, following the explanation in
comments. See
-- module Yi.Config for more information on configuration. Other
configuration
-- examples can be found in the examples directory. You can also use
or copy
-- another user configuration, which can be found in modules
Yi.Users.*
myHaskellMode = cleverMode { modePrettify = (>>) . modePrettify
cleverMode <*> dollarify }
dollarify :: Expr TT -> BufferM ()
dollarify e = maybe (return ()) dollarifyWithin . selectedTree e =<<
getSelectRegionB
dollarifyWithin :: Tree TT -> BufferM ()
dollarifyWithin = trace . ("dollarifyWithin: " ++) . show <*> runQ .
(dollarifyTop =<<) . getAllSubTrees
data QueuedUpdate = QueuedUpdate { qUpdatePoint :: Point
, qInsert :: String
, qDelete :: Int
} deriving (Eq, Ord)
runQ :: [QueuedUpdate] -> BufferM ()
runQ = mapM_ run1Q . sortBy (flip compare)
where
run1Q :: QueuedUpdate -> BufferM ()
run1Q (QueuedUpdate { qUpdatePoint = p, qInsert = i, qDelete =
d })
= do
deleteNAt Forward d p
when (not $ null i) $ insertNAt i p
openParen = Special '('
closeParen = Special ')'
isNormalParen :: Tree TT -> Bool
isNormalParen (Paren t1 _ t2) = tokT t1 == openParen && tokT t2 ==
closeParen
isNormalParen _ = False
-- Assumes length of token is one character
queueDelete :: TT -> QueuedUpdate
queueDelete = queueReplaceWith ""
-- Assumes length of token is one character
queueReplaceWith :: String -> TT -> QueuedUpdate
queueReplaceWith s t = QueuedUpdate { qUpdatePoint = posnOfs $ tokPosn
t
, qInsert = s
, qDelete = 1
}
-- Only strips comments from the top level
stripComments :: Expr TT -> Expr TT
stripComments = filter $ \t -> case t of { (Atom x) -> not (isComment
$ tokT x); _ -> True }
dollarifyTop :: Tree TT -> [QueuedUpdate]
dollarifyTop p@(Paren t1 e t2)
| isNormalParen p = case stripComments e of
[Paren _ _ _] -> [queueDelete t2, queueDelete t1]
e' -> dollarifyExpr e'
dollarifyTop (Block bList) = dollarifyExpr . stripComments =<< toList
bList
dollarifyTop _ = []
-- Expression must not contain comments
dollarifyExpr :: Expr TT -> [QueuedUpdate]
dollarifyExpr e@(_:_) | p@(Paren t e t2) <- last e
, isNormalParen p
, isCollapsible e
, all isSimple e
= [queueDelete t2, queueReplaceWith "$ " t]
dollarifyExpr _ = []
isSimple :: Tree TT -> Bool
isSimple (Paren _ _ _) = True
isSimple (Block _) = False
isSimple (Atom t) = tokT t `elem` [Number, CharTok, StringTok,
VarIdent, ConsIdent]
isSimple _ = False
both :: (a -> b) -> a -> a -> (b, b)
both f x y = (f x, f y)
isCollapsible :: Expr TT -> Bool
isCollapsible = uncurry (&&) . (both isSimple . head <*> last) .
stripComments
selectedTree :: Expr TT -> Region -> Maybe (Tree TT)
selectedTree e r = findLargestWithin r <$> getLastPath e (regionLast
r)
-- List must be non-empty
findLargestWithin :: Region -> [Tree TT] -> Tree TT
findLargestWithin r = fromMaybe . head <*> safeLast . takeWhile
(within r)
within :: Region -> Tree TT -> Bool
within r t = includedRegion ((mkRegion . getFirstOffset <*>
getLastOffset) t) r
safeLast :: [a] -> Maybe a
safeLast [] = Nothing
safeLast s = return $ last s
main :: IO ()
main = yi $ myConfig
{
modeTable = AnyMode myHaskellMode : modeTable myConfig,
-- Keymap Configuration
defaultKm = defaultKm myConfig,
-- UI Configuration
-- Override the default UI as such:
startFrontEnd = startFrontEnd myConfig,
-- Yi.UI.Vty.start -- for Vty
-- (can be overridden at the command line)
-- Options:
configUI = defaultUIConfig
{
configFontSize = Nothing,
-- 'Just 10' for specifying the size.
configTheme = configTheme defaultUIConfig,
-- darkBlueTheme -- Change the color scheme
here.
configWindowFill = ' '
-- '~' -- Typical for Vim
}
}
--~--~---------~--~----~------------~-------~--~----~
Yi development mailing list
[email protected]
http://groups.google.com/group/yi-devel
-~----------~----~----~----~------~----~------~--~---
