hindent 2.1 → 2.2
raw patch · 3 files changed
+63/−35 lines, 3 files
Files
- hindent.cabal +1/−1
- src/HIndent.hs +23/−15
- src/HIndent/Pretty.hs +39/−19
hindent.cabal view
@@ -1,5 +1,5 @@ name: hindent-version: 2.1+version: 2.2 synopsis: Extensible Haskell pretty printer description: Extensible Haskell pretty printer. Both a library and an executable. .
src/HIndent.hs view
@@ -97,14 +97,14 @@ ,evalState (traverse (insert l (ComInfo c ownLine)) ast) False)) . ([],) . fmap (\n -> NodeInfo n [])- where collect c ni@(NodeInfo l _) =- do when (commentAfter c ni)+ where collect c ni@(NodeInfo newL _) =+ do when (commentAfter ni c) (modify (\ml ->- maybe (Just l)- (\l' ->- Just (if on spanBefore srcInfoSpan l l'- then l'- else l))+ maybe (Just newL)+ (\oldL ->+ Just (if on spanBefore srcInfoSpan oldL newL+ then newL+ else oldL)) ml)) return ni insert al c ni@(NodeInfo bl cs) =@@ -115,13 +115,21 @@ else return ni -- | Is the comment after the node?-commentAfter :: Comment -> NodeInfo -> Bool-commentAfter (Comment _ cspan _) (NodeInfo (SrcSpanInfo nspan _) _) =- spanBefore nspan cspan+commentAfter :: NodeInfo -> Comment -> Bool+commentAfter (NodeInfo (SrcSpanInfo n _) _) (Comment _ c _) =+ spanBefore n c --- | Span: a < b+-- | Does the first span end before the second starts? spanBefore :: SrcSpan -> SrcSpan -> Bool-spanBefore a b =- (srcSpanEndLine a < srcSpanEndLine b) ||- ((srcSpanEndLine a == srcSpanEndLine b) &&- (srcSpanEndColumn a < srcSpanEndColumn b))+spanBefore before after =+ (srcSpanStartLine after > srcSpanEndLine before) ||+ ((srcSpanStartLine after == srcSpanEndLine before) &&+ (srcSpanStartColumn after > srcSpanEndColumn before))++srcspan :: SrcSpan -> String+srcspan s =+ show (srcSpanStartLine s) ++ ":" ++ show (srcSpanStartColumn s) ++ "-" +++ show (srcSpanEndLine s) ++ ":" ++ show (srcSpanEndColumn s)++com :: Comment -> String+com (Comment _ s _) = srcspan s
src/HIndent/Pretty.hs view
@@ -84,7 +84,9 @@ case st of PrintState{psExtenders = es,psUserState = s} -> case listToMaybe (mapMaybe (makePrinter s) es) of- Just m -> m+ Just m ->+ do m+ printComments a Nothing -> prettyNoExt a where makePrinter s (Extender f) = case cast a of@@ -98,8 +100,13 @@ => ast NodeInfo -> Printer () prettyNoExt a = do prettyInternal a- mapM_ printComment (nodeInfoComments (ann a))+ printComments a +-- | Print comments of a node.+printComments :: (Pretty ast)+ => ast NodeInfo -> Printer ()+printComments = mapM_ printComment . nodeInfoComments . ann+ -- | Pretty print a comment. printComment :: ComInfo -> Printer () printComment (ComInfo (Comment inline _ str) own) =@@ -700,15 +707,22 @@ error "FIXME: No implementation for TypeDecl." decl TypeFamDecl{} = error "FIXME: No implementation for TypeFamDecl."-decl (DataDecl _ dataornew ctx dhead condecls _derivs) =- depend (do pretty dataornew- space)- (depend (maybeCtx ctx)- (do pretty dhead- case condecls of- [] -> return ()- [x] -> singleCons x- xs -> multiCons xs))+decl (DataDecl _ dataornew ctx dhead condecls mderivs) =+ do depend (do pretty dataornew+ space)+ (depend (maybeCtx ctx)+ (do pretty dhead+ case condecls of+ [] -> return ()+ [x] -> singleCons x+ xs -> multiCons xs))+ indentSpaces <- getIndentSpaces+ case mderivs of+ Nothing -> return ()+ Just derivs ->+ do newline+ column indentSpaces+ (pretty derivs) where singleCons x = do write " =" indentSpaces <- getIndentSpaces@@ -757,6 +771,12 @@ decl x@InfixDecl{} = pretty' x decl x@DefaultDecl{} = pretty' x +instance Pretty Deriving where+ prettyInternal (Deriving _ heads) =+ do write "deriving"+ space+ parens (commas (map pretty heads))+ instance Pretty Alt where prettyInternal x = case x of@@ -844,14 +864,14 @@ indentSpaces <- getIndentSpaces braces (prefixedLined ","- (map (indented indentSpaces . prettyPair)- (concatMap (\(FieldDecl _ names ty) ->- map (,ty) names)- fields))))- where prettyPair (name,ty) =- depend (do pretty name- write " :: ")- (pretty ty)+ (map (indented indentSpaces . pretty)+ fields)))++instance Pretty FieldDecl where+ prettyInternal (FieldDecl _ names ty) =+ depend (do commas (map pretty names)+ write " :: ")+ (pretty ty) instance Pretty FieldUpdate where prettyInternal x =