diff --git a/hindent.cabal b/hindent.cabal --- a/hindent.cabal +++ b/hindent.cabal @@ -1,5 +1,5 @@ name: hindent -version: 4.3.5 +version: 4.3.6 synopsis: Extensible Haskell pretty printer description: Extensible Haskell pretty printer. Both a library and an executable. . diff --git a/src/HIndent/Styles/ChrisDone.hs b/src/HIndent/Styles/ChrisDone.hs --- a/src/HIndent/Styles/ChrisDone.hs +++ b/src/HIndent/Styles/ChrisDone.hs @@ -389,37 +389,40 @@ -------------------------------------------------------------------------------- -- Helpers -infixApp :: (Pretty ast,Pretty ast1,Pretty ast2) - => Exp NodeInfo - -> ast NodeInfo - -> ast1 NodeInfo - -> ast2 NodeInfo +infixApp :: Exp NodeInfo + -> Exp NodeInfo + -> QOp NodeInfo + -> Exp NodeInfo -> Maybe Int64 - -> Printer t () + -> Printer s () infixApp e a op b indent = do let is = isFlat e overflow <- isOverflow - (depend (do pretty a + (depend (do prettyWithIndent a space pretty op space) - (do pretty b)) + (do prettyWithIndent b)) if is && not overflow - then do depend (do pretty a + then do depend (do prettyWithIndent a space pretty op space) (do pretty b) - else do pretty a + else do prettyWithIndent a space pretty op newline case indent of - Nothing -> pretty b + Nothing -> prettyWithIndent b Just col -> do indentSpaces <- getIndentSpaces column (col + indentSpaces) - (pretty b) + (prettyWithIndent b) + where prettyWithIndent e' = + case e' of + (InfixApp _ a' op' b') -> infixApp e' a' op' b' indent + _ -> pretty e' -- | Make the right hand side dependent if it's flat, otherwise -- newline it. diff --git a/src/HIndent/Styles/Gibiansky.hs b/src/HIndent/Styles/Gibiansky.hs --- a/src/HIndent/Styles/Gibiansky.hs +++ b/src/HIndent/Styles/Gibiansky.hs @@ -114,6 +114,7 @@ -- | Format patterns. pat :: Extend Pat pat (PTuple _ boxed pats) = writeTuple boxed pats +pat (PList _ pats) = singleLineList pats pat p = prettyNoExt p -- | Format import statements. @@ -238,6 +239,12 @@ pretty result letExpr _ = error "Not a let" +keepingColumn :: Printer State () -> Printer State () +keepingColumn printer = do + col <- getColumn + ind <- gets psIndentLevel + column (max col ind) printer + appExpr :: Exp NodeInfo -> Printer State () appExpr app@(App _ f x) = do prevState <- get @@ -254,23 +261,18 @@ allArgsSeparate <- not <$> canSingleLine (pretty f) if allArgsSeparate then separateArgs app - else do - col <- getColumn - ind <- gets psIndentLevel - column (max col ind) $ do - pretty f - newline - indented indentSpaces $ pretty x + else keepingColumn $ do + pretty f + newline + indented indentSpaces $ pretty x where singleLine = spaced [pretty f, pretty x] - multiLine = do - col <- getColumn - column col $ do - pretty f - newline - indentOnce - pretty x + multiLine = keepingColumn $ do + pretty f + newline + indentOnce + pretty x canSingleLine :: Printer State a -> Printer State Bool canSingleLine printer = do @@ -292,12 +294,10 @@ separateArgs :: Exp NodeInfo -> Printer State () separateArgs expr = let (fun, args) = collectArgs expr - in do - col <- getColumn - column col $ do - pretty fun - newline - indented indentSpaces $ lined $ map pretty $ reverse args + in keepingColumn $ do + pretty fun + newline + indented indentSpaces $ lined $ map pretty $ reverse args appExpr _ = error "Not an app" doExpr :: Exp NodeInfo -> Printer State () @@ -311,7 +311,7 @@ listExpr (List _ els) = attemptSingleLine (singleLineList els) (multiLineList els) listExpr _ = error "Not a list" -singleLineList :: [Exp NodeInfo] -> Printer State () +singleLineList :: Pretty a => [a NodeInfo] -> Printer State () singleLineList exps = do write "[" inter (write ", ") $ map pretty exps @@ -319,18 +319,15 @@ multiLineList :: [Exp NodeInfo] -> Printer State () multiLineList [] = write "[]" -multiLineList (first:exps) = do - col <- getColumn - ind <- gets psIndentLevel - column (max col ind) $ do - write "[ " - pretty first - forM_ exps $ \el -> do - newline - write ", " - pretty el +multiLineList (first:exps) = keepingColumn $ do + write "[ " + pretty first + forM_ exps $ \el -> do newline - write "]" + write ", " + pretty el + newline + write "]" dollarExpr :: Exp NodeInfo -> Printer State () dollarExpr (InfixApp _ left op right) = do @@ -399,24 +396,22 @@ applicativeExpr _ = error "Not an application" opExpr :: Exp NodeInfo -> Printer State () -opExpr (InfixApp _ left op right) = do - col <- getColumn - column col $ do - pretty left +opExpr (InfixApp _ left op right) = keepingColumn $ do + pretty left - let delta = lineDelta op left - if delta == 0 - then space - else replicateM_ delta newline + let delta = lineDelta op left + if delta == 0 + then space + else replicateM_ delta newline - pretty op + pretty op - let delta = lineDelta right op - if delta == 0 - then space - else replicateM_ delta newline + let delta = lineDelta right op + if delta == 0 + then space + else replicateM_ delta newline - pretty right + pretty right opExpr exp = prettyNoExt exp lambdaExpr :: Exp NodeInfo -> Printer State () diff --git a/src/HIndent/Styles/JohanTibell.hs b/src/HIndent/Styles/JohanTibell.hs --- a/src/HIndent/Styles/JohanTibell.hs +++ b/src/HIndent/Styles/JohanTibell.hs @@ -19,6 +19,7 @@ import Data.Maybe import HIndent.Pretty import HIndent.Types +import HIndent.Styles.ChrisDone (infixApp) import Language.Haskell.Exts.Annotated.Syntax import Prelude hiding (exp) @@ -406,38 +407,3 @@ write " = " pretty e' _ -> prettyNoExt e - --------------------------------------------------------------------------------- --- Helpers - -infixApp :: (Pretty ast,Pretty ast1,Pretty ast2) - => Exp NodeInfo - -> ast NodeInfo - -> ast1 NodeInfo - -> ast2 NodeInfo - -> Maybe Int64 - -> Printer s () -infixApp e a op b indent = - do is <- isFlat e - overflow <- isOverflow - (depend (do pretty a - space - pretty op - space) - (do pretty b)) - if is && not overflow - then do depend (do pretty a - space - pretty op - space) - (do pretty b) - else do pretty a - space - pretty op - newline - case indent of - Nothing -> pretty b - Just col -> - do indentSpaces <- getIndentSpaces - column (col + indentSpaces) - (pretty b)