hindent 4.3.10 → 4.3.11

raw patch · 6 files changed

+144/−112 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hindent.cabal +2/−1
• src/HIndent.hs +12/−109
• src/HIndent/Comments.hs +110/−0
• src/HIndent/Styles/ChrisDone.hs +16/−0
• src/HIndent/Types.hs +3/−1
• src/main/Main.hs +1/−1

@@ -1,5 +1,5 @@ name:                hindent-version:             4.3.10+version:             4.3.11 synopsis:            Extensible Haskell pretty printer description:         Extensible Haskell pretty printer. Both a library and an executable.                      .@@ -30,6 +30,7 @@   exposed-modules:   HIndent                      HIndent.Types                      HIndent.Pretty+                     HIndent.Comments                      HIndent.Styles.Fundamental                      HIndent.Styles.ChrisDone                      HIndent.Styles.JohanTibell

@@ -22,8 +22,7 @@   )   where -import           Control.Monad.Trans.Maybe-import           Data.Functor.Identity+import           HIndent.Comments import           HIndent.Pretty import           HIndent.Styles.ChrisDone (chrisDone) import           HIndent.Styles.Fundamental (fundamental)@@ -32,8 +31,9 @@ import           HIndent.Types  import           Control.Monad.State.Strict-import           Data.Data-import           Data.Function+import           Control.Monad.Trans.Maybe+import           Data.Functor.Identity+import           Data.Maybe (fromMaybe) import           Data.Monoid import qualified Data.Text.IO as ST import           Data.Text.Lazy (Text)@@ -41,21 +41,18 @@ import           Data.Text.Lazy.Builder (Builder) import qualified Data.Text.Lazy.Builder as T import qualified Data.Text.Lazy.IO as T-import           Data.Traversable import           Language.Haskell.Exts.Annotated hiding (Style,prettyPrint,Pretty,style,parse)-import           Data.Maybe (fromMaybe)  -- | Format the given source. reformat :: Style -> Maybe [Extension] -> Text -> Either String Builder reformat style mexts x =-  case parseModuleWithComments (case mexts of-                                  Just exts -> parseMode {extensions = exts}-                                  Nothing -> parseMode)+  case parseModuleWithComments mode                                (T.unpack x) of     ParseOk (m,comments) ->       let (cs,ast) =             annotateComments (fromMaybe m $ applyFixities baseFixities m) comments       in Right (prettyPrint+                  mode                   style                   -- For the time being, assume that all "free-floating" comments come at the beginning.                   -- If they were not at the beginning, they would be after some ast node.@@ -63,17 +60,20 @@                   (do mapM_ (printComment Nothing) (reverse cs)                       pretty ast))     ParseFailed _ e -> Left e+  where mode = (case mexts of+                  Just exts -> parseMode {extensions = exts}+                  Nothing -> parseMode)  -- | Pretty print the given printable thing.-prettyPrint :: Style -> (forall s. Printer s ()) -> Builder-prettyPrint style m =+prettyPrint :: ParseMode -> Style -> (forall s. Printer s ()) -> Builder+prettyPrint mode style m =   case style of     Style _name _author _desc st extenders config ->       maybe (error "Printer failed with mzero call.")             psOutput             (runIdentity                (runMaybeT (execStateT (runPrinter m)-                                      (PrintState 0 mempty False 0 1 st extenders config False False))))+                                      (PrintState 0 mempty False 0 1 st extenders config False False mode))))  -- | Parse mode, includes all extensions, doesn't assume any fixities. parseMode :: ParseMode@@ -113,100 +113,3 @@ styles :: [Style] styles =   [fundamental,chrisDone,johanTibell,gibiansky]---- | Annotate the AST with comments.-annotateComments :: forall ast. (Data (ast NodeInfo),Traversable ast,Annotated ast)-                 => ast SrcSpanInfo -> [Comment] -> ([ComInfo],ast NodeInfo)-annotateComments src comments =-  let-      -- Make sure to process comments top to bottom.-      reversed = reverse comments--      -- Replace source spans with node infos in the AST.-      src' = fmap (\n -> NodeInfo n []) src--      -- Add all comments to the ast.-      (cominfos, src'') = foldr processComment ([], src') reversed--  in -- Reverse order of comments at each node.-    (cominfos, fmap (\(NodeInfo n cs) -> NodeInfo n $ reverse cs) src'')--  where processComment :: Comment-                       -> ([ComInfo],ast NodeInfo)-                       -> ([ComInfo],ast NodeInfo)-        -- Add in a single comment to the ast.-        processComment c@(Comment _ cspan _) (cs,ast) =-          -- Try to find the node after which this comment lies.-          case execState (traverse (collect After c) ast) Nothing of-            -- When no node is found, the comment is on its own line.-            Nothing -> (ComInfo c Nothing : cs, ast)--            -- We found the node that this comment follows.-            -- Check whether the node is on the same line.-            Just (NodeInfo l coms)-              -- If it's on a different line than the node, but the node has an-              -- EOL comment, and the EOL comment and this comment are aligned,-              -- attach this comment to the preceding node.-              | ownLine && alignedWithPrevious -> insertedBefore--              -- If it's on a different line than the node, look for the following node to attach it to.-              | ownLine ->-                  case execState (traverse (collect Before c) ast) Nothing of-                    -- If we don't find a node after the comment, leave it with the previous node.-                    Nothing   -> insertedBefore-                    Just (NodeInfo node _) ->-                      (cs, evalState (traverse (insert node (ComInfo c $ Just Before)) ast) False)--              -- If it's on the same line, insert this comment into that node.-              | otherwise -> insertedBefore-              where-                ownLine = srcSpanStartLine cspan /= srcSpanEndLine (srcInfoSpan l)-                insertedBefore = (cs, evalState (traverse (insert l (ComInfo c $ Just After)) ast) False)-                alignedWithPrevious-                  | null coms = False-                  | otherwise = case last coms of-                      -- Require single line comment after the node.-                      ComInfo (Comment False prevSpan _) (Just After) ->-                        srcSpanStartLine prevSpan == srcSpanStartLine cspan - 1 &&-                        srcSpanStartColumn prevSpan == srcSpanStartColumn cspan-                      _       -> False--        -- For a comment, check whether the comment is after the node.-        -- If it is, store it in the state; otherwise do nothing.-        -- The location specifies where the comment should lie relative to the node.-        collect :: ComInfoLocation -> Comment -> NodeInfo -> State (Maybe NodeInfo) NodeInfo-        collect loc' c ni@(NodeInfo newL _) =-          do when (commentLocated loc' ni c)-                  (modify (maybe (Just ni)-                                 (\oldni@(NodeInfo oldL _) ->-                                    Just (if (spanTest loc' `on` srcInfoSpan) oldL newL-                                             then ni-                                             else oldni))))-             return ni--        -- Insert the comment into the ast. Find the right node and add it to the-        -- comments of that node. Do nothing afterwards.-        insert :: SrcSpanInfo -> ComInfo -> NodeInfo -> State Bool NodeInfo-        insert al c ni@(NodeInfo bl cs) =-          do done <- get-             if not done && al == bl-                then do put True-                        return (ni {nodeInfoComments = c : cs})-                else return ni---- | Is the comment after the node?-commentLocated :: ComInfoLocation -> NodeInfo -> Comment -> Bool-commentLocated loc' (NodeInfo (SrcSpanInfo n _) _) (Comment _ c _) =-  spanTest loc' n c---- | For @After@, does the first span end before the second starts?--- For @Before@, does the first span start after the second ends?-spanTest :: ComInfoLocation -> SrcSpan -> SrcSpan -> Bool-spanTest loc' first second =-  (srcSpanStartLine after > srcSpanEndLine before) ||-  ((srcSpanStartLine after == srcSpanEndLine before) &&-   (srcSpanStartColumn after > srcSpanEndColumn before))-  where (before,after) =-          case loc' of-            After -> (first,second)-            Before -> (second,first)

