hindent 4.3.0 → 4.3.1

raw patch · 2 files changed

+54/−48 lines, 2 filesdep ~descriptivePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: descriptive

API changes (from Hackage documentation)

Files

• hindent.cabal +2/−2
• src/HIndent/Styles/Gibiansky.hs +52/−46

@@ -1,5 +1,5 @@ name:                hindent-version:             4.3.0+version:             4.3.1 synopsis:            Extensible Haskell pretty printer description:         Extensible Haskell pretty printer. Both a library and an executable.                      .@@ -40,7 +40,7 @@   build-depends:     base >= 4 && < 5                    , hindent                    , text-                   , descriptive == 0.3.*+                   , descriptive >= 0.3 && < 0.5                    , haskell-src-exts  executable hindent-generate-tests

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards, RankNTypes #-}+{-# OPTIONS_GHC  -fno-warn-name-shadowing  #-}  module HIndent.Styles.Gibiansky where @@ -17,14 +18,14 @@ import           Prelude hiding (exp, all, mapM_, minimum, and, maximum)  -- | Empty state.-data State = State+data State = State { gibianskyForceSingleLine :: Bool }  -- | The printer style. gibiansky :: Style gibiansky = Style { styleName = "gibiansky"                   , styleAuthor = "Andrew Gibiansky"                   , styleDescription = "Andrew Gibiansky's style"-                  , styleInitialState = State+                  , styleInitialState = State { gibianskyForceSingleLine = False }                   , styleExtenders = [ Extender imp                                      , Extender modl                                      , Extender context@@ -61,24 +62,29 @@ maxSingleLineExports :: Integral a => a maxSingleLineExports = 4 -attemptSingleLine :: Printer s a -> Printer s a -> Printer s a+attemptSingleLine :: Printer State a -> Printer State a -> Printer State a attemptSingleLine single multiple = do-  -- Try printing on one line.   prevState <- get-  result <- single+  if gibianskyForceSingleLine $ psUserState prevState+    then single+    else do+      -- Try printing on one line.+      modifyState $ \st -> st { gibianskyForceSingleLine = True }+      result <- single+      modifyState $ \st -> st { gibianskyForceSingleLine = False } -  --  If it doesn't fit, reprint on multiple lines.-  col <- getColumn-  maxColumns <- configMaxColumns <$> gets psConfig-  if col > maxColumns-    then do-      put prevState-      multiple-    else return result+      --  If it doesn't fit, reprint on multiple lines.+      col <- getColumn+      maxColumns <- configMaxColumns <$> gets psConfig+      if col > maxColumns+        then do+          put prevState+          multiple+        else return result  -------------------------------------------------------------------------------- -- Extenders-type Extend f = forall t. f NodeInfo -> Printer t ()+type Extend f = f NodeInfo -> Printer State ()  -- | Format whole modules. modl :: Extend Module@@ -171,10 +177,9 @@       pretty from       write " -> "       pretty to-    else-    -- If the function argument types are on different lines,-    -- write one argument type per line.-    do+    else do+      -- If the function argument types are on different lines,+      -- write one argument type per line.       col <- getColumn       pretty from       column (col - 3) $ do@@ -183,7 +188,7 @@         indented 3 $ pretty to typ t = prettyNoExt t -writeTuple :: Pretty ast => Boxed -> [ast NodeInfo] -> Printer s ()+writeTuple :: Pretty ast => Boxed -> [ast NodeInfo] -> Printer State () writeTuple boxed vals = parens $ do   boxed'   inter (write ", ") $ map pretty vals@@ -221,7 +226,7 @@ exprs (Tuple _ _ exps) = parens $ inter (write ", ") $ map pretty exps exprs exp = prettyNoExt exp -letExpr :: Exp NodeInfo -> Printer s ()+letExpr :: Exp NodeInfo -> Printer State () letExpr (Let _ binds result) = do   cols <- depend (write "let ") $ do             col <- getColumn@@ -233,7 +238,7 @@     pretty result letExpr _ = error "Not a let" -appExpr :: Exp NodeInfo -> Printer s ()+appExpr :: Exp NodeInfo -> Printer State () appExpr app@(App _ f x) = do   prevState <- get   prevLine <- getLineNum@@ -251,7 +256,8 @@       then separateArgs app       else do         col <- getColumn-        column col $ do+        ind <- gets psIndentLevel+        column (max col ind) $ do           pretty f           newline           indented indentSpaces $ pretty x@@ -266,7 +272,7 @@         indentOnce         pretty x -    canSingleLine :: Printer s a -> Printer s Bool+    canSingleLine :: Printer State a -> Printer State Bool     canSingleLine printer = do       st <- get       prevLine <- getLineNum@@ -283,7 +289,7 @@       in (fun, y : args)     collectArgs nonApp = (nonApp, []) -    separateArgs :: Exp NodeInfo -> Printer s ()+    separateArgs :: Exp NodeInfo -> Printer State ()     separateArgs expr =       let (fun, args) = collectArgs expr       in do@@ -294,24 +300,24 @@           indented indentSpaces $ lined $ map pretty $ reverse args appExpr _ = error "Not an app" -doExpr :: Exp NodeInfo -> Printer s ()+doExpr :: Exp NodeInfo -> Printer State () doExpr (Do _ stmts) = do   write "do"   newline   indented 2 $ onSeparateLines stmts doExpr _ = error "Not a do" -listExpr :: Exp NodeInfo -> Printer s ()+listExpr :: Exp NodeInfo -> Printer State () listExpr (List _ els) = attemptSingleLine (singleLineList els) (multiLineList els) listExpr _ = error "Not a list" -singleLineList :: [Exp NodeInfo] -> Printer s ()+singleLineList :: [Exp NodeInfo] -> Printer State () singleLineList exps = do   write "["   inter (write ", ") $ map pretty exps   write "]" -multiLineList :: [Exp NodeInfo] -> Printer s ()+multiLineList :: [Exp NodeInfo] -> Printer State () multiLineList [] = write "[]" multiLineList (first:exps) = do   col <- getColumn@@ -326,7 +332,7 @@     newline     write "]" -dollarExpr :: Exp NodeInfo -> Printer s ()+dollarExpr :: Exp NodeInfo -> Printer State () dollarExpr (InfixApp _ left op right) = do   pretty left   write " "@@ -344,14 +350,14 @@     needsNewline exp = lineDelta exp op > 0 dollarExpr _ = error "Not an application" -applicativeExpr :: Exp NodeInfo -> Printer s ()+applicativeExpr :: Exp NodeInfo -> Printer State () 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 s ()+    singleLine :: Exp NodeInfo -> Exp NodeInfo -> [Exp NodeInfo] -> Printer State ()     singleLine first second rest = spaced                                      [ pretty first                                      , write "<$>"@@ -360,7 +366,7 @@                                      , inter (write " <*> ") $ map pretty rest                                      ] -    multiLine :: Exp NodeInfo -> Exp NodeInfo -> [Exp NodeInfo] -> Printer s ()+    multiLine :: Exp NodeInfo -> Exp NodeInfo -> [Exp NodeInfo] -> Printer State ()     multiLine first second rest = do       pretty first       depend (write " ") $ do@@ -392,7 +398,7 @@     isAp _ = False applicativeExpr _ = error "Not an application" -opExpr :: Exp NodeInfo -> Printer s ()+opExpr :: Exp NodeInfo -> Printer State () opExpr (InfixApp _ left op right) = do   col <- getColumn   column col $ do@@ -413,7 +419,7 @@     pretty right opExpr exp = prettyNoExt exp -lambdaExpr :: Exp NodeInfo -> Printer s ()+lambdaExpr :: Exp NodeInfo -> Printer State () lambdaExpr (Lambda _ pats exp) = do   write "\\"   spaced $ map pretty pats@@ -424,7 +430,7 @@     pretty exp lambdaExpr _ = error "Not a lambda" -caseExpr :: Exp NodeInfo -> Printer s ()+caseExpr :: Exp NodeInfo -> Printer State () caseExpr (Case _ exp alts) = do   depend (write "case ") $ do     pretty exp@@ -434,14 +440,14 @@   writeCaseAlts alts caseExpr _ = error "Not a case" -lambdaCaseExpr :: Exp NodeInfo -> Printer s ()+lambdaCaseExpr :: Exp NodeInfo -> Printer State () lambdaCaseExpr (LCase _ alts) = do   write "\\case"   newline   writeCaseAlts alts lambdaCaseExpr _ = error "Not a lambda case" -ifExpr :: Exp NodeInfo -> Printer s ()+ifExpr :: Exp NodeInfo -> Printer State () ifExpr (If _ cond thenExpr elseExpr) =   depend (write "if") $ do     write " "@@ -454,7 +460,7 @@     pretty elseExpr ifExpr _ = error "Not an if statement" -writeCaseAlts :: [Alt NodeInfo] -> Printer s ()+writeCaseAlts :: [Alt NodeInfo] -> Printer State () writeCaseAlts alts = do   allSingle <- and <$> mapM isSingle alts   withCaseContext True $ indented indentSpaces $@@ -465,7 +471,7 @@       else lined $ map (prettyCase Nothing) alts    where-    isSingle :: Alt NodeInfo -> Printer s Bool+    isSingle :: Alt NodeInfo -> Printer State Bool     isSingle alt' = fst <$> sandbox                               (do                                  line <- gets psLine@@ -476,7 +482,7 @@     altPattern :: Alt l -> Pat l     altPattern (Alt _ p _ _) = p -    patternLen :: Pat NodeInfo -> Printer s Int+    patternLen :: Pat NodeInfo -> Printer State Int     patternLen pat = fromIntegral <$> fst <$> sandbox                                                 (do                                                    col <- getColumn@@ -484,7 +490,7 @@                                                    col' <- getColumn                                                    return $ col' - col) -    prettyCase :: Maybe Int -> Alt NodeInfo -> Printer s ()+    prettyCase :: Maybe Int -> Alt NodeInfo -> Printer State ()     prettyCase mpatlen (Alt _ p galts mbinds) = do       -- Padded pattern       case mpatlen of@@ -505,7 +511,7 @@         indented indentSpaces $ depend (write "where ") (pretty binds)  -recUpdateExpr :: Printer s () -> [FieldUpdate NodeInfo] -> Printer s ()+recUpdateExpr :: Printer State () -> [FieldUpdate NodeInfo] -> Printer State () recUpdateExpr expWriter updates = do   expWriter   write " "@@ -563,7 +569,7 @@   indented 1 $ prefixedLined "," (map (\p -> space >> pretty p) stmts)   rhsRest exp -rhsRest :: Pretty ast => ast NodeInfo -> Printer s ()+rhsRest :: Pretty ast => ast NodeInfo -> Printer State () rhsRest exp = do   write " "   rhsSeparator@@ -607,7 +613,7 @@     funBody pat rhs mbinds decls decl = prettyNoExt decl -funBody :: [Pat NodeInfo] -> Rhs NodeInfo -> Maybe (Binds NodeInfo) -> Printer s ()+funBody :: [Pat NodeInfo] -> Rhs NodeInfo -> Maybe (Binds NodeInfo) -> Printer State () funBody pat rhs mbinds = do   spaced $ map pretty pat @@ -628,13 +634,13 @@       newline       indented indentSpaces $ writeWhereBinds binds -writeWhereBinds :: Binds NodeInfo -> Printer s ()+writeWhereBinds :: Binds NodeInfo -> Printer State () writeWhereBinds ds@(BDecls _ binds) = do   printComments Before ds   onSeparateLines binds writeWhereBinds binds = prettyNoExt binds -onSeparateLines :: (Pretty ast, Annotated ast) => [ast NodeInfo] -> Printer s ()+onSeparateLines :: (Pretty ast, Annotated ast) => [ast NodeInfo] -> Printer State () onSeparateLines vals@(first:rest) = do   pretty first   forM_ (zip vals rest) $ \(prev, cur) -> do