hindent 4.4.2 → 4.5.0

raw patch · 19 files changed

+248/−75 lines, 19 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hindent.cabal +1/−1
• src/HIndent/Pretty.hs +17/−5
• src/HIndent/Styles/Gibiansky.hs +50/−15
• src/HIndent/Styles/JohanTibell.hs +55/−51
• test/gibiansky/expected/40.exp +3/−0
• test/gibiansky/expected/41.exp +35/−0
• test/gibiansky/expected/42.exp +4/−0
• test/gibiansky/expected/43.exp +8/−0
• test/gibiansky/expected/44.exp +3/−0
• test/gibiansky/tests/40.test +3/−0
• test/gibiansky/tests/41.test +7/−0
• test/gibiansky/tests/42.test +4/−0
• test/gibiansky/tests/43.test +7/−0
• test/gibiansky/tests/44.test +3/−0
• test/johan-tibell/expected/2.exp +3/−3
• test/johan-tibell/expected/6.exp +19/−0
• test/johan-tibell/expected/7.exp +8/−0
• test/johan-tibell/tests/6.test +15/−0
• test/johan-tibell/tests/7.test +3/−0

@@ -1,5 +1,5 @@ name:                hindent-version:             4.4.2+version:             4.5.0 synopsis:            Extensible Haskell pretty printer description:         Extensible Haskell pretty printer. Both a library and an executable.                      .

@@ -48,6 +48,7 @@   , depend   , dependBind   , swing+  , swingBy   , getIndentSpaces   , getColumnLimit   -- * Predicates@@ -422,6 +423,15 @@      indentSpaces <- getIndentSpaces      column (orig + indentSpaces) b +-- | Swing the second printer below and indented with respect to the first by+-- the specified amount.+swingBy :: MonadState (PrintState s) m => Int64 -> m () -> m b -> m b+swingBy i a b =+  do orig <- gets psIndentLevel+     a+     newline+     column (orig + i) b+ -------------------------------------------------------------------------------- -- * Instances @@ -721,11 +731,13 @@      newline      indented indentSpaces (lined (map (withCaseContext True . pretty) alts)) exp (MultiIf _ alts) =-  depend (write "if ")-         (lined (map (\p ->-                        do write "| "-                           pretty p)-                     alts))+  withCaseContext+    True+    (depend (write "if ")+            (lined (map (\p ->+                           do write "| "+                              pretty p)+                        alts))) exp (Lit _ lit) = prettyInternal lit exp x@XTag{} = pretty' x exp x@XETag{} = pretty' x

