git.iko.soy/ormolu
on master help sign in
Implemenet rendering of standalone deriving
commit5570439bb4bf8438c0b9d8cbd2d8fdffb02aff5e authorsphaso <sphaso@gmail.com> dateSun 9 Jun 2019, 16:03 (7 years ago) parent7e31ae7
6 files changed+174−8
compare with master
unifiedsplit
data/examples/declaration/deriving/multiline-out.hs+44 data/examples/declaration/deriving/multiline.hs+36 data/examples/declaration/deriving/singleline-out.hs+17 data/examples/declaration/deriving/singleline.hs+12 src/Ormolu/Printer/Meat/Declaration.hs+10−2 src/Ormolu/Printer/Meat/Declaration/Instance.hs+55−6
data/examples/declaration/deriving/multiline-out.hsnew file+44
@@ -0,0 +1,44 @@
1+deriving instance
2+ Eq
3+ Foo
4+
5+deriving stock instance
6+ Show
7+ Foo
8+
9+deriving anyclass instance
10+ ToJSON
11+ Foo
12+
13+deriving newtype instance
14+ Data
15+ Foo
16+
17+deriving instance
18+ {-# OVERLAPPABLE #-}
19+ Ord
20+ Foo
21+
22+deriving instance
23+ {-# OVERLAPPING #-}
24+ Num
25+ Foo
26+
27+deriving instance
28+ {-# OVERLAPS #-}
29+ Read
30+ Foo
31+
32+deriving instance
33+ {-# INCOHERENT #-}
34+ Show
35+ Foo
36+
37+deriving via
38+ Foo
39+ Int
40+ instance
41+ Triple
42+ A
43+ B
44+ C
data/examples/declaration/deriving/multiline.hsnew file+36
@@ -0,0 +1,36 @@
1+deriving instance Eq
2+ Foo
3+
4+deriving stock instance
5+ Show
6+ Foo
7+deriving anyclass instance
8+ ToJSON
9+ Foo
10+deriving newtype instance
11+ Data
12+ Foo
13+
14+deriving instance
15+ {-# OVERLAPPABLE #-}
16+ Ord
17+ Foo
18+deriving instance
19+ {-# OVERLAPPING #-}
20+ Num
21+ Foo
22+deriving instance
23+ {-# OVERLAPS #-}
24+ Read
25+ Foo
26+deriving instance
27+ {-# INCOHERENT #-}
28+ Show
29+ Foo
30+
31+deriving via Foo
32+ Int
33+ instance Triple
34+ A
35+ B
36+ C
data/examples/declaration/deriving/singleline-out.hsnew file+17
@@ -0,0 +1,17 @@
1+deriving instance Eq Foo
2+
3+deriving stock instance Show Foo
4+
5+deriving anyclass instance ToJSON Foo
6+
7+deriving newtype instance Data Foo
8+
9+deriving instance {-# OVERLAPPABLE #-} Ord Foo
10+
11+deriving instance {-# OVERLAPPING #-} Num Foo
12+
13+deriving instance {-# OVERLAPS #-} Read Foo
14+
15+deriving instance {-# INCOHERENT #-} Show Foo
16+
17+deriving via Int instance Triple A B C
data/examples/declaration/deriving/singleline.hsnew file+12
@@ -0,0 +1,12 @@
1+deriving instance Eq Foo
2+
3+deriving stock instance Show Foo
4+deriving anyclass instance ToJSON Foo
5+deriving newtype instance Data Foo
6+
7+deriving instance {-# OVERLAPPABLE #-} Ord Foo
8+deriving instance {-# OVERLAPPING #-} Num Foo
9+deriving instance {-# OVERLAPS #-} Read Foo
10+deriving instance {-# INCOHERENT #-} Show Foo
11+
12+deriving via Int instance Triple A B C
src/Ormolu/Printer/Meat/Declaration.hs+10−2
@@ -27,7 +27,7 @@ p_hsDecl = \case
2727 ValD NoExt x -> p_valDecl x
2828 SigD NoExt x -> p_sigDecl x
2929 InstD NoExt x -> p_instDecl x
30− DerivD _ _ -> notImplemented "DerivD"
30+ DerivD NoExt x -> p_derivDecl x
3131 DefD _ _ -> notImplemented "DefD"
3232 ForD _ _ -> notImplemented "ForD"
3333 WarningD _ _ -> notImplemented "WarningD"
@@ -61,4 +61,12 @@ p_instDecl = \case
6161 ClsInstD NoExt x -> p_clsInstDecl x
6262 TyFamInstD NoExt x -> p_tyFamInstDecl Free x
6363 DataFamInstD NoExt x -> p_dataFamInstDecl Free x
64− _ -> notImplemented "certain kinds of declarations"
64+ XInstDecl _ -> notImplemented "XInstDecl"
65+
66+p_derivDecl :: DerivDecl GhcPs -> R ()
67+p_derivDecl = \case
68+ d@DerivDecl {..} -> p_standaloneDerivDecl d
69+ XDerivDecl _ -> notImplemented "XDerivDecl standalone deriving"
70+
71+----------------------------------------------------------------------------
72+-- Helpers
src/Ormolu/Printer/Meat/Declaration/Instance.hs+55−6
@@ -8,6 +8,7 @@ module Ormolu.Printer.Meat.Declaration.Instance
88 ( p_clsInstDecl
99 , p_tyFamInstDecl
1010 , p_dataFamInstDecl
11+ , p_standaloneDerivDecl
1112 )
1213where
1314
@@ -26,16 +27,47 @@ import Ormolu.Printer.Meat.Declaration.Value
2627import Ormolu.Printer.Meat.Type
2728import Ormolu.Utils
2829
30+p_standaloneDerivDecl :: DerivDecl GhcPs -> R ()
31+p_standaloneDerivDecl DerivDecl {..} = do
32+ let typesAfterInstance = located (hsib_body (hswc_body deriv_type)) p_hsType
33+ instTypes toIndent = inci $ do
34+ txt "instance"
35+ breakpoint
36+ match_overlap_mode deriv_overlap_mode breakpoint
37+ if toIndent
38+ then inci typesAfterInstance
39+ else typesAfterInstance
40+ txt "deriving"
41+ case deriv_strategy of
42+ Nothing -> do
43+ space
44+ instTypes False
45+ Just l -> locatedVia Nothing l $ \case
46+ StockStrategy -> do
47+ txt " stock "
48+ instTypes False
49+ AnyclassStrategy -> do
50+ txt " anyclass "
51+ instTypes False
52+ NewtypeStrategy -> do
53+ txt " newtype "
54+ instTypes False
55+ ViaStrategy HsIB {..} -> do
56+ txt " via"
57+ breakpoint
58+ inci (located hsib_body p_hsType)
59+ breakpoint
60+ instTypes True
61+ ViaStrategy (XHsImplicitBndrs NoExt) ->
62+ notImplemented "XHsImplicitBndrs"
63+ newline
64+p_standaloneDerivDecl (XDerivDecl _) = notImplemented "XDerivDecl"
65+
2966p_clsInstDecl :: ClsInstDecl GhcPs -> R ()
3067p_clsInstDecl = \case
3168 ClsInstDecl {..} -> do
3269 txt "instance "
33− case unLoc <$> cid_overlap_mode of
34− Just Overlappable {} -> txt "{-# OVERLAPPABLE #-} "
35− Just Overlapping {} -> txt "{-# OVERLAPPING #-} "
36− Just Overlaps {} -> txt "{-# OVERLAPS #-} "
37− Just Incoherent {} -> txt "{-# INCOHERENT #-} "
38− _ -> pure ()
70+ match_overlap_mode cid_overlap_mode space
3971 case cid_poly_ty of
4072 HsIB {..} -> sitcc (located hsib_body p_hsType)
4173 XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"
@@ -81,3 +113,20 @@ p_dataFamInstDecl style = \case
81113 let HsIB {..} = dfid_eqn
82114 FamEqn {..} = hsib_body
83115 p_dataDecl style feqn_tycon feqn_pats feqn_rhs
116+
117+match_overlap_mode :: Maybe (Located OverlapMode) -> R () -> R ()
118+match_overlap_mode overlap_mode layoutStrategy =
119+ case unLoc <$> overlap_mode of
120+ Just Overlappable {} -> do
121+ txt "{-# OVERLAPPABLE #-}"
122+ layoutStrategy
123+ Just Overlapping {} -> do
124+ txt "{-# OVERLAPPING #-}"
125+ layoutStrategy
126+ Just Overlaps {} -> do
127+ txt "{-# OVERLAPS #-}"
128+ layoutStrategy
129+ Just Incoherent {} -> do
130+ txt "{-# INCOHERENT #-}"
131+ layoutStrategy
132+ _ -> pure ()