hindent 3.8 → 3.9

raw patch · 10 files changed

+194/−41 lines, 10 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• elisp/hindent.el +9/−0
• hindent.cabal +2/−2
• src/HIndent.hs +6/−5
• src/HIndent/Pretty.hs +10/−7
• src/HIndent/Styles/ChrisDone.hs +2/−2
• src/HIndent/Styles/Gibiansky.hs +147/−20
• src/HIndent/Styles/JohanTibell.hs +2/−2
• src/HIndent/Types.hs +8/−1
• src/main/Main.hs +5/−2
• test/Spec.hs +3/−0

@@ -2,6 +2,10 @@  ;; Copyright (c) 2014 Chris Done. All rights reserved. +;; Author: Chris Done <chrisdone@gmail.com>+;; URL: https://github.com/chrisdone/hindent+;; Package-Requires: ((cl-lib "0.5"))+ ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option)@@ -17,12 +21,15 @@  ;;; Code: +(require 'cl-lib)+ (defcustom hindent-style   "fundamental"   "The style to use for formatting."   :group 'haskell   :type 'string) +;;;###autoload (defun hindent/reformat-decl ()   "Re-format the current declaration by parsing and pretty   printing it. Comments are preserved, although placement may be@@ -145,3 +152,5 @@                               (looking-at "{-# "))))))  (provide 'hindent)++;;; hindent.el ends here

@@ -1,5 +1,5 @@ name:                hindent-version:             3.8+version:             3.9 synopsis:            Extensible Haskell pretty printer description:         Extensible Haskell pretty printer. Both a library and an executable.                      .@@ -7,7 +7,7 @@ license:             BSD3 stability:           Unstable license-file:        LICENSE-author:              Chris Done+author:              Chris Done, Andrew Gibiansky, Tobias Pflug, Pierre Radermecker maintainer:          chrisdone@gmail.com copyright:           2014 Chris Done category:            Development

@@ -22,10 +22,10 @@   where  import           HIndent.Pretty-import           HIndent.Styles.ChrisDone-import           HIndent.Styles.Fundamental-import           HIndent.Styles.Gibiansky-import           HIndent.Styles.JohanTibell+import           HIndent.Styles.ChrisDone (chrisDone)+import           HIndent.Styles.Fundamental (fundamental)+import           HIndent.Styles.Gibiansky (gibiansky)+import           HIndent.Styles.JohanTibell (johanTibell) import           HIndent.Types  import           Control.Monad.State.Strict@@ -40,6 +40,7 @@ import qualified Data.Text.Lazy.IO as T import           Data.Traversable import           Language.Haskell.Exts.Annotated hiding (Style,prettyPrint,Pretty,style,parse)+import           Data.Maybe (fromMaybe)  -- | Format the given source. reformat :: Style -> Text -> Either String Builder@@ -48,7 +49,7 @@                                (T.unpack x) of     ParseOk (mod,comments) ->       let (cs,ast) =-            annotateComments mod comments+            annotateComments (fromMaybe mod $ applyFixities baseFixities mod) comments       in Right (prettyPrint                   style                   -- For the time being, assume that all "free-floating" comments come at the beginning.

@@ -113,8 +113,7 @@ -- | Pretty print a comment. printComment :: Maybe SrcSpan -> ComInfo -> Printer () printComment mayNodespan (ComInfo (Comment inline cspan str) own) =-  do col <- getColumn-     when own newline+  do when own newline      -- Insert proper amount of space before comment.      -- This maintains alignment. This cannot force comments      -- to go before the left-most possible indent (specified by depends).@@ -278,8 +277,12 @@   do eol <- gets psEolComment      when (eol && x /= "\n") newline      state <- get-     let out =-           if psNewline state+     let clearEmpty =+           configClearEmptyLines (psConfig state)+         writingNewline = x == "\n"+         out =+           if psNewline state &&+              not (clearEmpty && writingNewline)               then T.fromText                      (T.replicate (fromIntegral (psIndentLevel state))                                   " ") <>@@ -1108,9 +1111,9 @@         do case mayModHead of              Nothing -> return ()              Just modHead -> pretty' modHead-           forM_ pragmas pretty-           forM_ imps pretty-           forM_ decls pretty+           inter newline (map pretty pragmas)+           inter newline (map pretty imps)+           inter newline (map pretty decls)       XmlPage{} ->         error "FIXME: No implementation for XmlPage."       XmlHybrid{} ->

@@ -50,8 +50,8 @@            ,Extender stmt            ,Extender decl]         ,styleDefConfig =-           Config {configMaxColumns = 80-                  ,configIndentSpaces = 2}}+           defaultConfig {configMaxColumns = 80+                         ,configIndentSpaces = 2}}  -------------------------------------------------------------------------------- -- Extenders