@@ -9,7 +9,7 @@ import           Data.List (unfoldr, isPrefixOf) import           Control.Monad.Trans.Maybe import           Data.Functor.Identity-import           Control.Monad.State.Strict hiding (state, State, forM_)+import           Control.Monad.State.Strict hiding (state, State, forM_, sequence_) import           Data.Typeable  import           HIndent.Pretty@@ -19,7 +19,7 @@ import           Language.Haskell.Exts.SrcLoc import           Language.Haskell.Exts.Pretty (prettyPrint) import           Language.Haskell.Exts.Comments-import           Prelude hiding (exp, all, mapM_, minimum, and, maximum, concatMap, or, any)+import           Prelude hiding (exp, all, mapM_, minimum, and, maximum, concatMap, or, any, sequence_)  -- | Empty state. data State = State { gibianskyForceSingleLine :: Bool, gibianskyLetBind :: Bool }@@ -581,7 +581,7 @@           start <- collectApplicativeExps left           return $ start ++ [right]       | otherwise = Nothing-    collectApplicativeExps x = return [x]+    collectApplicativeExps _ = Nothing      isFmap :: QOp NodeInfo -> Bool     isFmap (QVarOp _ (UnQual _ (Symbol _ "<$>"))) = True@@ -593,22 +593,54 @@ applicativeExpr _ = error "Not an application"  opExpr :: Exp NodeInfo -> Printer State ()-opExpr (InfixApp _ left op right) = keepingColumn $ do-  pretty left+opExpr expr@(InfixApp _ left op right) = keepingColumn $ do+  let deltaLeft = lineDelta op left+      deltaRight = lineDelta right op -  let delta = lineDelta op left-  if delta == 0-    then space-    else replicateM_ delta newline+  -- If this starts out as a single line expression, try to keep it as a single line expression. Break+  -- it up over multiple lines if it doesn't fit using operator columns, but only when all the+  -- operators are the same.+  if deltaLeft == 0 && deltaRight == 0 && numOperatorUses op expr >= 2+    then attemptSingleLine opSingle opMulti+    else userSpecified deltaLeft deltaRight+  where+    -- Use user-specified spacing for the newlines in the operator+    userSpecified deltaLeft deltaRight = do+      pretty left -  pretty op+      if deltaLeft == 0+        then space+        else replicateM_ deltaLeft newline -  let delta = lineDelta right op-  if delta == 0-    then space-    else replicateM_ delta newline+      pretty op -  pretty right+      if deltaRight == 0+        then space+        else replicateM_ deltaRight newline++      pretty right++    -- Write the entire infix expression on one line.+    opSingle = sequence_ [pretty left, space, pretty op, space, pretty right]++    -- Use operator column layout.+    opMulti = do+      let opArguments = collectOpArguments op expr+      forM_ (init opArguments) $ \arg -> do+        pretty arg+        space+        pretty op+        newline+      pretty (last opArguments)++    -- Count the number of times an infix operator is used in a row.+    numOperatorUses op e = length (collectOpArguments op e) - 1++    -- Collect all arguments to an infix operator.+    collectOpArguments op expr'@(InfixApp _ left' op' right')+      | void op == void op' = collectOpArguments op left' ++ collectOpArguments op right'+      | otherwise = [expr']+    collectOpArguments _ expr' = [expr'] opExpr exp = prettyNoExt exp  lambdaExpr :: Exp NodeInfo -> Printer State ()@@ -821,6 +853,7 @@         remainder       else         depend (write "| ") $ writeStmts >> remainder+    printComments After a  lineBreakAfterRhs :: NodeInfo -> Exp NodeInfo -> Bool lineBreakAfterRhs rhsLoc exp = onNextLine exp@@ -890,6 +923,7 @@     writeName     space     funBody pat rhs mbinds+    printComments After match decls (ClassDecl _ ctx dhead fundeps mayDecls) = do   let decls = fromMaybe [] mayDecls       noDecls = null decls@@ -947,6 +981,7 @@ writeWhereBinds ds@(BDecls _ binds) = do   printComments Before ds   onSeparateLines binds+  printComments After ds writeWhereBinds binds = prettyNoExt binds  -- Print all the ASTs on separate lines, respecting user spacing.

@@ -13,8 +13,9 @@  module HIndent.Styles.JohanTibell where -import Control.Monad+import Control.Monad hiding (forM_) import Control.Monad.State.Class+import Data.Foldable (forM_) import Data.Int import Data.Maybe import HIndent.Pretty@@ -44,6 +45,7 @@         ,styleInitialState = State         ,styleExtenders =            [Extender decl+           ,Extender match            ,Extender context            ,Extender typ            ,Extender conDecl@@ -80,25 +82,9 @@                  pretty) stmt e = prettyNoExt e --- | Handle do specially and also space out guards more.+-- | Handle do and case specially and also space out guards more. rhs :: Rhs NodeInfo -> Printer s ()-rhs x =-  case x of-    UnGuardedRhs _ (Do _ dos) ->-      swing (write " = do")-            (lined (map pretty dos))-    GuardedRhss _ gas ->-      do newline-         indentSpaces <- getIndentSpaces-         indented indentSpaces-                  (lined (map (\p ->-                                 do write "|"-                                    pretty p)-                              gas))-    _ -> do inCase <- gets psInsideCase-            if inCase-               then unguardedalt x-               else unguardedrhs x+rhs x = prettyNoExt x  -- | Implement dangling right-hand-sides. guardedRhs :: GuardedRhs NodeInfo -> Printer s ()@@ -111,25 +97,12 @@                             do space                                pretty p)                          stmts))-     swing (write " = do")+     inCase <- gets psInsideCase+     write (if inCase then " -> " else " = ")+     swing (write "do")            (lined (map pretty dos)) guardedRhs e = prettyNoExt e --- | Unguarded case alts.-unguardedalt :: Rhs NodeInfo -> Printer s ()-unguardedalt (UnGuardedRhs _ e) =-  do indentSpaces <- getIndentSpaces-     write " -> "-     indented indentSpaces (pretty e)-unguardedalt e = prettyNoExt e--unguardedrhs :: Rhs NodeInfo -> Printer s ()-unguardedrhs (UnGuardedRhs _ e) =-  do indentSpaces <- getIndentSpaces-     write " = "-     indented indentSpaces (pretty e)-unguardedrhs e = prettyNoExt e- -- | Expression customizations. exp :: Exp NodeInfo -> Printer s () -- | Space out tuples.@@ -222,8 +195,34 @@                           (map pretty es)) exp (RecUpdate _ exp updates) = recUpdateExpr (pretty exp) updates exp (RecConstr _ qname updates) = recUpdateExpr (pretty qname) updates+exp (Let _ binds e) =+  do newline   -- Make the let swing under.+     depend (write "let ")+            (do pretty binds+                newline+                indented (-4) (depend (write "in ")+                                      (pretty e))) exp e = prettyNoExt e +match :: Match NodeInfo -> Printer s ()+match (Match _ name pats rhs mbinds) =+  do depend (do pretty name+                space)+            (spaced (map pretty pats))+     withCaseContext False (pretty rhs)+     forM_ mbinds bindingGroup+match (InfixMatch _ pat1 name pats rhs mbinds) =+  do depend (do pretty pat1+                space+                case name of+                  Ident _ i ->+                    string ("`" ++ i ++ "`")+                  Symbol _ s -> string s)+            (do space+                spaced (map pretty pats))+     withCaseContext False (pretty rhs)+     forM_ mbinds bindingGroup+ -- | Format contexts with spaces and commas between class constraints. context :: Context NodeInfo -> Printer s () context (CxTuple _ asserts) =@@ -279,7 +278,7 @@         collapseFaps (TyFun _ arg result) = arg : collapseFaps result         collapseFaps e = [e]         prettyTy ty =-          do small <- isSmall' ty+          do small <- isSmall (pretty ty)              if small                 then pretty ty                 else case collapseFaps ty of@@ -287,21 +286,12 @@                        tys ->                          prefixedLined "-> "                                        (map pretty tys)-        isSmall' p =-          do overflows <- isOverflow (pretty p)-             oneLine <- isSingleLiner (pretty p)-             return (not overflows && oneLine) decl (PatBind _ pat rhs' mbinds) =-      do pretty pat-         pretty rhs'-         case mbinds of-           Nothing -> return ()-           Just binds ->-             do newline-                indented 2-                         (do write "where"-                             newline-                             indented 2 (pretty binds))+  withCaseContext False $+    do pretty pat+       pretty rhs'+       forM_ mbinds bindingGroup+ -- | Handle records specially for a prettier display (see guide). decl (DataDecl _ dataornew ctx dhead condecls@[_] mderivs)   | any isRecord condecls =@@ -382,7 +372,7 @@ isRecord _ = False  -- | Does printing the given thing overflow column limit? (e.g. 80)-isOverflow :: Printer s a -> Printer s Bool+isOverflow :: MonadState (PrintState s) m => m a -> m Bool isOverflow p =   do (_,st) <- sandbox p      columnLimit <- getColumnLimit@@ -436,3 +426,17 @@                              write " = "                              pretty e'     _ -> prettyNoExt e++isSmall :: MonadState (PrintState t) m => m a -> m Bool+isSmall p =+  do overflows <- isOverflow p+     oneLine <- isSingleLiner p+     return (not overflows && oneLine)++bindingGroup :: Binds NodeInfo -> Printer s ()+bindingGroup binds =+  do newline+     indented 2+              (do write "where"+                  newline+                  indented 2 (pretty binds))

@@ -0,0 +1,3 @@+a = b <$> c++a = b <*> d

@@ -0,0 +1,35 @@+veryLongExpression = veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong++veryLongExpression = veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong .+                     veryLong + 3++veryLongExpression = veryLong . veryLong ++                     veryLong . veryLong ++                     veryLong . veryLong ++                     veryLong . veryLong ++                     veryLong . veryLong ++                     veryLong . veryLong ++                     3++veryLongExpression = veryLong .?! veryLong +?! veryLong .?! veryLong +?! veryLong .?! veryLong +?! veryLong .?! veryLong +?! veryLong .?! veryLong +?! veryLong .?! veryLong +?! 3

@@ -0,0 +1,4 @@+f a =+  let foo = bar -- retained comment+      baz = qux -- the test is to ensure this comment is not dropped+  in dog

@@ -0,0 +1,8 @@+test x+  | x == 0 = 0+  | otherwise =+      let foo y+            | y == 0 = 0 -- comment one+            | y == 0 = 1 -- comment two+            | otherwise = 2  -- comment three+      in bar x

@@ -0,0 +1,3 @@+test foo bar [] = baz qux --comment zero+test foo bar [x] = baz qux --comment one+test foo bar [x:xs] = baz qux --comment two

@@ -0,0 +1,3 @@+a = b <$> c++a = b <*> d

@@ -0,0 +1,7 @@+veryLongExpression = veryLong . veryLong . veryLong .veryLong . veryLong . veryLong .veryLong . veryLong . veryLong .veryLong . veryLong . veryLong++veryLongExpression = veryLong . veryLong . veryLong .veryLong . veryLong . veryLong .veryLong . veryLong . veryLong .veryLong . veryLong . veryLong + 3++veryLongExpression = veryLong . veryLong + veryLong .veryLong + veryLong . veryLong +veryLong . veryLong + veryLong .veryLong + veryLong . veryLong + 3++veryLongExpression = veryLong .?! veryLong +?! veryLong .?!veryLong +?! veryLong .?! veryLong +?!veryLong .?! veryLong +?! veryLong .?!veryLong +?! veryLong .?! veryLong +?! 3

@@ -0,0 +1,4 @@+f a =+  let foo = bar -- retained comment+      baz = qux -- the test is to ensure this comment is not dropped+  in dog

@@ -0,0 +1,7 @@+test x+  | x == 0 = 0+  | otherwise = let foo y+                      | y == 0 = 0 -- comment one+                      | y == 0 = 1 -- comment two+                      | otherwise = 2  -- comment three+                in bar x

@@ -0,0 +1,3 @@+test foo bar [] = baz qux --comment zero+test foo bar [x] = baz qux --comment one+test foo bar [x:xs] = baz qux --comment two

@@ -1,5 +1,5 @@ strToMonth :: String -> Int strToMonth month = case month of-        "Jan" -> 1-        "Feb" -> 2-        _ -> error $ "Unknown month " ++ month+    "Jan" -> 1+    "Feb" -> 2+    _ -> error $ "Unknown month " ++ month

@@ -0,0 +1,19 @@+f :: Int+f x+    | x <- Just x+    , x <- Just x = +        case x of+            Just x -> e+    | otherwise = do+        e+  where+    x = y++g x = case x of+    a -> x+  where+    foo = case x of+        _ -> do+            launchMissiles+      where+        y = 2

@@ -0,0 +1,8 @@+g x = +    let x = 1+    in x+  where+    foo = +        let y = 2+            z = 3+        in y

@@ -0,0 +1,15 @@+f :: Int+f x | x <- Just x+    , x <- Just x = case x of+         Just x -> e+  | otherwise = do+    e+  where+    x = y++g x = case x of a -> x+  where+    foo = case x of+        _ -> do launchMissiles+      where+        y = 2

@@ -0,0 +1,3 @@+g x = let x = 1 in x+  where+    foo = let y = 2; z = 3 in y