structured-haskell-mode 1.0.4 → 1.0.6
raw patch · 10 files changed
+200/−64 lines, 10 filesdep +descriptivedep +text
Dependencies added: descriptive, text
Files
- elisp/shm-ast.el +38/−14
- elisp/shm-fold.el +4/−0
- elisp/shm-indent.el +9/−3
- elisp/shm-insert-del.el +12/−6
- elisp/shm-layout.el +11/−9
- elisp/shm-manipulation.el +4/−0
- elisp/shm-overlays.el +4/−0
- elisp/shm-slot.el +16/−0
- src/Main.hs +97/−29
- structured-haskell-mode.cabal +5/−3
elisp/shm-ast.el view
@@ -316,25 +316,44 @@ haskell-interactive-mode-prompt-start (line-end-position)))) ;; Don't activate if we're doing a GHCi command.- (unless (string-match "^:" whole-line)- (cons haskell-interactive-mode-prompt-start- (line-end-position)))))))- )))+ (unless (and (string-match "^:" whole-line)+ (not (string-match "^:t[^ ]* " whole-line))+ (not (string-match "^:k[^ ]* " whole-line)))+ (cons (save-excursion+ (goto-char haskell-interactive-mode-prompt-start)+ (when (looking-at ":[kt][^ ]* ")+ (search-forward " " (point-max) t 1))+ (point))+ (line-end-position)))))))))) ;; Otherwise we just do our line-based hack. (t (save-excursion- (let ((start (or (progn (goto-char (line-end-position))- (search-backward-regexp "^[^ \n]" nil t 1)- (unless (or (looking-at "^-}$")- (looking-at "^{-$"))- (point)))+ (let ((start (or (flet+ ((jump ()+ (search-backward-regexp "^[^ \n]" nil t 1)+ (cond+ ((save-excursion (goto-char (line-beginning-position))+ (looking-at "|]"))+ (jump))+ (t (unless (or (looking-at "^-}$")+ (looking-at "^{-$"))+ (point))))))+ (goto-char (line-end-position))+ (jump)) 0)) (end (progn (goto-char (1+ (point)))- (or (when (search-forward-regexp "[\n]+[^ \n]" nil t 1)- (forward-char -1)- (search-backward-regexp "[^\n ]" nil t)- (forward-char)- (point))+ (or (flet+ ((jump ()+ (when (search-forward-regexp "[\n]+[^ \n]" nil t 1)+ (cond+ ((save-excursion (goto-char (line-beginning-position))+ (looking-at "|]"))+ (jump))+ (t (forward-char -1)+ (search-backward-regexp "[^\n ]" nil t)+ (forward-char)+ (point))))))+ (jump)) (point-max))))) (cons start end)))))) @@ -628,3 +647,8 @@ (shm-node-string (shm-current-node))) (provide 'shm-ast)++;; Local variables:+;; byte-compile-warnings: (not cl-functions)+;; byte-compile-warnings: (not cl-macros)+;; End:
elisp/shm-fold.el view
@@ -68,3 +68,7 @@ (+ (point) 1)))) (provide 'shm-fold)++;; Local variables:+;; byte-compile-warnings: (not cl-functions)+;; End:
elisp/shm-indent.el view
@@ -144,8 +144,14 @@ with it." (interactive) (cond- ((not (shm-current-node))- (shm/simple-indent))+ ((or (= (line-beginning-position)+ (line-end-position))+ (not (shm-current-node)))+ (if (= (line-beginning-position)+ (line-end-position))+ (newline)+ (progn (newline)+ (shm/simple-indent)))) ((and (shm-in-string) (not (= (shm-node-start (shm-current-node)) (point))))@@ -336,7 +342,7 @@ (eq 'Lambda (shm-node-cons parent))) (cond ((eq shm-lambda-indent-style 'leftmost-parent)- (let ((leftmost-parent (cdr (shm-find-furthest-parent-on-line parent-pair))))+ (let ((leftmost-parent (cdr (shm-find-furthest-parent-on-line parent-pair t)))) (shm-newline) (indent-to (+ (shm-indent-spaces) (shm-node-indent-column leftmost-parent)))))
elisp/shm-insert-del.el view
@@ -29,14 +29,14 @@ (forward-char -1) (shm-adjust-dependents (point) 1))) -(defun shm/wrap-parens ()+(defun shm/wrap-parens (&optional current) "Wrap the node in parentheses." (interactive) (cond ((region-active-p) (shm-wrap-delimiters "(" ")")) (t (let ((line (line-number-at-pos))- (node (shm-current-node)))+ (node (or current (shm-current-node)))) (save-excursion (goto-char (shm-node-start node)) (insert "(")@@ -62,6 +62,8 @@ (insert " ")) (shm-auto-insert-skeletons (cond+ ((looking-back "[[ (,]\\\\")+ (shm-auto-insert-lambda)) ((and (looking-back "[^a-zA-Z0-9_]do") (shm-nothing-following-p)) (shm-auto-insert-do))@@ -473,7 +475,7 @@ (let ((current (shm-actual-node))) (cond ((shm-find-overlay 'shm-quarantine)- (if (not (or (looking-back "[ ,[({\\]")+ (if (not (or (looking-back "[ ,[({\\!]") (and (looking-back "\\$") (string= "(" open)) (bolp)))@@ -483,11 +485,11 @@ (let ((point (point))) (shm-insert-string close) (when (and (/= (point) (line-end-position))- (not (looking-at "[]){} ,]")))+ (not (looking-at "[]){} ,\\]"))) (shm-insert-string " ")) (goto-char point))) (t- (if (not (or (looking-back "[ ,[({]")+ (if (not (or (looking-back "[ ,[({!\\]") (bolp))) (progn (shm-insert-string " ") 1) 0)@@ -495,7 +497,7 @@ (let ((point (point))) (shm-insert-string close) (when (and (/= (point) (line-end-position))- (not (looking-at "[]){} ,]")))+ (not (looking-at "[]){} ,!]"))) (shm-insert-string " ")) (goto-char point) (shm/init t))))))))@@ -565,3 +567,7 @@ (insert name)))) (provide 'shm-insert-del)++;; Local variables:+;; byte-compile-warnings: (not cl-functions)+;; End:
elisp/shm-layout.el view
@@ -210,19 +210,21 @@ (push-mark) (goto-char start)))) -(defun shm-find-furthest-parent-on-line (current)+(defun shm-find-furthest-parent-on-line (current &optional stop-at-rhs) "Find the parent which starts nearest to column 0 on the current line. This is used when indenting dangling expressions."- (let ((parent (shm-node-parent current)))- (if parent- (if (= (line-beginning-position)- (save-excursion (goto-char (shm-node-start (cdr parent)))- (line-beginning-position)))- (shm-find-furthest-parent-on-line parent)- current)- current)))+ (if (string= (shm-node-type-name (cdr current)) "Decl")+ current+ (let ((parent (shm-node-parent current)))+ (if parent+ (if (= (line-beginning-position)+ (save-excursion (goto-char (shm-node-start (cdr parent)))+ (line-beginning-position)))+ (shm-find-furthest-parent-on-line parent stop-at-rhs)+ current)+ current)))) (defun shm-indent-spaces () "Get the number of spaces to indent."
elisp/shm-manipulation.el view
@@ -59,6 +59,10 @@ (shm-insert-string (concat " " qop " "))) (t (error "Please go to the start or end of the node to indicate direction.")))) (t (error "Unable to figure out the operator.")))))+ ((string= "Type" (shm-node-type-name current))+ (if (= (point) (shm-node-start current))+ (save-excursion (insert " -> "))+ (insert " -> "))) (t (error "Not in an infix application."))))) (defun shm/raise ()
elisp/shm-overlays.el view
@@ -61,3 +61,7 @@ (overlays-in (point-min) (point-max)))) (provide 'shm-overlays)++;; Local variables:+;; byte-compile-warnings: (not cl-functions)+;; End:
elisp/shm-slot.el view
@@ -68,6 +68,17 @@ (shm-insert-string "_") (shm-evaporate point (point))))) +(defun shm-auto-insert-lambda ()+ "Insert template++\_ -> undefined+"+ (save-excursion+ (shm/insert-underscore)+ (forward-char)+ (insert " -> ")+ (shm/insert-undefined)))+ (defun shm-auto-insert-do () "Insert template @@ -199,3 +210,8 @@ (forward-char -1)) (provide 'shm-slot)++;; Local variables:+;; byte-compile-warnings: (not cl-functions)+;; byte-compile-warnings: (not cl-macros)+;; End:
src/Main.hs view
@@ -1,18 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ExistentialQuantification #-} -{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-signatures -fno-warn-type-defaults #-} -- | Take in Haskell code and output a vector of source spans and -- their associated node type and case. module Main (main) where -import Control.Applicative-import Data.Data-import Data.Maybe-import Language.Haskell.Exts.Annotated-import System.Environment+import Control.Applicative+import Data.Data+import Data.List+import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T+import Descriptive+import Descriptive.Options+import Language.Haskell.Exts.Annotated+import System.Environment -- | A generic Dynamic-like constructor -- but more convenient to -- write and pattern match on.@@ -34,34 +41,59 @@ --- | Main entry point. main :: IO ()-main = do- code <- getContents- action:typ:_ <- getArgs- outputWith action typ code+main =+ do code <- getContents+ args <- getArgs+ case consume options (map T.pack args) of+ (Right (action,typ,exts),_) ->+ outputWith action typ exts code+ (Left _err,_) ->+ error (T.unpack (textDescription (fst (describe options [])))) +-- | Action to perform.+data Action = Parse | Check++-- | Thing to parse.+data ParseType = Decl | Stmt++-- | Command line options.+options :: Consumer [Text] Option (Action,ParseType,[Extension])+options = (,,) <$> action <*> typ <*> exts+ where action =+ sumConstant Parse "parse" <|>+ sumConstant Check "check"+ typ =+ sumConstant Decl "decl" <|>+ sumConstant Stmt "stmt"+ sumConstant sum' text =+ fmap (const sum')+ (constant text)+ exts =+ fmap getExtensions+ (many (prefix "X" "Language extension"))+ -- | Output some result with the given action (check/parse/etc.), -- parsing the given type of AST node. In the past, the type was any -- kind of AST node. Today, it's just a "decl" which is covered by -- 'parseTopLevel'.-outputWith :: String -> String -> String -> IO ()-outputWith action typ code =+outputWith :: Action -> ParseType -> [Extension] -> String -> IO ()+outputWith action typ exts code = case typ of- "decl" ->- output action parseTopLevel code- "stmt" ->- output action parseSomeStmt code- _ -> error "Unknown parser type."+ Decl -> output action parseTopLevel exts code+ Stmt -> output action parseSomeStmt exts code -- | Output AST info for the given Haskell code.-output :: String -> Parser -> String -> IO ()-output action parser code =- case parser parseMode code of+output :: Action -> Parser -> [Extension] -> String -> IO ()+output action parser exts code =+ case parser parseMode {extensions = exts} code of ParseFailed _ e -> error e ParseOk (D ast) -> case action of- "check" -> return ()- "parse" -> putStrLn ("[" ++ concat (genHSE ast) ++ "]")- _ -> error "unknown action"+ Check -> return ()+ Parse ->+ putStrLn ("[" +++ concat (genHSE ast) +++ "]") -- | An umbrella parser to parse: --@@ -87,17 +119,14 @@ D . fix <$> parseExpWithMode mode code <|> D <$> parseImport mode code +-- | Apply fixities after parsing. fix ast = fromMaybe ast (applyFixities baseFixities ast) -- | Parse mode, includes all extensions, doesn't assume any fixities. parseMode :: ParseMode parseMode =- defaultParseMode { extensions = allExtensions- , fixities = Nothing- }- where allExtensions = filter isDisabledExtention knownExtensions- isDisabledExtention (DisableExtension _) = False- isDisabledExtention _ = True+ defaultParseMode {extensions = defaultExtensions+ ,fixities = Nothing} -- | Generate a list of spans from the HSE AST. genHSE :: Data a => a -> [String]@@ -183,3 +212,42 @@ ParseOk (Module _ _ [p] _ _) -> return p ParseOk _ -> ParseFailed noLoc "parseModulePragma" ParseFailed x y -> ParseFailed x y++--------------------------------------------------------------------------------+-- Extensions stuff stolen from hlint++-- | Consume an extensions list from arguments.+getExtensions :: [Text] -> [Extension]+getExtensions = foldl f defaultExtensions . map T.unpack+ where f _ "Haskell98" = []+ f a ('N':'o':x)+ | Just x' <- readExtension x =+ delete x' a+ f a x+ | Just x' <- readExtension x =+ x' :+ delete x' a+ f _ x = error $ "Unknown extension: " ++ x++-- | Parse an extension.+readExtension :: String -> Maybe Extension+readExtension x =+ case classifyExtension x of+ UnknownExtension _ -> Nothing+ x' -> Just x'++-- | Default extensions.+defaultExtensions :: [Extension]+defaultExtensions =+ [e | e@EnableExtension{} <- knownExtensions] \\+ map EnableExtension badExtensions++-- | Extensions which steal too much syntax.+badExtensions :: [KnownExtension]+badExtensions =+ [Arrows -- steals proc+ ,TransformListComp -- steals the group keyword+ ,XmlSyntax, RegularPatterns -- steals a-b+ ,UnboxedTuples -- breaks (#) lens operator+ ,QuasiQuotes -- breaks [x| ...], making whitespace free list comps break+ ]
structured-haskell-mode.cabal view
@@ -1,5 +1,5 @@ name: structured-haskell-mode-version: 1.0.4+version: 1.0.6 synopsis: Structured editing Emacs mode for Haskell description: Structured editing Emacs mode for Haskell. homepage: https://github.com/chrisdone/structured-haskell-mode@@ -41,5 +41,7 @@ main-is: Main.hs ghc-options: -O2 -Wall hs-source-dirs: src- build-depends: base >= 4 && < 5,- haskell-src-exts == 1.15.*+ build-depends: base >= 4 && < 5+ , haskell-src-exts == 1.15.*+ , text+ , descriptive == 0.0.*