@@ -0,0 +1,110 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE OverloadedStrings, TupleSections, ScopedTypeVariables #-}++-- | Comment handling.++module HIndent.Comments where++import Control.Monad.State.Strict+import Data.Data+import Data.Function+import Data.Traversable+import HIndent.Types+import Language.Haskell.Exts.Annotated hiding (Style,prettyPrint,Pretty,style,parse)++-- | Annotate the AST with comments.+annotateComments :: forall ast. (Data (ast NodeInfo),Traversable ast,Annotated ast)+                 => ast SrcSpanInfo -> [Comment] -> ([ComInfo],ast NodeInfo)+annotateComments src comments =+  let+      -- Make sure to process comments top to bottom.+      reversed = reverse comments++      -- Replace source spans with node infos in the AST.+      src' = fmap (\n -> NodeInfo n []) src++      -- Add all comments to the ast.+      (cominfos, src'') = foldr processComment ([], src') reversed++  in -- Reverse order of comments at each node.+    (cominfos, fmap (\(NodeInfo n cs) -> NodeInfo n $ reverse cs) src'')++  where processComment :: Comment+                       -> ([ComInfo],ast NodeInfo)+                       -> ([ComInfo],ast NodeInfo)+        -- Add in a single comment to the ast.+        processComment c@(Comment _ cspan _) (cs,ast) =+          -- Try to find the node after which this comment lies.+          case execState (traverse (collect After c) ast) Nothing of+            -- When no node is found, the comment is on its own line.+            Nothing -> (ComInfo c Nothing : cs, ast)++            -- We found the node that this comment follows.+            -- Check whether the node is on the same line.+            Just (NodeInfo l coms)+              -- If it's on a different line than the node, but the node has an+              -- EOL comment, and the EOL comment and this comment are aligned,+              -- attach this comment to the preceding node.+              | ownLine && alignedWithPrevious -> insertedBefore++              -- If it's on a different line than the node, look for the following node to attach it to.+              | ownLine ->+                  case execState (traverse (collect Before c) ast) Nothing of+                    -- If we don't find a node after the comment, leave it with the previous node.+                    Nothing   -> insertedBefore+                    Just (NodeInfo node _) ->+                      (cs, evalState (traverse (insert node (ComInfo c $ Just Before)) ast) False)++              -- If it's on the same line, insert this comment into that node.+              | otherwise -> insertedBefore+              where+                ownLine = srcSpanStartLine cspan /= srcSpanEndLine (srcInfoSpan l)+                insertedBefore = (cs, evalState (traverse (insert l (ComInfo c $ Just After)) ast) False)+                alignedWithPrevious+                  | null coms = False+                  | otherwise = case last coms of+                      -- Require single line comment after the node.+                      ComInfo (Comment False prevSpan _) (Just After) ->+                        srcSpanStartLine prevSpan == srcSpanStartLine cspan - 1 &&+                        srcSpanStartColumn prevSpan == srcSpanStartColumn cspan+                      _       -> False++        -- For a comment, check whether the comment is after the node.+        -- If it is, store it in the state; otherwise do nothing.+        -- The location specifies where the comment should lie relative to the node.+        collect :: ComInfoLocation -> Comment -> NodeInfo -> State (Maybe NodeInfo) NodeInfo+        collect loc' c ni@(NodeInfo newL _) =+          do when (commentLocated loc' ni c)+                  (modify (maybe (Just ni)+                                 (\oldni@(NodeInfo oldL _) ->+                                    Just (if (spanTest loc' `on` srcInfoSpan) oldL newL+                                             then ni+                                             else oldni))))+             return ni++        -- Insert the comment into the ast. Find the right node and add it to the+        -- comments of that node. Do nothing afterwards.+        insert :: SrcSpanInfo -> ComInfo -> NodeInfo -> State Bool NodeInfo+        insert al c ni@(NodeInfo bl cs) =+          do done <- get+             if not done && al == bl+                then do put True+                        return (ni {nodeInfoComments = c : cs})+                else return ni++-- | Is the comment after the node?+commentLocated :: ComInfoLocation -> NodeInfo -> Comment -> Bool+commentLocated loc' (NodeInfo (SrcSpanInfo n _) _) (Comment _ c _) =+  spanTest loc' n c++-- | For @After@, does the first span end before the second starts?+-- For @Before@, does the first span start after the second ends?+spanTest :: ComInfoLocation -> SrcSpan -> SrcSpan -> Bool+spanTest loc' first second =+  (srcSpanStartLine after > srcSpanEndLine before) ||+  ((srcSpanStartLine after == srcSpanEndLine before) &&+   (srcSpanStartColumn after > srcSpanEndColumn before))+  where (before,after) =+          case loc' of+            After -> (first,second)+            Before -> (second,first)

