hindent 1.0 → 2.0

raw patch · 6 files changed

+163/−57 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hindent.cabal +1/−1
• src/HIndent.hs +17/−6
• src/HIndent/Pretty.hs +25/−21
• src/HIndent/Styles/ChrisDone.hs +108/−25
• src/HIndent/Types.hs +10/−3
• src/main/Main.hs +2/−1

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

@@ -43,8 +43,11 @@     ParseOk (v,comments) ->       case annotateComments v comments of         (cs,ast) ->-          Right (prettyPrint config style (do mapM_ printComment cs-                                              pretty ast))+          Right (prettyPrint+                   config+                   style+                   (do mapM_ printComment cs+                       pretty ast))     ParseFailed _ e -> Left e  -- | Pretty print the given printable thing.@@ -77,13 +80,21 @@   [fundamental,chrisDone,michaelSnoyman,johanTibell]  -- | Annotate the AST with comments.-annotateComments :: (Data (ast NodeInfo),Traversable ast,Annotated ast) => ast SrcSpanInfo -> [Comment] -> ([Comment],ast NodeInfo)+annotateComments :: (Data (ast NodeInfo),Traversable ast,Annotated ast)+                 => ast SrcSpanInfo -> [Comment] -> ([ComInfo],ast NodeInfo) annotateComments =-  foldr (\c (cs,ast) ->+  foldr (\c@(Comment _ cspan _) (cs,ast) ->            case execState (traverse (collect c) ast) Nothing of-             Nothing -> (c : cs,ast)+             Nothing ->+               (ComInfo c True :+                cs+               ,ast)              Just l ->-               (cs,evalState (traverse (insert l c) ast) False)) .+               let ownLine =+                     srcSpanStartLine cspan /=+                     srcSpanEndLine (srcInfoSpan l)+               in (cs+                  ,evalState (traverse (insert l (ComInfo c ownLine)) ast) False)) .   ([],) .   fmap (\n -> NodeInfo n [])   where collect c ni@(NodeInfo l _) =

