4955cdc · ormolu · git.iko.soy

git.iko.soy/ormolu

Add MinimalSig printer

commit4955cdc4bc59e1bddc0bfe837f686392c7ae0767 authorBasile Henry <bjm.henry@gmail.com> dateSat 15 Jun 2019, 00:49 (7 years ago) parent7307b6d

11 files changed+89−58

compare with master

unifiedsplit

data/examples/declaration/signature/minimal/minimal-out.hs+12 data/examples/declaration/signature/minimal/minimal.hs+10 src/Ormolu/Imports.hs+12−12 src/Ormolu/Printer/Combinators.hs+11−13 src/Ormolu/Printer/Comments.hs+2−2 src/Ormolu/Printer/Meat/Declaration/Data.hs+3−3 src/Ormolu/Printer/Meat/Declaration/Signature.hs+22 src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+2−2 src/Ormolu/Printer/Meat/Declaration/Value.hs+9−9 src/Ormolu/Printer/Meat/Module.hs+6−5 src/Ormolu/Utils.hs−12

data/examples/declaration/signature/minimal/minimal-out.hsnew file+12

@@ -0,0 +1,12 @@

1+class Foo a where

2+ {-# MINIMAL (==) | ((/=), foo) #-}

3+ {-# MINIMAL

4+ a

5+ | ( b, c, d

6+ | e

7+ , f

8+ )

9+ | g

10+ #-}

11+ (==) :: a -> a -> Bool

12+ (/=) :: a -> a -> Bool

data/examples/declaration/signature/minimal/minimal.hsnew file+10

@@ -0,0 +1,10 @@

1+class Foo a where

3+ {-# MINIMAL (==) |( (/=) , foo) #-}

5+ {-# MINIMAL a | (b , c , d | e

6+ , f)

7+ | g #-}

9+ (==) :: a -> a -> Bool

10+ (/=) :: a -> a -> Bool

src/Ormolu/Imports.hs+12−12

@@ -14,7 +14,7 @@ import Data.List (sortBy)

1414import GHC hiding (GhcPs, IE)

1515import HsExtension

1616import HsImpExp (IE (..))

17−import Ormolu.Utils (unL, notImplemented)

17+import Ormolu.Utils (notImplemented)

1818

1919-- | Sort imports by module name. This also sorts explicit import lists for

2020-- each declaration.

@@ -37,21 +37,21 @@ compareIdecl (L _ m0) (L _ m1) =

3737 then LT

3838 else n0 `compare` n1

3939 where

40− n0 = unL (ideclName m0)

41− n1 = unL (ideclName m1)

40+ n0 = unLoc (ideclName m0)

41+ n1 = unLoc (ideclName m1)

4242 isPrelude = (== "Prelude") . moduleNameString

4343

4444-- | Sort located import or export.

4545

4646sortLies :: [LIE GhcPs] -> [LIE GhcPs]

47−sortLies = sortBy (compareIE `on` unL) . fmap (fmap sortThings)

47+sortLies = sortBy (compareIE `on` unLoc) . fmap (fmap sortThings)

4848

4949-- | Sort imports\/exports inside of 'IEThingWith'.

5050

5151sortThings :: IE GhcPs -> IE GhcPs

5252sortThings = \case

5353 IEThingWith NoExt x w xs fl ->

54− IEThingWith NoExt x w (sortBy (compareIewn `on` unL) xs) fl

54+ IEThingWith NoExt x w (sortBy (compareIewn `on` unLoc) xs) fl

5555 other -> other

5656

5757-- | Compare two located imports or exports.

@@ -63,10 +63,10 @@ compareIE = compareIewn `on` getIewn

6363

6464getIewn :: IE GhcPs -> IEWrappedName RdrName

6565getIewn = \case

66− IEVar NoExt x -> unL x

67− IEThingAbs NoExt x -> unL x

68− IEThingAll NoExt x -> unL x

69− IEThingWith NoExt x _ _ _ -> unL x

66+ IEVar NoExt x -> unLoc x

67+ IEThingAbs NoExt x -> unLoc x

68+ IEThingAll NoExt x -> unLoc x

69+ IEThingWith NoExt x _ _ _ -> unLoc x

7070 IEModuleContents NoExt _ -> notImplemented "IEModuleContents"

7171 IEGroup NoExt _ _ -> notImplemented "IEGroup"

7272 IEDoc NoExt _ -> notImplemented "IEDoc"

@@ -76,12 +76,12 @@ getIewn = \case

7676-- | Compare two @'IEWrapppedName' 'RdrName'@ things.

7777

7878compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering

79−compareIewn (IEName x) (IEName y) = unL x `compare` unL y

79+compareIewn (IEName x) (IEName y) = unLoc x `compare` unLoc y

8080compareIewn (IEName _) (IEPattern _) = LT

8181compareIewn (IEName _) (IEType _) = LT

8282compareIewn (IEPattern _) (IEName _) = GT

83−compareIewn (IEPattern x) (IEPattern y) = unL x `compare` unL y

83+compareIewn (IEPattern x) (IEPattern y) = unLoc x `compare` unLoc y

8484compareIewn (IEPattern _) (IEType _) = LT

8585compareIewn (IEType _) (IEName _) = GT

8686compareIewn (IEType _) (IEPattern _) = GT

87−compareIewn (IEType x) (IEType y) = unL x `compare` unL y

87+compareIewn (IEType x) (IEType y) = unLoc x `compare` unLoc y

src/Ormolu/Printer/Combinators.hs+11−13

@@ -50,7 +50,7 @@ import Data.List (intersperse)

5050import Data.Text (Text)

5151import Ormolu.Printer.Comments

5252import Ormolu.Printer.Internal

53−import Ormolu.Utils (unL, getSpan, isModule)

53+import Ormolu.Utils (isModule)

5454import Outputable (Outputable (..), showSDocUnsafe)

5555import SrcLoc

5656import qualified Data.Text as T

@@ -101,15 +101,15 @@ locatedVia ml loc f = do

101101 RealSrcSpan l' -> g (L l' a)

102102 withRealLocated loc spitPrecedingComments

103103 let setEnclosingSpan =

104− case getSpan loc of

104+ case getLoc loc of

105105 UnhelpfulSpan _ -> id

106106 RealSrcSpan orf ->

107− if isModule (unL loc)

107+ if isModule (unLoc loc)

108108 then id

109109 else withEnclosingSpan orf

110110 setEnclosingSpan $ case ml of

111− Nothing -> f (unL loc)

112− Just l' -> switchLayout l' (f (unL loc))

111+ Nothing -> f (unLoc loc)

112+ Just l' -> switchLayout l' (f (unLoc loc))

113113 withRealLocated loc spitFollowingComments

114114

115115-- | A version of 'located' with arguments flipped.

@@ -271,19 +271,17 @@ pragmaBraces m = sitcc $ do

271271 vlayout space (newline >> txt " ")

272272 txt "#-}"

273273

274−-- | This surrounds the body in a pragma, which includes the 'pragmaBraces' and

275−--- the keyword for the pragma. It also takes a 'SrcSpan', which should be the

276−--- combined span of the body. This means multiline layouts are only triggered

277−--- when the body spans multiple lines, not just when the braces or pragma

278−--- keyword do.

274+-- | Surround the body with a pragma name and 'pragmaBraces'.

279275

280−pragma :: SrcSpan -> Text -> R () -> R ()

281−pragma srcSpan pragmaText body = switchLayout srcSpan . pragmaBraces $ do

276+pragma

277+ :: Text -- ^ Pragma text

278+ -> R () -- ^ Pragma body

279+ -> R ()

280+pragma pragmaText body = pragmaBraces $ do

282281 txt pragmaText

283282 breakpoint

284283 inci body

285284

286−

287285-- | Surround given entity by optional space before and a newline after, iff

288286-- current layout is multiline.

289287

src/Ormolu/Printer/Comments.hs+2−2

@@ -18,7 +18,7 @@ import Data.Data (Data)

1818import Data.Maybe (isJust)

1919import Ormolu.CommentStream

2020import Ormolu.Printer.Internal

21−import Ormolu.Utils (isModule, getSpan)

21+import Ormolu.Utils (isModule)

2222import SrcLoc

2323import qualified Data.List.NonEmpty as NE

2424import qualified Data.Text as T

@@ -41,7 +41,7 @@ spitFollowingComments

4141 => RealLocated a -- ^ AST element of attach comments to

4242 -> R ()

4343spitFollowingComments ref = do

44− trimSpanStream (getSpan ref)

44+ trimSpanStream (getLoc ref)

4545 handleCommentSeries (spitFollowingComment ref)

4646

4747-- | Output all remaining comments in the comment stream.

src/Ormolu/Printer/Meat/Declaration/Data.hs+3−3

@@ -42,13 +42,13 @@ p_dataDecl style name tpats HsDataDefn {..} = do

4242 space

4343 txt ":: "

4444 located k p_hsType

45− let gadt = isJust dd_kindSig || any (isGadt . unL) dd_cons

45+ let gadt = isJust dd_kindSig || any (isGadt . unLoc) dd_cons

4646 if gadt

4747 then do

4848 txt " where"

4949 newline

5050 inci $ newlineSep (sitcc . located' p_conDecl) dd_cons

51− else switchLayout (combineSrcSpans' (getSpan name :| (getSpan <$> dd_cons))) $ do

51+ else switchLayout (combineSrcSpans' (getLoc name :| (getLoc <$> dd_cons))) $ do

5252 breakpoint

5353 inci $ do

5454 txt "= "

@@ -76,7 +76,7 @@ p_conDecl = \case

7676 txt "-> "

7777 RecCon l -> do

7878 located l p_conDeclFields

79− unless (null $ unL l) $ do

79+ unless (null $ unLoc l) $ do

8080 breakpoint

8181 txt "-> "

8282 InfixCon _ _ -> notImplemented "InfixCon"

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

@@ -12,6 +12,7 @@ module Ormolu.Printer.Meat.Declaration.Signature

1212where

1313

1414import BasicTypes

15+import BooleanFormula

1516import Control.Monad

1617import GHC

1718import Ormolu.Printer.Combinators

@@ -30,6 +31,7 @@ p_sigDecl' = \case

3031 FixSig NoExt sig -> p_fixSig sig

3132 InlineSig NoExt name inlinePragma -> p_inlineSig name inlinePragma

3233 SpecSig NoExt name ts inlinePragma -> p_specSig name ts inlinePragma

34+ MinimalSig NoExt _ booleanFormula -> p_minimalSig booleanFormula

3335 _ -> notImplemented "certain types of signature declarations"

3436

3537p_typeSig

@@ -135,3 +137,23 @@ p_activation = \case

135137 atom n

136138 txt "]"

137139 space

140+

141+p_minimalSig

142+ :: LBooleanFormula (Located RdrName) -- ^ Boolean formula

143+ -> R ()

144+p_minimalSig =

145+ located' $ \booleanFormula ->

146+ pragma "MINIMAL" (p_booleanFormula booleanFormula)

147+

148+p_booleanFormula

149+ :: BooleanFormula (Located RdrName) -- ^ Boolean formula

150+ -> R ()

151+p_booleanFormula = \case

152+ Var name -> p_rdrName name

153+ And xs -> velt $

154+ withSep comma (located' p_booleanFormula) xs

155+ Or xs -> velt $

156+ withSep (vlayout space (return ()) >> txt "| ")

157+ (located' p_booleanFormula)

158+ xs

159+ Parens l -> located l (parens . p_booleanFormula)

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+2−2

@@ -32,7 +32,7 @@ p_famDecl style FamilyDecl {..} = do

3232 Free -> " family"

3333 let HsQTvs {..} = fdTyVars

3434 combinedSpans = combineSrcSpans' $

35− getSpan fdLName :| fmap getSpan hsq_explicit

35+ getLoc fdLName :| fmap getLoc hsq_explicit

3636 breakpoint

3737 inci $ do

3838 switchLayout combinedSpans $ do

@@ -88,7 +88,7 @@ p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()

8888p_tyFamInstEqn HsIB {..} = do

8989 let FamEqn {..} = hsib_body

9090 combinedSpans = combineSrcSpans' $

91− getSpan feqn_tycon :| fmap getSpan feqn_pats

91+ getLoc feqn_tycon :| fmap getLoc feqn_pats

9292 switchLayout combinedSpans $ p_infixDefHelper

9393 (isInfix feqn_fixity)

9494 inci

src/Ormolu/Printer/Meat/Declaration/Value.hs+9−9

@@ -97,7 +97,7 @@ p_match style isInfix m_pats m_grhss = do

9797 _ -> return ()

9898 Just ne_pats -> do

9999 let combinedSpans = combineSrcSpans' $

100− getSpan <$> ne_pats

100+ getLoc <$> ne_pats

101101 inci' = if isOneLineSpan combinedSpans

102102 then id

103103 else inci

@@ -127,7 +127,7 @@ p_match style isInfix m_pats m_grhss = do

127127 Case -> unless hasGuards (txt " ->")

128128 _ -> txt " ->"

129129 let combinedSpans = combineSrcSpans' $

130− getGRHSSpan . unL <$> NE.fromList grhssGRHSs

130+ getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

131131 placement = blockPlacement grhssGRHSs

132132 inciLocalBinds = case placement of

133133 Normal -> id

@@ -142,7 +142,7 @@ p_match style isInfix m_pats m_grhss = do

142142 _ -> EqualSign

143143 newlineSep (located' (p_grhs groupStyle)) grhssGRHSs

144144 unless

145− (GHC.isEmptyLocalBindsPR (unL grhssLocalBinds))

145+ (GHC.isEmptyLocalBindsPR (unLoc grhssLocalBinds))

146146 (inciLocalBinds $ do

147147 newline

148148 line (txt "where")

@@ -195,8 +195,8 @@ p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()

195195p_hsLocalBinds = \case

196196 HsValBinds NoExt (ValBinds NoExt bag lsigs) -> do

197197 let ssStart = either

198− (srcSpanStart . getSpan)

199− (srcSpanStart . getSpan)

198+ (srcSpanStart . getLoc)

199+ (srcSpanStart . getLoc)

200200 items =

201201 (Left <$> bagToList bag) ++ (Right <$> lsigs)

202202 p_item (Left x) = located x p_valDecl'

@@ -261,7 +261,7 @@ p_hsExpr = \case

261261 located x p_hsExpr

262262 space

263263 located op p_hsExpr

264− placeHanging (exprPlacement (unL y)) $

264+ placeHanging (exprPlacement (unLoc y)) $

265265 located y p_hsExpr

266266 NegApp NoExt e _ -> do

267267 txt "-"

@@ -276,7 +276,7 @@ p_hsExpr = \case

276276 breakpoint

277277 inci (located x p_hsExpr)

278278 ExplicitTuple NoExt args boxity -> do

279− let isSection = any (isMissing . unL) args

279+ let isSection = any (isMissing . unLoc) args

280280 isMissing = \case

281281 Missing NoExt -> True

282282 _ -> False

@@ -566,7 +566,7 @@ p_quasiQuote quoter m = do

566566-- Helpers

567567

568568getGRHSSpan :: GRHS GhcPs (LHsExpr GhcPs) -> SrcSpan

569−getGRHSSpan (GRHS NoExt _ body) = getSpan body

569+getGRHSSpan (GRHS NoExt _ body) = getLoc body

570570getGRHSSpan (XGRHS NoExt) = notImplemented "XGRHS"

571571

572572-- | Place a thing that may have a hanging form. This function handles how

@@ -602,7 +602,7 @@ exprPlacement = \case

602602 _ -> Normal

603603

604604withGuards :: [LGRHS GhcPs (LHsExpr GhcPs)] -> Bool

605−withGuards = any (checkOne . unL)

605+withGuards = any (checkOne . unLoc)

606606 where

607607 checkOne :: GRHS GhcPs (LHsExpr GhcPs) -> Bool

608608 checkOne (GRHS NoExt [] _) = False

src/Ormolu/Printer/Meat/Module.hs+6−5

@@ -23,6 +23,7 @@ import Ormolu.Printer.Meat.Declaration

2323import Ormolu.Printer.Meat.ImportExport

2424import Ormolu.Utils

2525import SrcLoc (combineSrcSpans)

26+import qualified Data.List.NonEmpty as NE

2627

2728p_hsModule :: ParsedSource -> R ()

2829p_hsModule loc@(L moduleSpan hsModule) = do

@@ -38,7 +39,7 @@ p_hsModule loc@(L moduleSpan hsModule) = do

3839 Nothing -> pure ()

3940 Just hsmodName' -> line $ do

4041 located hsmodName' p_hsmodName

41− maybe (pure ()) (located' p_warningTxt) hsmodDeprecMessage

42+ forM_ hsmodDeprecMessage (located' p_warningTxt)

4243 case hsmodExports of

4344 Nothing -> return ()

4445 Just hsmodExports' -> do

@@ -55,7 +56,7 @@ p_hsModule loc@(L moduleSpan hsModule) = do

5556 case md of

5657 Nothing -> located d p_hsDecl

5758 Just d' ->

58− if separatedDecls (unL d) (unL d')

59+ if separatedDecls (unLoc d) (unLoc d')

5960 then line (located d p_hsDecl)

6061 else located d p_hsDecl

6162

@@ -63,7 +64,7 @@ p_hsModule loc@(L moduleSpan hsModule) = do

6364 when (trailingComments && isJust hsmodName) newline

6465 spitRemainingComments

6566

66−-- | Layout the WARNING/DEPRECATED pragmas in the module head

67+-- | Layout the WARNING\/DEPRECATED pragmas in the module head.

6768

6869p_warningTxt :: WarningTxt -> R ()

6970p_warningTxt = \case

@@ -73,10 +74,10 @@ p_warningTxt = \case

7374 p_pragma :: Text -> [Located StringLiteral] -> R ()

7475 p_pragma pragmaText lits = switchLayout (litsSpan lits) $ do

7576 breakpoint

76− inci $ pragma (litsSpan lits) pragmaText (p_lits lits)

77+ inci $ pragma pragmaText (p_lits lits)

7778

7879 litsSpan :: [Located StringLiteral] -> SrcSpan

79− litsSpan lits = combineSrcSpans (getLoc $ head lits) (getLoc $ last lits)

80+ litsSpan lits = combineSrcSpans' (getLoc <$> NE.fromList lits)

8081

8182 p_lits :: [Located StringLiteral] -> R ()

8283 p_lits = \case

src/Ormolu/Utils.hs−12

@@ -3,8 +3,6 @@

33module Ormolu.Utils

44 ( combineSrcSpans'

55 , isModule

6− , unL

7− , getSpan

86 , notImplemented

97 )

108where

@@ -23,16 +21,6 @@ combineSrcSpans' (x:|xs) = foldr combineSrcSpans x xs

2321isModule :: Data a => a -> Bool

2422isModule x = showConstr (toConstr x) == "HsModule"

2523

26−-- | Exact inner value from a 'Located' thing.

27−

28−unL :: GenLocated l e -> e

29−unL (L _ e) = e

30−

31−-- | Get source span from a 'Located' thing.

32−

33−getSpan :: GenLocated l e -> l

34−getSpan (L spn _) = spn

35−

3624-- | Placeholder for things that are not yet implemented.

3725

3826notImplemented :: String -> a