@@ -3,8 +3,9 @@ module HIndent.Styles.Gibiansky (gibiansky) where  import Data.Foldable-import Control.Monad (unless, when)+import Control.Monad (unless, when, replicateM_, void) import Control.Monad.State (gets, get, put)+import Debug.Trace  import HIndent.Pretty import HIndent.Types@@ -34,11 +35,36 @@                            , Extender guardedAlts                            ]         , styleDefConfig =-           Config { configMaxColumns = 100-                  , configIndentSpaces = 2-                  }+           defaultConfig { configMaxColumns = maxColumns+                         , configIndentSpaces = indentSpaces+                         , configClearEmptyLines =  True+                         }         } +-- | Number of spaces to indent by.+indentSpaces :: Integral a => a+indentSpaces = 2++-- | Printer to indent one level.+indentOnce :: Printer ()+indentOnce = replicateM_ indentSpaces $ write " "++-- | Max number of columns per line.+maxColumns :: Integral a => a+maxColumns = 100++attemptSingleLine :: Printer a -> Printer a -> Printer ()+attemptSingleLine single multiple = do+  -- Try printing on one line.+  prevState <- get+  void single++  --  If it doesn't fit, reprint on multiple lines.+  col <- getColumn+  when (col > maxColumns) $ do+    put prevState+    void multiple+ -------------------------------------------------------------------------------- -- Extenders @@ -134,6 +160,9 @@ exprs _ exp@App{} = appExpr exp exprs _ exp@Do{} = doExpr exp exprs _ exp@List{} = listExpr exp+exprs _ exp@(InfixApp _ _ (QVarOp _ (UnQual _ (Symbol _ "$"))) _) = dollarExpr exp+exprs _ exp@(InfixApp _ _ (QVarOp _ (UnQual _ (Symbol _ "<*>"))) _) = applicativeExpr exp+exprs _ exp@Lambda{} = lambdaExpr exp exprs _ exp = prettyNoExt exp  letExpr :: Exp NodeInfo -> Printer ()@@ -160,16 +189,7 @@ doExpr _ = error "Not a do"  listExpr :: Exp NodeInfo -> Printer ()-listExpr (List _ els) = do-  -- Try printing list on one line.-  prevState <- get-  singleLineList els--  --  If it doesn't fit, reprint on multiple lines.-  col <- getColumn-  when (col > configMaxColumns (psConfig prevState)) $ do-    put prevState-    multiLineList els+listExpr (List _ els) = attemptSingleLine (singleLineList els) (multiLineList els) listExpr _ = error "Not a list"  singleLineList :: [Exp NodeInfo] -> Printer ()@@ -192,6 +212,82 @@     newline     write "]" +dollarExpr :: Exp NodeInfo -> Printer ()+dollarExpr (InfixApp _ left op right) = do+  pretty left+  write " "+  pretty op+  if needsNewline right+    then do+      newline+      depend indentOnce $ pretty right+    else do+      write " "+      pretty right+  where+    needsNewline Case{} = True+    needsNewline _ = False+dollarExpr _ = error "Not an application"++applicativeExpr :: Exp NodeInfo -> Printer ()+applicativeExpr exp@InfixApp{} =+  case applicativeArgs of+    Just (first:second:rest) ->+      attemptSingleLine (singleLine first second rest) (multiLine first second rest)+    _ -> prettyNoExt exp+  where+    singleLine :: Exp NodeInfo -> Exp NodeInfo -> [Exp NodeInfo] -> Printer ()+    singleLine first second rest = spaced+      [ pretty first+      , write "<$>"+      , pretty second+      , write "<*>"+      , inter (write " <*> ") $ map pretty rest+      ]++    multiLine :: Exp NodeInfo -> Exp NodeInfo -> [Exp NodeInfo] -> Printer ()+    multiLine first second rest = do+      pretty first+      depend (write " ") $ do+        write "<$> "+        pretty second+        forM_ rest $ \val -> do+          newline+          write "<*> "+          pretty val++    applicativeArgs :: Maybe [Exp NodeInfo]+    applicativeArgs = collectApplicativeExps exp++    collectApplicativeExps :: Exp NodeInfo -> Maybe [Exp NodeInfo]+    collectApplicativeExps (InfixApp _ left op right)+      | isFmap op = return [left, right]+      | isAp op = do+          start <- collectApplicativeExps left+          return $ start ++ [right]+      | otherwise = Nothing+    collectApplicativeExps x = return [x]++    isFmap :: QOp NodeInfo -> Bool+    isFmap (QVarOp _ (UnQual _ (Symbol _ "<$>"))) = True+    isFmap _ = False++    isAp :: QOp NodeInfo -> Bool+    isAp (QVarOp _ (UnQual _ (Symbol _ "<*>"))) = True+    isAp _ = False+applicativeExpr _ = error "Not an application"++lambdaExpr :: Exp NodeInfo -> Printer ()+lambdaExpr (Lambda _ pats exp) = do+  write "\\"+  spaced $ map pretty pats+  write " ->"+  attemptSingleLine (write " " >> pretty exp) $ do+    newline+    indentOnce+    pretty exp+lambdaExpr _ = error "Not a lambda"+ rhss :: Extend Rhs rhss _ (UnGuardedRhs _ exp) = do   write " = "@@ -219,19 +315,50 @@    forM_ mayDeriving $ \deriv -> do     newline-    indented 2 $ pretty deriv-decls _ (PatBind _ pat Nothing rhs mbinds) = do-  pretty pat+    indented indentSpaces $ pretty deriv++decls _ (PatBind _ pat Nothing rhs mbinds) = funBody [pat] rhs mbinds+decls _ (FunBind _ matches) = +  forM_ matches $ \match -> do++    (name, pat, rhs, mbinds) <- +      case match of+        Match _ name pat rhs mbinds -> return (name, pat, rhs, mbinds)+        InfixMatch _ left name pat rhs mbinds -> do+          pretty left+          write " "+          return (name, pat, rhs, mbinds)++    pretty name+    write " "+    funBody pat rhs mbinds+decls _ decl = prettyNoExt decl++funBody :: [Pat NodeInfo] -> Rhs NodeInfo -> Maybe (Binds NodeInfo) -> Printer ()+funBody pat rhs mbinds = do+  spaced $ map pretty pat   pretty rhs-  indentSpaces <- getIndentSpaces++  -- Process the binding group, if it exists.   forM_ mbinds $ \binds -> do     newline+    -- Add an extra newline after do blocks.     when (isDoBlock rhs) newline     indented indentSpaces $ do       write "where"       newline-      indented indentSpaces $ pretty binds-decls _ decl = prettyNoExt decl+      indented indentSpaces $ writeWhereBinds binds++writeWhereBinds :: Binds NodeInfo -> Printer ()+writeWhereBinds (BDecls _ binds@(first:rest)) = do+  pretty first+  forM_ (zip binds rest) $ \(prev, cur) -> do+    let prevLine = srcSpanEndLine . srcInfoSpan . nodeInfoSpan . ann $ prev+        curLine = startLine . nodeInfoSpan . ann $ cur+        emptyLines = curLine - prevLine+    replicateM_ (traceShowId emptyLines) newline+    pretty cur+writeWhereBinds binds = prettyNoExt binds  isDoBlock :: Rhs l -> Bool isDoBlock (UnGuardedRhs _ Do{}) = True

