hindent 3.0 → 3.1
raw patch · 7 files changed
+142/−75 lines, 7 filesdep +monad-loopsdep ~base
Dependencies added: monad-loops
Dependency ranges changed: base
Files
- hindent.cabal +2/−1
- src/HIndent.hs +1/−1
- src/HIndent/Pretty.hs +19/−6
- src/HIndent/Styles/ChrisDone.hs +104/−57
- src/HIndent/Styles/Fundamental.hs +1/−1
- src/HIndent/Styles/JohanTibell.hs +11/−5
- src/HIndent/Types.hs +4/−4
hindent.cabal view
@@ -1,5 +1,5 @@ name: hindent-version: 3.0+version: 3.1 synopsis: Extensible Haskell pretty printer description: Extensible Haskell pretty printer. Both a library and an executable. .@@ -27,6 +27,7 @@ build-depends: base >= 4 && <5 , data-default , haskell-src-exts >= 1.15.0+ , monad-loops , mtl , text
src/HIndent.hs view
@@ -25,7 +25,7 @@ import HIndent.Styles.JohanTibell import HIndent.Types -import Control.Monad.State+import Control.Monad.State.Strict import Data.Data import Data.Monoid import qualified Data.Text.IO as ST
src/HIndent/Pretty.hs view
@@ -37,6 +37,7 @@ , indented , column , depend+ , dependBind , swing , getIndentSpaces , getColumnLimit@@ -73,7 +74,7 @@ -- * Pretty printing class -- | Pretty printing class.-class (Annotated ast,Typeable1 ast) => Pretty ast where+class (Annotated ast,Typeable ast) => Pretty ast where prettyInternal :: ast NodeInfo -> Printer () -- | Pretty print using extenders.@@ -91,7 +92,7 @@ case cast a of Just v -> Just (f s v) Nothing -> Nothing- makePrinter s (CatchAll f) = Just (f s a)+ makePrinter s (CatchAll f) = (f s a) -- | Run the basic printer for the given node without calling an -- extension hook for this node, but do allow extender hooks in child@@ -108,7 +109,7 @@ -- | Pretty print a comment. printComment :: ComInfo -> Printer () printComment (ComInfo (Comment inline _ str) own) =- do st <- sandbox (write "")+ do (_,st) <- sandbox (write "") if own then newline else unless (psColumn st == 0) space@@ -207,6 +208,18 @@ then column col dependent else dependent +-- | Make the latter's indentation depend upon the end column of the+-- former.+dependBind :: Printer a -> (a -> Printer b) -> Printer b+dependBind maker dependent =+ do state' <- get+ v <- maker+ st <- get+ col <- gets psColumn+ if state' /= st+ then column col (dependent v)+ else (dependent v)+ -- | Wrap in parens. parens :: Printer a -> Printer a parens p =@@ -289,13 +302,13 @@ -- | Play with a printer and then restore the state to what it was -- before. sandbox :: MonadState s m- => m a -> m s+ => m a -> m (a,s) sandbox p = do orig <- get- _ <- p+ a <- p new <- get put orig- return new+ return (a,new) -- | No binds? nullBinds :: Binds NodeInfo -> Bool
src/HIndent/Styles/ChrisDone.hs view
@@ -12,6 +12,8 @@ import HIndent.Pretty import HIndent.Types +import Control.Monad+import Control.Monad.Loops import Control.Monad.State.Class import Data.Int import Language.Haskell.Exts.Annotated.Syntax@@ -174,7 +176,7 @@ -- is two invalid statements, not one valid infix op. stmt :: State -> Stmt NodeInfo -> Printer () stmt _ (Qualifier _ e@(InfixApp _ a op b)) =- do col <- fmap psColumn (sandbox (write ""))+ do col <- fmap (psColumn . snd) (sandbox (write "")) infixApp e a op b (Just col) stmt _ e = prettyNoExt e @@ -190,27 +192,23 @@ -- If the head is short we depend, otherwise we swing. exp _ (App _ op a) = do orig <- gets psIndentLevel- headIsShort <- isShort f- depend (do pretty f- space)- (do flats <- mapM isFlat args- flatish <- fmap ((< 2) . length . filter not)- (return flats)- singleLiner <- isSingleLiner (spaced (map pretty args))- overflow <- isOverflowMax (spaced (map pretty args))- if singleLiner &&- ((headIsShort && flatish) ||- all id flats) &&- not overflow- then spaced (map pretty args)- else do allSingleLiners <- fmap (all id)- (mapM (isSingleLiner . pretty) args)- if headIsShort || allSingleLiners- then lined (map pretty args)- else do newline- indentSpaces <- getIndentSpaces- column (orig + indentSpaces)- (lined (map pretty args)))+ dependBind+ (do (short,st) <- isShort f+ put st+ space+ return short)+ (\headIsShort ->+ do let flats = map isFlat args+ flatish =+ length (filter not flats) <+ 2+ if (headIsShort && flatish) ||+ all id flats+ then do ((singleLiner,overflow),st) <- sandboxNonOverflowing args+ if singleLiner && not overflow+ then put st+ else multi orig args headIsShort+ else multi orig args headIsShort) where (f,args) = flatten op [a] flatten :: Exp NodeInfo -> [Exp NodeInfo]@@ -242,70 +240,117 @@ Boxed -> ")")) where p = commas (map pretty exps) exp _ (List _ es) =- do single <- isSingleLiner p- underflow <- fmap not (isOverflow p)- if single && underflow- then p+ do (ok,st) <- sandbox renderFlat+ if ok+ then put st else brackets (prefixedLined "," (map pretty es))- where p = brackets (commas (map pretty es))+ where renderFlat =+ do line <- gets psLine+ brackets (commas (map pretty es))+ st <- get+ columnLimit <- getColumnLimit+ let overflow = psColumn st > columnLimit+ single = psLine st == line+ return (not overflow && single) exp _ e = prettyNoExt e --------------------------------------------------------------------------------+-- Indentation helpers++-- | Sandbox and render the nodes on multiple lines, returning whether+-- each is a single line.+sandboxSingles :: Pretty ast+ => [ast NodeInfo] -> Printer (Bool,PrintState)+sandboxSingles args =+ sandbox (allM (\(i,arg) ->+ do when (i /= (0::Int)) newline+ line <- gets psLine+ pretty arg+ st <- get+ return (psLine st == line))+ (zip [0 ..] args))++-- | Render multi-line nodes.+multi :: Pretty ast+ => Int64 -> [ast NodeInfo] -> Bool -> Printer ()+multi orig args headIsShort =+ if headIsShort+ then lined (map pretty args)+ else do (allAreSingle,st) <- sandboxSingles args+ if allAreSingle+ then put st+ else do newline+ indentSpaces <- getIndentSpaces+ column (orig + indentSpaces)+ (lined (map pretty args))++-- | Sandbox and render the node on a single line, return whether it's+-- on a single line and whether it's overflowing.+sandboxNonOverflowing :: Pretty ast+ => [ast NodeInfo] -> Printer ((Bool,Bool),PrintState)+sandboxNonOverflowing args =+ sandbox (do line <- gets psLine+ columnLimit <- getColumnLimit+ singleLineRender+ st <- get+ return (psLine st == line,psColumn st > columnLimit + 20))+ where singleLineRender =+ spaced (map pretty args)++-------------------------------------------------------------------------------- -- Predicates -- | Is the expression "short"? Used for app heads. isShort :: (Pretty ast)- => ast NodeInfo -> Printer Bool+ => ast NodeInfo -> Printer (Bool,PrintState) isShort p = do line <- gets psLine- orig <- fmap psColumn (sandbox (write ""))- st <- sandbox (pretty p)+ orig <- fmap (psColumn . snd) (sandbox (write ""))+ (_,st) <- sandbox (pretty p) return (psLine st == line &&- (psColumn st < orig + shortName))+ (psColumn st < orig + shortName),st) -- | 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+ => m a -> m (Bool,PrintState) isSmall p = do line <- gets psLine- st <- sandbox p- return (psLine st == line && psColumn st < smallColumnLimit)+ (_,st) <- sandbox p+ return (psLine st == line && psColumn st < smallColumnLimit,st) -- | Is an expression flat?-isFlat :: Exp NodeInfo -> Printer Bool+isFlat :: Exp NodeInfo -> Bool isFlat (Lambda _ _ e) = isFlat e isFlat (App _ a b) =- return (isName a && isName b)+ isName a && isName b where isName (Var{}) = True isName _ = False isFlat (InfixApp _ a _ b) =- do a' <- isFlat a- b' <- isFlat b- return (a' && b')+ isFlat a && isFlat b isFlat (NegApp _ a) = isFlat a-isFlat VarQuote{} = return True-isFlat TypQuote{} = return True-isFlat (List _ []) = return True-isFlat Var{} = return True-isFlat Lit{} = return True-isFlat Con{} = return True+isFlat VarQuote{} = True+isFlat TypQuote{} = True+isFlat (List _ []) = True+isFlat Var{} = True+isFlat Lit{} = True+isFlat Con{} = True isFlat (LeftSection _ e _) = isFlat e isFlat (RightSection _ _ e) = isFlat e-isFlat _ = return False+isFlat _ = False -- | Does printing the given thing overflow column limit? (e.g. 80) isOverflow :: Printer a -> Printer Bool isOverflow p =- do st <- sandbox p+ do (_,st) <- sandbox p columnLimit <- getColumnLimit 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+ do (_,st) <- sandbox p columnLimit <- getColumnLimit return (psColumn st > columnLimit + 20) @@ -314,7 +359,7 @@ => m a -> m Bool isSingleLiner p = do line <- gets psLine- st <- sandbox p+ (_,st) <- sandbox p return (psLine st == line) --------------------------------------------------------------------------------@@ -328,7 +373,7 @@ -> Maybe Int64 -> Printer () infixApp e a op b indent =- do is <- isFlat e+ do let is = isFlat e overflow <- isOverflow (depend (do pretty a space@@ -359,10 +404,12 @@ -> (Exp NodeInfo -> Printer ()) -> Printer () dependOrNewline left right f =- do flat <- isFlat right- small <- isSmall (depend left (f right))- if flat || small- then depend left (f right)- else do left- newline- (f right)+ do if isFlat right+ then renderDependent+ else do (small,st) <- isSmall renderDependent+ if small+ then put st+ else do left+ newline+ (f right)+ where renderDependent = depend left (f right)
src/HIndent/Styles/Fundamental.hs view
@@ -10,7 +10,7 @@ import HIndent.Types import Data.Default-import Prelude hiding (exp)+ -- | Empty state. data State = State
src/HIndent/Styles/JohanTibell.hs view
@@ -4,6 +4,12 @@ -- | Stub module for Johan Tibell's style. -- -- Documented here: <https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md>+--+-- Questions:+--+-- How to indent after a guarded alt/rhs?+-- How to indent let?+-- How to indent large ADT constructors types? module HIndent.Styles.JohanTibell (johanTibell)@@ -289,7 +295,7 @@ -- | Does printing the given thing overflow column limit? (e.g. 80) isOverflow :: Printer a -> Printer Bool isOverflow p =- do st <- sandbox p+ do (_,st) <- sandbox p columnLimit <- getColumnLimit return (psColumn st > columnLimit) @@ -298,16 +304,16 @@ => m a -> m Bool isSingleLiner p = do line <- gets psLine- st <- sandbox p+ (_,st) <- sandbox p return (psLine st == line) -- | Is the expression "short"? Used for app heads. isShort :: (Pretty ast)- => ast NodeInfo -> Printer Bool+ => ast NodeInfo -> Printer (Bool) isShort p = do line <- gets psLine- orig <- fmap psColumn (sandbox (write ""))- st <- sandbox (pretty p)+ orig <- fmap (psColumn . snd) (sandbox (write ""))+ (_,st) <- sandbox (pretty p) return (psLine st == line && (psColumn st < orig + shortName))
src/HIndent/Types.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | All types.@@ -17,7 +16,8 @@ ,ComInfo(..)) where -import Control.Monad.State (MonadState(..),State)+import Control.Applicative+import Control.Monad.State.Strict (MonadState(..),State) import Data.Data import Data.Default import Data.Int (Int64)@@ -29,7 +29,7 @@ -- | A pretty printing monad. newtype Printer a = Printer {runPrinter :: State PrintState a}- deriving (Monad,Functor,MonadState PrintState)+ deriving (Applicative,Monad,Functor,MonadState PrintState) -- | The state of the pretty printer. data PrintState =@@ -53,7 +53,7 @@ -- 'prettyNoExt' to fallback to the built-in printer. data Extender s where Extender :: forall s a. (Typeable a) => (s -> a -> Printer ()) -> Extender s- CatchAll :: forall s. (forall a. Typeable a => s -> a -> Printer ()) -> Extender s+ CatchAll :: forall s. (forall a. Typeable a => s -> a -> Maybe (Printer ())) -> Extender s -- | A printer style. data Style =