Implement rendering of simplest value-level constructs

data/examples/declaration/value/function/case-multi-line-out.hs

@@ -0,0 +1,25 @@
+foo :: Int -> Int
+foo x =
+  case x of
+    5 -> 10
+    _ -> 12
+
+bar :: Int -> Int
+bar x =
+  case x of
+    5 ->
+      if x > 5
+        then 10
+        else 12
+    _ -> 12
+
+baz :: Int -> Int
+baz x =
+  case x of
+    5 -> 10
+    _ -> 12
+
+quux :: Int -> Int
+quux x =
+  case x of
+    x -> x

data/examples/declaration/value/function/case-multi-line.hs

@@ -0,0 +1,19 @@
+foo :: Int -> Int
+foo x = case x of
+  5 -> 10
+  _ -> 12
+
+bar :: Int -> Int
+bar x =
+  case x of
+    5 -> if x > 5
+           then 10 else 12
+    _ -> 12
+
+baz :: Int -> Int
+baz x = case x of 5 -> 10
+                  _ -> 12
+
+quux :: Int -> Int
+quux x = case x of
+  x -> x

data/examples/declaration/value/function/case-single-line-out.hs

@@ -0,0 +1,2 @@
+foo :: Int -> Int
+foo x = case x of x -> x

data/examples/declaration/value/function/case-single-line.hs

@@ -0,0 +1,2 @@
+foo :: Int -> Int
+foo x = case x of x -> x

data/examples/declaration/value/function/if-multi-line-out.hs

@@ -0,0 +1,5 @@
+foo :: Int -> Int
+foo x =
+  if x > 5
+    then 10
+    else 12

data/examples/declaration/value/function/if-multi-line.hs

@@ -0,0 +1,3 @@
+foo :: Int -> Int
+foo x = if x > 5 then 10
+  else 12

data/examples/declaration/value/function/if-single-line-out.hs

@@ -0,0 +1,5 @@
+foo :: Int -> Int
+foo x = if x > 5 then 10 else 12
+
+bar :: Int -> Int
+bar x = if x > 5 then 10 else 12

data/examples/declaration/value/function/if-single-line.hs

@@ -0,0 +1,6 @@
+foo :: Int -> Int
+foo x = if x > 5 then 10 else 12
+
+bar :: Int -> Int
+bar x =
+  if x > 5 then 10 else 12

data/examples/declaration/value/function/lambda-case-out.hs