@@ -53,8 +53,8 @@            ,Extender alts            ,Extender guardedAlt]         ,styleDefConfig =-           Config {configMaxColumns = 80-                  ,configIndentSpaces = 4}}+           defaultConfig {configMaxColumns = 80+                         ,configIndentSpaces = 4}}  -------------------------------------------------------------------------------- -- Extenders

@@ -12,6 +12,7 @@   ,Extender(..)   ,Style(..)   ,Config(..)+  ,defaultConfig   ,NodeInfo(..)   ,ComInfo(..))   where@@ -70,12 +71,18 @@ data Config =   Config {configMaxColumns :: !Int64 -- ^ Maximum columns to fit code into ideally.          ,configIndentSpaces :: !Int64 -- ^ How many spaces to indent?+         ,configClearEmptyLines :: !Bool  -- ^ Remove spaces on lines that are otherwise empty?          }  instance Default Config where   def =     Config {configMaxColumns = 80-           ,configIndentSpaces = 2}+           ,configIndentSpaces = 2+           ,configClearEmptyLines = False}++-- | Default style configuration.+defaultConfig :: Config+defaultConfig = def  -- | Information for each node in the AST. data NodeInfo =

@@ -5,12 +5,14 @@  module Main where +import           HIndent+ import           Data.List import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as T import qualified Data.Text.Lazy.IO as T-import           HIndent-import           HIndent.Types+import           Data.Version (showVersion)+import           Paths_hindent (version) import           System.Environment  -- | Main entry point.@@ -22,6 +24,7 @@          T.interact            (either error T.toLazyText .             reformat style)+       ["--version"] -> putStrLn $ "hindent " ++ showVersion version        _ ->          error ("arguments: --style [" ++                 intercalate "|"

@@ -43,6 +43,8 @@   expContents <- readFile exp   let testDecls = parsePieces testContents       expDecls = parsePieces expContents+  when (length testDecls /= length expDecls) $+    error $ "Mismatched number of pieces in files " ++ test ++ " and " ++ exp   return $ describe ("hindent applied to chunks in " ++ test) $ foldl1 (>>) $ zipWith (mkSpec style) testDecls expDecls  mkSpec :: HIndent.Style -> String -> String -> Spec@@ -64,4 +66,5 @@        (nonNull, _:rest) -> (map fst nonNull, map fst rest)      pieceBreak :: (String, String) -> Bool+    pieceBreak ("", "") = error "Two consecutive line breaks!"     pieceBreak (line, next) = null line && head next /= ' '