hindent 2.3 → 2.4
raw patch · 3 files changed
+45/−43 lines, 3 files
Files
- hindent.cabal +2/−2
- src/HIndent/Pretty.hs +26/−21
- src/HIndent/Styles/ChrisDone.hs +17/−20
hindent.cabal view
@@ -1,5 +1,5 @@ name: hindent-version: 2.3+version: 2.4 synopsis: Extensible Haskell pretty printer description: Extensible Haskell pretty printer. Both a library and an executable. .@@ -27,7 +27,7 @@ HIndent.Styles.JohanTibell build-depends: base >= 4 && <5 , data-default- , haskell-src-exts+ , haskell-src-exts >= 1.15.0 , mtl , text
src/HIndent/Pretty.hs view
@@ -240,7 +240,8 @@ comma = write "," -- | Write an integral.-int :: Integral n => n -> Printer ()+int :: Integral n+ => n -> Printer () int = write . decimal -- | Write out a string, updating the current position information.@@ -277,15 +278,18 @@ -- | Indent spaces, e.g. 2. getIndentSpaces :: Printer Int64-getIndentSpaces = gets (configIndentSpaces . psConfig)+getIndentSpaces =+ gets (configIndentSpaces . psConfig) -- | Column limit, e.g. 80 getColumnLimit :: Printer Int64-getColumnLimit = gets (configMaxColumns . psConfig)+getColumnLimit =+ gets (configMaxColumns . psConfig) -- | Play with a printer and then restore the state to what it was -- before.-sandbox :: MonadState s m => m a -> m s+sandbox :: MonadState s m+ => m a -> m s sandbox p = do orig <- get _ <- p@@ -468,7 +472,9 @@ swing (do pretty f) (lined (map pretty args)) where (f,args) = flatten op [a]- flatten :: Exp NodeInfo -> [Exp NodeInfo] -> (Exp NodeInfo,[Exp NodeInfo])+ flatten :: Exp NodeInfo+ -> [Exp NodeInfo]+ -> (Exp NodeInfo,[Exp NodeInfo]) flatten (App _ f' a') b = flatten f' (a' : b) flatten f' as = (f',as)@@ -527,7 +533,8 @@ Unboxed -> "#)" Boxed -> ")")) exp (List _ es) =- brackets (prefixedLined "," (map pretty es))+ brackets (prefixedLined ","+ (map pretty es)) exp (LeftSection _ e op) = parens (depend (do pretty e space)@@ -732,8 +739,7 @@ Nothing -> return () Just derivs -> do newline- column indentSpaces- (pretty derivs)+ column indentSpaces (pretty derivs) where singleCons x = do write " =" indentSpaces <- getIndentSpaces@@ -807,7 +813,8 @@ prettyInternal x = case x of ClassA _ name types ->- spaced (pretty name : map pretty types)+ spaced (pretty name :+ map pretty types) InfixA{} -> error "FIXME: No implementation for InfixA." IParam{} ->@@ -821,8 +828,7 @@ BangedTy _ ty -> depend (write "!") (pretty ty)- UnBangedTy _ ty ->- pretty ty+ UnBangedTy _ ty -> pretty ty UnpackedTy _ ty -> depend (write "{-# UNPACK #-} !") (pretty ty)@@ -831,7 +837,7 @@ prettyInternal x = case x of BDecls _ ds -> lined (map pretty ds)- IPBinds _ i -> lined (map pretty i)+ IPBinds _ i -> lined (map pretty i) instance Pretty ClassDecl where prettyInternal x =@@ -842,7 +848,8 @@ (depend (maybeCtx ctx) (do pretty h (case mkind of- Nothing -> return ()+ Nothing ->+ return () Just kind -> do write " :: " pretty kind)))@@ -873,10 +880,8 @@ depend (pretty name) (do space indentSpaces <- getIndentSpaces- braces (prefixedLined- ","- (map (indented indentSpaces . pretty)- fields)))+ braces (prefixedLined ","+ (map (indented indentSpaces . pretty) fields))) instance Pretty FieldDecl where prettyInternal (FieldDecl _ names ty) =@@ -941,10 +946,10 @@ case i of InsDecl _ d -> pretty d InsType _ name ty ->- depend (do write "type "- pretty name- write " = ")- (pretty ty)+ depend (do write "type "+ pretty name+ write " = ")+ (pretty ty) _ -> pretty' i instance Pretty Match where
src/HIndent/Styles/ChrisDone.hs view
@@ -207,7 +207,9 @@ column (orig + indentSpaces) (lined (map pretty args))) where (f,args) = flatten op [a]- flatten :: Exp NodeInfo -> [Exp NodeInfo] -> (Exp NodeInfo,[Exp NodeInfo])+ flatten :: Exp NodeInfo+ -> [Exp NodeInfo]+ -> (Exp NodeInfo,[Exp NodeInfo]) flatten (App _ f' a') b = flatten f' (a' : b) flatten f' as = (f',as)@@ -277,27 +279,23 @@ (pretty b) -- | Is the expression "short"? Used for app heads.-isShort :: (Pretty ast) => ast NodeInfo -> Printer Bool+isShort :: (Pretty ast)+ => ast NodeInfo -> Printer Bool isShort p = do line <- gets psLine orig <- fmap psColumn (sandbox (write "")) st <- sandbox (pretty p)- return (psLine st ==- line &&- (psColumn st <- orig +- shortName))+ return (psLine st == line &&+ (psColumn st < orig + shortName)) -- | Is the given expression "small"? I.e. does it fit on one line and -- under 'smallColumnLimit' columns.-isSmall :: MonadState PrintState m => m a -> m Bool+isSmall :: MonadState PrintState m+ => m a -> m Bool isSmall p = do line <- gets psLine st <- sandbox p- return (psLine st ==- line &&- psColumn st <- smallColumnLimit)+ return (psLine st == line && psColumn st < smallColumnLimit) -- | Make the right hand side dependent if it's flat, otherwise -- newline it.@@ -317,7 +315,8 @@ -- | Is an expression flat? isFlat :: Exp NodeInfo -> Printer Bool isFlat (Lambda _ _ e) = isFlat e-isFlat (App _ a b) = return (isName a && isName b)+isFlat (App _ a b) =+ return (isName a && isName b) where isName (Var{}) = True isName _ = False isFlat (InfixApp _ a _ b) =@@ -340,21 +339,19 @@ isOverflow p = do st <- sandbox p columnLimit <- getColumnLimit- return (psColumn st >- columnLimit)+ return (psColumn st > columnLimit) -- | Does printing the given thing overflow column limit? (e.g. 80) isOverflowMax :: Printer a -> Printer Bool isOverflowMax p = do st <- sandbox p columnLimit <- getColumnLimit- return (psColumn st >- columnLimit + 20)+ return (psColumn st > columnLimit + 20) -- | Is the given expression a single-liner when printed?-isSingleLiner :: MonadState PrintState m => m a -> m Bool+isSingleLiner :: MonadState PrintState m+ => m a -> m Bool isSingleLiner p = do line <- gets psLine st <- sandbox p- return (psLine st ==- line)+ return (psLine st == line)