@@ -0,0 +1,6 @@
+{-# LANGUAGE LambdaCase #-}
+foo :: Int -> Int
+foo =
+  \case
+    5 -> 10
+    _ -> 12

data/examples/declaration/value/function/lambda-case.hs

@@ -0,0 +1,6 @@
+{-# LANGUAGE LambdaCase #-}
+
+foo :: Int -> Int
+foo = \case
+  5 -> 10
+  _ -> 12

data/examples/declaration/value/function/lambda-multi-line-out.hs

@@ -0,0 +1,11 @@
+foo :: a -> a -> a
+foo x =
+  \y ->
+    x
+
+bar :: Int -> Int -> Int
+bar x =
+  \y ->
+    if x > y
+      then 10
+      else 12

data/examples/declaration/value/function/lambda-multi-line.hs

@@ -0,0 +1,9 @@
+foo :: a -> a -> a
+foo x = \y ->
+  x
+
+bar :: Int -> Int -> Int
+bar x = \y ->
+  if x > y
+    then 10
+    else 12

data/examples/declaration/value/function/lambda-single-line-out.hs

@@ -0,0 +1,5 @@
+foo :: a -> a -> a
+foo x = \y -> x
+
+bar :: a -> a -> a
+bar x = \y -> x

data/examples/declaration/value/function/lambda-single-line.hs

@@ -0,0 +1,6 @@
+foo :: a -> a -> a
+foo x = \y -> x
+
+bar :: a -> a -> a
+bar x =
+  \y -> x

data/examples/declaration/value/function/let-multi-line-out.hs

@@ -0,0 +1,12 @@
+foo :: Int -> Int
+foo x =
+  let z = y
+      y = x
+  in z + 100
+
+bar :: Int -> Int
+bar x =
+  let z = y
+      y = x
+  in z
+       + 100

data/examples/declaration/value/function/let-multi-line.hs

@@ -0,0 +1,12 @@
+foo :: Int -> Int
+foo x =
+  let z = y
+      y = x
+  in z + 100
+
+bar :: Int -> Int
+bar x =
+  let z = y
+      y = x
+  in z
+      + 100

data/examples/declaration/value/function/let-single-line-out.hs

@@ -0,0 +1,2 @@
+foo :: a -> a
+foo x = let x = x in x

data/examples/declaration/value/function/let-single-line.hs

@@ -0,0 +1,2 @@
+foo :: a -> a
+foo x = let x = x in x

data/examples/declaration/value/function/multiline-arguments-out.hs

@@ -0,0 +1,8 @@
+foo :: Int -> Int -> Int -> Int
+foo
+  (Foo g o)
+  ( Bar
+      x
+      y
+  )
+  z = x

data/examples/declaration/value/function/multiline-arguments.hs

@@ -0,0 +1,4 @@
+foo :: Int -> Int -> Int -> Int
+foo (Foo g o)
+    (Bar
+       x y) z = x

data/examples/declaration/value/function/multiple-matches-out.hs

@@ -0,0 +1,3 @@
+foo :: Int -> Int
+foo 5 = 10
+foo _ = 12

data/examples/declaration/value/function/multiple-matches.hs

@@ -0,0 +1,3 @@
+foo :: Int -> Int
+foo 5 = 10
+foo _ = 12

data/examples/declaration/value/function/negation-out.hs

@@ -0,0 +1,2 @@
+foo :: Int
+foo = (-2)

data/examples/declaration/value/function/negation.hs

@@ -0,0 +1,2 @@
+foo :: Int
+foo = (-2)

data/examples/declaration/value/function/simple-out.hs

@@ -0,0 +1,3 @@
+bar x = x
+
+baz = x

data/examples/declaration/value/function/simple.hs

@@ -0,0 +1,2 @@
+bar x = x
+baz = x

data/examples/declaration/value/function/where-out.hs

@@ -0,0 +1,17 @@
+foo :: Int -> Int
+foo x = f x
+  where
+    f z = z
+
+bar :: Int -> Int
+bar x = f x
+  where
+    f :: Int -> Int
+    f z = z
+
+baz :: Int -> Int
+baz x = q
+  where
+    y = x
+    z = y
+    q = z

data/examples/declaration/value/function/where.hs

@@ -0,0 +1,15 @@
+foo :: Int -> Int
+foo x = f x where f z = z
+
+bar :: Int -> Int
+bar x = f x
+  where
+    f :: Int -> Int
+    f z = z
+
+baz :: Int -> Int
+baz x = q
+  where
+    y = x
+    z = y
+    q = z

data/examples/declaration/value/other/line-multi-line-out.hs

@@ -0,0 +1,6 @@
+x :: [Int]
+x =
+  [ 1
+  , 2
+  , somethingSomething 3
+  ]

data/examples/declaration/value/other/line-multi-line.hs

@@ -0,0 +1,6 @@
+x :: [Int]
+x = [
+  1
+  , 2
+  , somethingSomething 3
+  ]

data/examples/declaration/value/other/line-single-line-out.hs

@@ -0,0 +1,2 @@
+x :: [Int]
+x = [1, 2, 3]

data/examples/declaration/value/other/line-single-line.hs

@@ -0,0 +1,2 @@
+x :: [Int]
+x = [1,2,3]

ormolu.cabal

@@ -60,9 +60,11 @@ library
                     , Ormolu.Printer.Meat.Common
                     , Ormolu.Printer.Meat.Declaration
                     , Ormolu.Printer.Meat.Declaration.Data
+                    , Ormolu.Printer.Meat.Declaration.Pat
                     , Ormolu.Printer.Meat.Declaration.Signature
                     , Ormolu.Printer.Meat.Declaration.Type
                     , Ormolu.Printer.Meat.Declaration.TypeFamily
+                    , Ormolu.Printer.Meat.Declaration.Value
                     , Ormolu.Printer.Meat.ImportExport
                     , Ormolu.Printer.Meat.Module
                     , Ormolu.Printer.Meat.Type

src/Ormolu/Printer/Internal.hs

@@ -245,15 +245,16 @@ enterLayout l (R m) = do
   let modRC rc = rc
         { rcLayout = l
         }
-  R (local modRC m)
+  x <- R (local modRC m)
   traceR ("lend_" ++ label) Nothing
+  return x
 
 -- | Do one or another thing depending on current 'Layout'.
 
 vlayout
-  :: R ()                       -- ^ Single line
-  -> R ()                       -- ^ Multi line
-  -> R ()
+  :: R a                        -- ^ Single line
+  -> R a                        -- ^ Multi line
+  -> R a
 vlayout sline mline = do
   l <- R (asks rcLayout)
   case l of

src/Ormolu/Printer/Meat/Declaration.hs

@@ -14,16 +14,19 @@ import Ormolu.Printer.Meat.Declaration.Data
 import Ormolu.Printer.Meat.Declaration.Signature
 import Ormolu.Printer.Meat.Declaration.Type
 import Ormolu.Printer.Meat.Declaration.TypeFamily
+import Ormolu.Printer.Meat.Declaration.Value
+import Ormolu.Utils
 
 p_hsDecl :: HsDecl GhcPs -> R ()
 p_hsDecl = \case
   TyClD x -> p_tyClDecl x
+  ValD x -> p_valDecl x
   SigD x -> p_sigDecl x
-  _ -> error "this is not yet supported"
+  _ -> notImplemented "certain kinds of declarations"
 
 p_tyClDecl :: TyClDecl GhcPs -> R ()
 p_tyClDecl = \case
   FamDecl x -> p_famDecl x
   SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs
   DataDecl {..} -> p_dataDecl tcdLName tcdTyVars tcdDataDefn
-  _ -> error "this is not yet supported"
+  _ -> notImplemented "certain kinds of declarations"

src/Ormolu/Printer/Meat/Declaration/Pat.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+
+module Ormolu.Printer.Meat.Declaration.Pat
+  ( p_pat
+  )
+where
+
+import BasicTypes
+import Control.Monad
+import GHC
+import Ormolu.Printer.Combinators
+import Ormolu.Printer.Meat.Common
+import Ormolu.Utils
+
+p_pat :: Pat GhcPs -> R ()
+p_pat = \case
+  WildPat _ -> txt "_"
+  VarPat name -> located name p_rdrName
+  LazyPat pat -> do
+    txt "~"
+    located pat p_pat
+  AsPat name pat -> do
+    located name p_rdrName
+    txt "@"
+    located pat p_pat
+  ParPat pat ->
+    located pat (parens . p_pat)
+  BangPat pat -> do
+    txt "!"
+    located pat p_pat
+  ListPat pats _ _ -> do
+    brackets $ velt (withSep comma (located' p_pat) pats)
+  TuplePat pats boxing _ -> do
+    let f =
+          case boxing of
+            Boxed -> parens
+            Unboxed -> parensHash
+    f $ velt (withSep comma (located' p_pat) pats)
+  SumPat pat _ _ _ -> do
+    -- XXX I'm not sure about this one.
+    located pat p_pat
+  PArrPat pats _ -> do
+    bracketsPar $ velt (withSep comma (located' p_pat) pats)
+  ConPatIn pat details ->
+    case details of
+      PrefixCon xs -> do
+        located pat p_rdrName
+        unless (null xs) . inci . inci $ do
+          breakpoint
+          velt' (located' p_pat <$> xs)
+      RecCon (HsRecFields fields dotdot) -> do
+        located pat p_rdrName
+        case dotdot of
+          Nothing -> txt " {..}"
+          Just _ -> do
+            braces $ velt (withSep comma (located' p_hsRecField) fields)
+      InfixCon x y -> do
+        located x p_pat
+        located pat (backticks . p_rdrName)
+        located y p_pat
+  ConPatOut {} -> notImplemented "ConPatOut"
+  ViewPat {} -> notImplemented "ViewPat"
+  SplicePat {} -> notImplemented "SplicePat"
+  LitPat p -> atom p
+  NPat v _ _ _ -> located v (atom . ol_val)
+  NPlusKPat {} -> notImplemented "NPlusKPat"
+  SigPatIn {} -> notImplemented "SigPatIn"
+  SigPatOut {} -> notImplemented "SigPatOut"
+  CoPat {} -> notImplemented "CoPat"
+
+p_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
+p_hsRecField HsRecField {..} =
+  located hsRecFieldLbl $ \x ->
+    located (rdrNameFieldOcc x) p_rdrName

src/Ormolu/Printer/Meat/Declaration/Signature.hs

@@ -5,18 +5,24 @@
 -- | Type signature declarations.
 
 module Ormolu.Printer.Meat.Declaration.Signature
-  ( p_sigDecl )
+  ( p_sigDecl
+  , p_sigDecl'
+  )
 where
 
 import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Type
+import Ormolu.Utils
 
 p_sigDecl :: Sig GhcPs -> R ()
-p_sigDecl = \case
-  TypeSig names hswc -> line (p_typeSig names hswc)
-  _ -> error "Ormolu.Printer.Meat.Declaration.Signature: unimplemented signatures"
+p_sigDecl = line . p_sigDecl'
+
+p_sigDecl' :: Sig GhcPs -> R ()
+p_sigDecl' = \case
+  TypeSig names hswc -> p_typeSig names hswc
+  _ -> notImplemented "certain types of signature declarations"
 
 p_typeSig
   :: [Located RdrName]

src/Ormolu/Printer/Meat/Declaration/Value.hs

@@ -0,0 +1,235 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+
+module Ormolu.Printer.Meat.Declaration.Value
+  ( p_valDecl
+  )
+where
+
+import Bag (bagToList)
+import Control.Monad
+import Data.List (sortOn)
+import GHC
+import Ormolu.Printer.Combinators
+import Ormolu.Printer.Meat.Common
+import Ormolu.Printer.Meat.Declaration.Pat
+import Ormolu.Printer.Meat.Declaration.Signature
+import Ormolu.Utils
+import SrcLoc (isOneLineSpan)
+import qualified Data.List.NonEmpty as NE
+
+p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
+p_valDecl = line . p_valDecl'
+
+p_valDecl' :: HsBindLR GhcPs GhcPs -> R ()
+p_valDecl' = \case
+  FunBind funId funMatches _ _ _ -> p_funBind funId funMatches
+  _ -> notImplemented "certain kinds of binding declarations"
+
+p_funBind
+  :: Located RdrName          -- ^
+  -> MatchGroup GhcPs (LHsExpr GhcPs) -- ^
+  -> R ()
+p_funBind name mgroup =
+  p_matchGroup (Function (unL name)) mgroup
+
+data MatchGroupStyle
+  = Function RdrName
+  | Case
+  | Lambda
+  | LambdaCase
+
+p_matchGroup
+  :: MatchGroupStyle
+  -> MatchGroup GhcPs (LHsExpr GhcPs)
+  -> R ()
+p_matchGroup style MG {..} =
+  locatedVia Nothing mg_alts $
+    newlineSep (located' (p_match style))
+
+p_match
+  :: MatchGroupStyle
+  -> Match GhcPs (LHsExpr GhcPs)
+  -> R ()
+p_match style Match {..} = do
+  case style of
+    Function name -> p_rdrName name
+    _ -> return ()
+  -- NOTE Normally, since patterns may be placed in a multi-line layout, it
+  -- is necessary to bump indentation for the pattern group so it's more
+  -- indented than function name. This in turn means that indentation for
+  -- the body should also be bumped. Normally this would mean that bodies
+  -- would start with two indentation steps applied, which is ugly, so we
+  -- need to be a bit more clever here and bump indentation level only when
+  -- pattern group is multiline.
+  inci' <- case NE.nonEmpty m_pats of
+    Nothing -> return id
+    Just ne_pats -> do
+      let combinedSpans = combineSrcSpans' $
+            getSpan <$> ne_pats
+          inci' = if isOneLineSpan combinedSpans
+            then id
+            else inci
+      switchLayout combinedSpans $ do
+        case style of
+          Function _ -> breakpoint
+          Case -> return ()
+          Lambda -> txt "\\"
+          LambdaCase -> return ()
+        inci' (velt' (located' p_pat <$> m_pats))
+      return inci'
+  inci' $ do
+    space
+    let GRHSs {..} = m_grhss
+    unless (length grhssGRHSs > 1) . txt $
+      case style of
+        Function _ -> "="
+        _ -> "->"
+    let combinedSpans = combineSrcSpans' $
+          getGRHSSpan . unL <$> NE.fromList grhssGRHSs
+    case style of
+      Lambda -> breakpoint
+      _ -> return ()
+    switchLayout combinedSpans . inci $ do
+      case style of
+        Lambda -> return ()
+        _ -> breakpoint
+      newlineSep (located' p_grhs) grhssGRHSs
+      unless (GHC.isEmptyLocalBinds (unL grhssLocalBinds)) $ do
+        newline
+        line (txt "where")
+        inci (located grhssLocalBinds p_hsLocalBinds)
+
+getGRHSSpan :: GRHS GhcPs (LHsExpr GhcPs) -> SrcSpan
+getGRHSSpan (GRHS _ body) = getSpan body
+
+p_grhs :: GRHS GhcPs (LHsExpr GhcPs) -> R ()
+p_grhs (GRHS guards body) =
+  case guards of
+    [] -> p_body
+    xs -> do
+      txt "| "
+      velt $ withSep comma (located' p_stmt) xs
+      txt " ->"
+      breakpoint
+      p_body
+  where
+    p_body = located body p_hsExpr
+
+p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
+p_stmt = \case
+  LastStmt {} -> notImplemented "do notation"
+  BindStmt {} -> notImplemented "do notation"
+  ApplicativeStmt {} -> notImplemented "applicative stmt"
+  BodyStmt body _ _ _ -> located body p_hsExpr
+  LetStmt binds -> located binds p_hsLocalBinds
+  ParStmt {} -> notImplemented "ParStmt"
+  TransStmt {} -> notImplemented "TransStmt"
+  RecStmt {} -> notImplemented "RecStmt"
+
+p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
+p_hsLocalBinds = \case
+  HsValBinds (ValBindsIn bag lsigs) -> do
+    let ssStart = either
+          (srcSpanStart . getSpan)
+          (srcSpanStart . getSpan)
+        items =
+          (Left <$> bagToList bag) ++ (Right <$> lsigs)
+        p_item (Left x) = located x p_valDecl'
+        p_item (Right x) = located x p_sigDecl'
+    newlineSep p_item (sortOn ssStart items)
+  HsValBinds _ -> notImplemented "HsValBinds"
+  HsIPBinds _ -> notImplemented "HsIPBinds"
+  EmptyLocalBinds -> return ()
+
+p_hsExpr :: HsExpr GhcPs -> R ()
+p_hsExpr = \case
+  HsVar name -> located name p_rdrName'
+  HsUnboundVar _ -> notImplemented "HsUnboundVar"
+  HsConLikeOut _ -> notImplemented "HsConLikeOut"
+  HsRecFld x ->
+    case x of
+      Unambiguous name _ -> located name p_rdrName'
+      Ambiguous name _ -> located name p_rdrName'
+  HsOverLabel _ _ -> notImplemented "HsOverLabel"
+  HsIPVar (HsIPName name) -> atom name
+  HsOverLit v -> atom (ol_val v)
+  HsLit lit -> atom lit
+  HsLam mgroup ->
+    p_matchGroup Lambda mgroup
+  HsLamCase mgroup -> do
+    txt "\\case"
+    newline
+    inci (p_matchGroup LambdaCase mgroup)
+  HsApp f x -> do
+    located f p_hsExpr
+    breakpoint
+    inci (located x p_hsExpr)
+  HsAppType {} -> notImplemented "HsAppType"
+  HsAppTypeOut {} -> notImplemented "HsAppTypeOut"
+  OpApp x op _ y -> do
+    located x p_hsExpr
+    breakpoint
+    inci $ do
+      located op p_hsExpr
+      space
+      located y p_hsExpr
+  NegApp e _ -> do
+    txt "-"
+    located e p_hsExpr
+  HsPar e -> parens (located e p_hsExpr)
+  SectionL {} -> notImplemented "SectionL"
+  SectionR {} -> notImplemented "SectionR"
+  ExplicitTuple {} -> notImplemented "ExplicitTuple"
+  ExplicitSum {} -> notImplemented "ExplicitSum"
+  HsCase e mgroup -> do
+    txt "case "
+    located e p_hsExpr
+    txt " of"
+    breakpoint
+    inci (p_matchGroup Case mgroup)
+  HsIf _ if' then' else' -> do
+    txt "if "
+    located if' p_hsExpr
+    breakpoint
+    inci (txt "then ")
+    located then' p_hsExpr
+    breakpoint
+    inci (txt "else ")
+    located else' p_hsExpr
+  HsMultiIf {} -> notImplemented "MulitiIf"
+  HsLet localBinds e -> do
+    txt "let "
+    inci (located localBinds p_hsLocalBinds)
+    breakpoint
+    txt "in "
+    located e p_hsExpr
+  HsDo {} -> notImplemented "HsDo"
+  ExplicitList _ _ xs -> do
+    brackets $ velt (withSep comma (located' p_hsExpr) xs)
+  ExplicitPArr {} -> notImplemented "ExplicitPArr"
+  RecordCon {} -> notImplemented "RecordCon"
+  RecordUpd {} -> notImplemented "RecordUpd"
+  ExprWithTySig {} -> notImplemented "ExprWithTySig"
+  ExprWithTySigOut {} -> notImplemented "ExprWithTySigOut"
+  ArithSeq {} -> notImplemented "ArithSeq"
+  PArrSeq {} -> notImplemented "PArrSeq"
+  HsSCC {} -> notImplemented "HsSCC"
+  HsCoreAnn {} -> notImplemented "HsCoreAnn"
+  HsBracket {} -> notImplemented "HsBracket"
+  HsRnBracketOut {} -> notImplemented "HsRnBracketOut"
+  HsTcBracketOut {} -> notImplemented "HsTcBracketOut"
+  HsSpliceE {} -> notImplemented "HsSpliceE"
+  HsProc {} -> notImplemented "HsProc"
+  HsStatic {} -> notImplemented "HsStatic"
+  HsArrApp {} -> notImplemented "HsArrApp"
+  HsArrForm {} -> notImplemented "HsArrForm"
+  HsTick {} -> notImplemented "HsTick"
+  HsBinTick {} -> notImplemented "HsBinTick"
+  HsTickPragma {} -> notImplemented "HsTickPragma"
+  EWildPat -> notImplemented "EWildPat"
+  EAsPat {} -> notImplemented "EAsPat"
+  EViewPat {} -> notImplemented "EViewPat"
+  ELazyPat {} -> notImplemented "ELazyPat"
+  HsWrap {} -> notImplemented "HsWrap"

src/Ormolu/Printer/Meat/Module.hs

@@ -10,13 +10,14 @@ where
 
 import Control.Monad
 import Data.Maybe (isJust)
-import GHC hiding (GhcPs, IE)
+import GHC
 import Ormolu.Imports
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Comments
 import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Declaration
 import Ormolu.Printer.Meat.ImportExport
+import Ormolu.Utils
 import SrcLoc (combineSrcSpans)
 
 p_hsModule :: ParsedSource -> R ()
@@ -43,7 +44,26 @@ p_hsModule loc@(L moduleSpan hsModule) = do
         when (not (null hsmodImports) || not (null hsmodDecls)) newline
     forM_ (sortImports hsmodImports) (located' p_hsmodImport)
     when (not (null hsmodImports) && not (null hsmodDecls)) newline
-    newlineSep (located' p_hsDecl) hsmodDecls
+
+    forM_ (zip hsmodDecls ((Just <$> drop 1 hsmodDecls) ++ [Nothing])) $
+      \(d, md) -> do
+        case md of
+          Nothing -> located d p_hsDecl
+          Just d' ->
+            if separatedDecls (unL d) (unL d')
+              then line (located d p_hsDecl)
+              else located d p_hsDecl
+
     trailingComments <- hasMoreComments
     when (trailingComments && isJust hsmodName) newline
     spitRemainingComments
+
+-- | Determine if these declarations should be separated by a blank line.
+
+separatedDecls
+  :: HsDecl GhcPs
+  -> HsDecl GhcPs
+  -> Bool
+separatedDecls (SigD (TypeSig (n:_) _)) (ValD (FunBind n' _ _ _ _)) =
+  unL n /= unL n'
+separatedDecls _ _ = True

src/Ormolu/Utils.hs

@@ -5,6 +5,7 @@ module Ormolu.Utils
   , isModule
   , unL
   , getSpan
+  , notImplemented
   )
 where
 
@@ -31,3 +32,8 @@ unL (L _ e) = e
 
 getSpan :: GenLocated l e -> l
 getSpan (L spn _) = spn
+
+-- | Placeholder for things that are not yet implemented.
+
+notImplemented :: String -> a
+notImplemented msg = error $ "not implemented yet: " ++ msg

tests/Ormolu/PrinterSpec.hs

@@ -23,21 +23,21 @@ spec = do
 
 checkExample :: Path Rel File -> Spec
 checkExample srcPath' = it (fromRelFile srcPath' ++ " works") $ do
-    let srcPath = examplesDir </> srcPath'
-    expectedOutputPath <- deriveOutput srcPath
-    -- 1. Given input snippet of source code parse it and pretty print it.
-    -- 2. Parse the result of pretty-printing again and make sure that AST
-    -- is the same as AST of the original snippet. (This happens in
-    -- 'ormoluFile' automatically.)
-    formatted0 <- ormoluFile defaultConfig (fromRelFile srcPath)
-    -- 3. Check the output against expected output. Thus all tests should
-    -- include two files: input and expected output.
-    expected <- (liftIO . T.readFile . fromRelFile) expectedOutputPath
-    formatted0 `shouldMatch` expected
-    -- 4. Check that running the formatter on the output produces the same
-    -- output again (the transformation is idempotent).
-    formatted1 <- ormolu defaultConfig "<formatted>" (T.unpack formatted0)
-    formatted1 `shouldMatch` formatted0
+  let srcPath = examplesDir </> srcPath'
+  expectedOutputPath <- deriveOutput srcPath
+  -- 1. Given input snippet of source code parse it and pretty print it.
+  -- 2. Parse the result of pretty-printing again and make sure that AST
+  -- is the same as AST of the original snippet. (This happens in
+  -- 'ormoluFile' automatically.)
+  formatted0 <- ormoluFile defaultConfig (fromRelFile srcPath)
+  -- 3. Check the output against expected output. Thus all tests should
+  -- include two files: input and expected output.
+  expected <- (liftIO . T.readFile . fromRelFile) expectedOutputPath
+  shouldMatch False formatted0 expected
+  -- 4. Check that running the formatter on the output produces the same
+  -- output again (the transformation is idempotent).
+  formatted1 <- ormolu defaultConfig "<formatted>" (T.unpack formatted0)
+  shouldMatch True formatted1 formatted0
 
 -- | Build list of examples for testing.
 
@@ -63,14 +63,19 @@ deriveOutput path = parseRelFile $
 -- | A version of 'shouldBe' that is specialized to comparing 'Text' values.
 -- It also prints multi-line snippets in a more readable form.
 
-shouldMatch :: Text -> Text -> Expectation
-shouldMatch actual expected  =
+shouldMatch :: Bool -> Text -> Text -> Expectation
+shouldMatch idempotencyTest actual expected  =
   when (actual /= expected) . expectationFailure $ unlines
-    [ "expected:"
+    [ "expected (" ++ pass ++ "):"
     , T.unpack expected
     , "but got:"
     , T.unpack actual
     ]
+  where
+    pass =
+      if idempotencyTest
+        then "idempotency pass"
+        else "first pass"
 
 examplesDir :: Path Rel Dir
 examplesDir = $(mkRelDir "data/examples")