@@ -8,13 +8,18 @@ module HIndent.Styles.ChrisDone where  import HIndent.Pretty+import HIndent.Comments import HIndent.Types  import Control.Monad import Control.Monad.Loops import Control.Monad.State.Class import Data.Int+import Data.Maybe+import Language.Haskell.Exts.Annotated (parseExpWithComments)+import Language.Haskell.Exts.Annotated.Fixity import Language.Haskell.Exts.Annotated.Syntax+import Language.Haskell.Exts.Parser (ParseResult(..)) import Prelude hiding (exp)  --------------------------------------------------------------------------------@@ -204,6 +209,17 @@  -- | Expressions exp :: Exp NodeInfo -> Printer t ()+exp e@(QuasiQuote _ "i" s) =+  do parseMode <- gets psParseMode+     case parseExpWithComments parseMode s of+       ParseOk (e',comments) ->+         do depend (do write "["+                       string "i"+                       write "|")+                   (do exp (snd (annotateComments (fromMaybe e' (applyFixities baseFixities e'))+                                                  comments))+                       write "|]")+       _ -> prettyNoExt e -- Infix applications will render on one line if possible, otherwise -- if any of the arguments are not "flat" then that expression is -- line-separated.

@@ -29,6 +29,7 @@ import Data.Text (Text) import Data.Text.Lazy.Builder (Builder) import Language.Haskell.Exts.Comments+import Language.Haskell.Exts.Parser import Language.Haskell.Exts.SrcLoc  -- | A pretty printing monad.@@ -48,10 +49,11 @@              ,psConfig :: !Config -- ^ Config which styles may or may not pay attention to.              ,psEolComment :: !Bool -- ^ An end of line comment has just been outputted.              ,psInsideCase :: !Bool -- ^ Whether we're in a case statement, used for Rhs printing.+             ,psParseMode :: !ParseMode -- ^ Mode used to parse the original AST.              }  instance Eq (PrintState s) where-  PrintState ilevel out newline col line _ _ _ eolc inc == PrintState ilevel' out' newline' col' line' _ _ _ eolc' inc' =+  PrintState ilevel out newline col line _ _ _ eolc inc pm == PrintState ilevel' out' newline' col' line' _ _ _ eolc' inc' pm' =     (ilevel,out,newline,col,line,eolc, inc) == (ilevel',out',newline',col',line',eolc', inc')  -- | A printer extender. Takes as argument the user state that the

@@ -109,5 +109,5 @@     ,TransformListComp -- steals the group keyword     ,XmlSyntax, RegularPatterns -- steals a-b     ,UnboxedTuples -- breaks (#) lens operator-    ,QuasiQuotes -- breaks [x| ...], making whitespace free list comps break+    -- ,QuasiQuotes -- breaks [x| ...], making whitespace free list comps break     ]