@@ -49,16 +49,15 @@   )   where -import           Data.Char- import           HIndent.Types-import           Language.Haskell.Exts.Comments +import           Language.Haskell.Exts.Comments import           Control.Monad.State hiding (state) import           Data.Int import           Data.List import           Data.Maybe import           Data.Monoid+import           Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as LT import           Data.Text.Lazy.Builder (Builder)@@ -78,7 +77,8 @@   prettyInternal :: ast NodeInfo -> Printer ()  -- | Pretty print using extenders.-pretty :: (Pretty ast) => ast NodeInfo -> Printer ()+pretty :: (Pretty ast)+       => ast NodeInfo -> Printer () pretty a =   do st <- get      case st of@@ -94,16 +94,19 @@ -- | Run the basic printer for the given node without calling an -- extension hook for this node, but do allow extender hooks in child -- nodes. Also auto-inserts comments.-prettyNoExt :: (Pretty ast) => ast NodeInfo -> Printer ()+prettyNoExt :: (Pretty ast)+            => ast NodeInfo -> Printer () prettyNoExt a =   do prettyInternal a      mapM_ printComment (nodeInfoComments (ann a))  -- | Pretty print a comment.-printComment :: Comment -> Printer ()-printComment (Comment inline _ str) =+printComment :: ComInfo -> Printer ()+printComment (ComInfo (Comment inline _ str) own) =   do st <- sandbox (write "")-     unless (psColumn st == 0) space+     if own+        then newline+        else unless (psColumn st == 0) space      if inline         then do write "{-"                 string str@@ -115,7 +118,8 @@  -- | Pretty print using HSE's own printer. The 'P.Pretty' class here -- is HSE's.-pretty' :: (P.Pretty (ast SrcSpanInfo),Functor ast) => ast NodeInfo -> Printer ()+pretty' :: (P.Pretty (ast SrcSpanInfo),Functor ast)+        => ast NodeInfo -> Printer () pretty' = write . T.fromText . T.pack . P.prettyPrint . fmap nodeInfoSpan  --------------------------------------------------------------------------------@@ -157,16 +161,16 @@  -- | Print all the printers separated newlines and optionally a line -- prefix.-prefixedLined :: Char -> [Printer ()] -> Printer ()+prefixedLined :: Text -> [Printer ()] -> Printer () prefixedLined pref ps' =   case ps' of     [] -> return ()     (p:ps) ->       do p-         indented (-1)+         indented (fromIntegral (T.length pref * (-1)))                   (mapM_ (\p' ->                             do newline-                               depend (string [pref]) p')+                               depend (write (T.fromText pref)) p')                          ps)  -- | Set the (newline-) indent level to the given column for the given@@ -503,7 +507,7 @@   depend (write (case boxed of                    Unboxed -> "(#"                    Boxed -> "("))-         (do parens (prefixedLined ','+         (do parens (prefixedLined ","                                    (map pretty exps))              write (case boxed of                       Unboxed -> "#)"@@ -517,7 +521,7 @@                       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)@@ -530,13 +534,13 @@   do indentSpaces <- getIndentSpaces      depend (do pretty n                 space)-            (braces (prefixedLined ','+            (braces (prefixedLined ","                                    (map (indented indentSpaces . pretty) fs))) exp (RecUpdate _ n fs) =   do indentSpaces <- getIndentSpaces      depend (do pretty n                 space)-            (braces (prefixedLined ','+            (braces (prefixedLined ","                                    (map (indented indentSpaces . pretty) fs))) exp (EnumFrom _ e) =   brackets (do pretty e@@ -562,7 +566,7 @@                               (write " |"))                    (do space                        prefixedLined-                         ','+                         ","                          (map (\(i,x) ->                                  depend (if i == 0                                             then return ()@@ -715,7 +719,7 @@              indentSpaces <- getIndentSpaces              column indentSpaces                     (depend (write "=")-                            (prefixedLined '|'+                            (prefixedLined "|"                                            (map (depend space . pretty) xs))) decl GDataDecl{} =   error "FIXME: No implementation for GDataDecl."@@ -850,7 +854,7 @@                (do space                    indentSpaces <- getIndentSpaces                    braces (prefixedLined-                             ','+                             ","                              (map (indented indentSpaces . prettyPair)                                   (concatMap (\(FieldDecl _ names ty) ->                                                 map (,ty) names)@@ -896,7 +900,7 @@       GuardedAlt _ stmts e ->         do indented 1                     (do (prefixedLined-                           ','+                           ","                            (map (\p ->                                    do space                                       pretty p)@@ -910,7 +914,7 @@       GuardedRhs _ stmts e ->         do indented 1                     (do prefixedLined-                          ','+                          ","                           (map (\p ->                                   do space                                      pretty p)

@@ -41,11 +41,63 @@            ,Extender rhs            ,Extender guardedrhs            ,Extender guardedalt-           ,Extender unguardedalt]+           ,Extender unguardedalt+           ,Extender stmt+           ,Extender decl]         ,styleDefConfig =            Config {configMaxColumns = 80                   ,configIndentSpaces = 2}} +-- | Pretty print type signatures like+--+-- foo :: (Show x,Read x)+--     => (Foo -> Bar)+--     -> Maybe Int+--     -> (Char -> X -> Y)+--     -> IO ()+--+decl :: t -> Decl NodeInfo -> Printer ()+decl _ (TypeSig _ names ty') =+  depend (do inter (write ", ")+                   (map pretty names)+             write " :: ")+         (declTy ty')+  where declTy dty =+          case dty of+            TyForall _ mbinds mctx ty ->+              do case mbinds of+                   Nothing -> return ()+                   Just ts ->+                     do write "forall "+                        spaced (map pretty ts)+                        write ". "+                        newline+                 case mctx of+                   Nothing -> prettyTy ty+                   Just ctx ->+                     do pretty ctx+                        newline+                        indented (-3)+                                 (depend (write "=> ")+                                         (prettyTy ty))+            _ -> prettyTy dty+        collapseFaps (TyFun _ arg result) = arg : collapseFaps result+        collapseFaps e = [e]+        prettyTy ty =+          do small <- isSmall' ty+             if small+                then pretty ty+                else case collapseFaps ty of+                       [] -> pretty ty+                       tys ->+                         prefixedLined "-> "+                                       (map pretty tys)+        isSmall' p =+          do overflows <- isOverflow (pretty p)+             oneLine <- isSingleLiner (pretty p)+             return (not overflows && oneLine)+decl _ e = prettyNoExt e+ -- | I want field updates to be dependent or newline. fieldupdate :: t -> FieldUpdate NodeInfo -> Printer () fieldupdate _ e =@@ -59,6 +111,7 @@     _ -> prettyNoExt e  +-- | Right-hand sides are dependent. rhs :: State -> Rhs NodeInfo -> Printer () rhs _ (UnGuardedRhs _ e) =   do indentSpaces <- getIndentSpaces@@ -73,7 +126,7 @@ guardedrhs _ (GuardedRhs _ stmts e) =   indented 1            (do prefixedLined-                 ','+                 ","                  (map (\p ->                          do space                             pretty p)@@ -89,7 +142,7 @@ guardedalt _ (GuardedAlt _ stmts e) =   indented 1            (do (prefixedLined-                  ','+                  ","                   (map (\p ->                           do space                              pretty p)@@ -110,30 +163,23 @@      pretty) unguardedalt _ e = prettyNoExt e +-- Do statements need to handle infix expression indentation specially because+-- do x *+--    y+-- 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 ""))+     infixApp e a op b (Just col)+stmt _ e = prettyNoExt e+ -- | Expressions exp :: State -> Exp NodeInfo -> Printer () -- Infix applications will render on one line if possible, otherwise -- if any of the arguments are not "flat" then that expression is -- line-separated. exp _ e@(InfixApp _ a op b) =-  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-                pretty b+  infixApp e a op b Nothing -- | We try to render everything on a flat line. More than one of the -- arguments are not flat and it wouldn't be a single liner. -- If the head is short we depend, otherwise we swing.@@ -149,7 +195,8 @@                 overflow <- isOverflowMax (spaced (map pretty args))                 if singleLiner &&                    ((headIsShort && flatish) ||-                    all id flats) && not overflow+                    all id flats) &&+                   not overflow                    then spaced (map pretty args)                    else do allSingleLiners <- fmap (all id)                                                    (mapM (isSingleLiner . pretty) args)@@ -181,7 +228,8 @@              underflow <- fmap not (isOverflow p)              if single && underflow                 then p-                else parens (prefixedLined ',' (map pretty exps))+                else prefixedLined ","+                                   (map pretty exps)              write (case boxed of                       Unboxed -> "#)"                       Boxed -> ")"))@@ -191,11 +239,43 @@      underflow <- fmap not (isOverflow p)      if single && underflow         then p-        else brackets (prefixedLined ','+        else brackets (prefixedLined ","                                      (map pretty es))   where p = brackets (commas (map pretty es)) exp _ e = prettyNoExt e +infixApp :: (Pretty ast,Pretty ast1,Pretty ast2)+         => Exp NodeInfo+         -> ast NodeInfo+         -> ast1 NodeInfo+         -> ast2 NodeInfo+         -> Maybe Int64+         -> Printer ()+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)+ -- | Is the expression "short"? Used for app heads. isShort :: (Pretty ast) => ast NodeInfo -> Printer Bool isShort p =@@ -221,7 +301,10 @@  -- | Make the right hand side dependent if it's flat, otherwise -- newline it.-dependOrNewline :: Printer () -> Exp NodeInfo -> (Exp NodeInfo -> Printer ()) -> Printer ()+dependOrNewline :: Printer ()+                -> Exp NodeInfo+                -> (Exp NodeInfo -> Printer ())+                -> Printer () dependOrNewline left right f =   do flat <- isFlat right      small <- isSmall (depend left (f right))

@@ -11,7 +11,8 @@   ,Extender(..)   ,Style(..)   ,Config(..)-  ,NodeInfo(..))+  ,NodeInfo(..)+  ,ComInfo(..))   where  import Control.Monad.State (MonadState(..),State)@@ -74,7 +75,13 @@  -- | Information for each node in the AST. data NodeInfo =-  NodeInfo {nodeInfoSpan :: SrcSpanInfo -- ^ Location info from the parser.-           ,nodeInfoComments :: [Comment] -- ^ Comments which follow this node.+  NodeInfo {nodeInfoSpan :: !SrcSpanInfo -- ^ Location info from the parser.+           ,nodeInfoComments :: ![ComInfo] -- ^ Comments which follow this node.             }   deriving (Typeable,Show,Data)++-- | Comment with some more info.+data ComInfo =+  ComInfo {comInfoComment :: !Comment+          ,comInfoOwnLine :: !Bool}+  deriving (Show,Typeable,Data)

@@ -24,7 +24,8 @@             reformat (styleDefConfig style) style)        _ ->          error ("arguments: --style [" ++-                intercalate "|" (map (T.unpack . styleName) styles) +++                intercalate "|"+                            (map (T.unpack . styleName) styles) ++                 "]")   where findStyle name =           find ((== T.pack name) . styleName) styles