git.iko.soy/ormolu
on master help sign in
Fix record pattern synonyms
commitbdb22b96ac114223f8de4ec6012390a8d238810c authorMauricio Fierro <mauriciofierrom@gmail.com> dateMon 15 Jul 2019, 18:26 (7 years ago) parentbe53b3e
5 files changed+65−22
compare with master
unifiedsplit
data/examples/declaration/value/pattern-synonyms/bidirectional-out.hs+14 data/examples/declaration/value/pattern-synonyms/bidirectional.hs+8 data/examples/declaration/value/pattern-synonyms/unidirectional-out.hs+12 data/examples/declaration/value/pattern-synonyms/unidirectional.hs+9 src/Ormolu/Printer/Meat/Declaration/Value.hs+22−22
data/examples/declaration/value/pattern-synonyms/bidirectional-out.hs+14
@@ -1,10 +1,24 @@
1+{-# LANGUAGE NamedFieldPuns #-}
12{-# LANGUAGE PatternSynonyms #-}
23
34pattern Arrow t1 t2 = App "->" [t1, t2]
45
6+pattern Arrow {t1, t2} = App "->" [t1, t2]
7+
8+pattern Arrow
9+ { t1,
10+ t2
11+ } =
12+ App "->" [t1, t2]
13+
514pattern Int =
615 App "Int" []
716
17+pattern Maybe {t} =
18+ App
19+ "Maybe"
20+ [t]
21+
822pattern Maybe t =
923 App
1024 "Maybe"
data/examples/declaration/value/pattern-synonyms/bidirectional.hs+8
@@ -1,8 +1,16 @@
11{-# LANGUAGE PatternSynonyms #-}
2+{-# LANGUAGE NamedFieldPuns #-}
23
34pattern Arrow t1 t2 = App "->" [t1, t2]
5+pattern Arrow{t1,t2} = App "->" [t1,t2]
6+pattern Arrow{t1
7+ , t2} = App "->" [t1, t2]
48pattern Int =
59 App "Int" []
10+pattern Maybe{t} =
11+ App
12+ "Maybe"
13+ [t]
614pattern Maybe t =
715 App
816 "Maybe"
data/examples/declaration/value/pattern-synonyms/unidirectional-out.hs+12
@@ -5,6 +5,18 @@ pattern Head x <- x : xs
55pattern Head' x <-
66 x : xs
77
8+pattern Head'' {x} <-
9+ x : xs
10+
11+pattern FirstTwo {x, y} <-
12+ x : (y : xs)
13+
14+pattern FirstTwo'
15+ { x,
16+ y
17+ } <-
18+ x : (y : xs)
19+
820pattern Simple <- "Simple"
921
1022pattern WithTypeSig :: String
data/examples/declaration/value/pattern-synonyms/unidirectional.hs+9
@@ -5,6 +5,15 @@ pattern Head x <- x:xs
55pattern Head' x
66 <- x:xs
77
8+pattern Head''{x}
9+ <- x:xs
10+
11+pattern FirstTwo{x,y}
12+ <- x : (y : xs)
13+
14+pattern FirstTwo'{x
15+ , y} <- x : (y:xs)
16+
817pattern Simple <- "Simple"
918
1019pattern WithTypeSig :: String
src/Ormolu/Printer/Meat/Declaration/Value.hs+22−22
@@ -10,6 +10,7 @@ module Ormolu.Printer.Meat.Declaration.Value
1010 )
1111where
1212
13+import Ormolu.Printer.Internal
1314import Bag (bagToList)
1415import BasicTypes
1516import Control.Monad
@@ -633,34 +634,29 @@ p_hsExpr = \case
633634p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
634635p_patSynBind PSB {..} = do
635636 txt "pattern "
636− let nonEmptySynDetails = \case
637− PrefixCon (_:_) -> True
638− RecCon (_:_) -> True
639− _ -> False
640637 case psb_dir of
641638 Unidirectional -> do
642639 p_rdrName psb_id
643− when (nonEmptySynDetails psb_args) space
644− p_patSynDetails psb_args
645− txt " <-"
646− breakpoint
647− inci (located psb_def p_pat)
640+ inci $ do
641+ p_patSynDetails psb_args
642+ txt " <-"
643+ breakpoint
644+ located psb_def p_pat
648645 ImplicitBidirectional -> do
649646 p_rdrName psb_id
650− when (nonEmptySynDetails psb_args) space
651− p_patSynDetails psb_args
652− txt " ="
653− breakpoint
654− inci (located psb_def p_pat)
647+ inci $ do
648+ p_patSynDetails psb_args
649+ txt " ="
650+ breakpoint
651+ located psb_def p_pat
655652 ExplicitBidirectional mgroup -> do
656653 p_rdrName psb_id
657− when (nonEmptySynDetails psb_args) space
658− p_patSynDetails psb_args
659− txt " <-"
660− breakpoint
661− inci (located psb_def p_pat)
662− newline
663654 inci $ do
655+ p_patSynDetails psb_args
656+ txt " <-"
657+ breakpoint
658+ located psb_def p_pat
659+ newline
664660 line (txt "where")
665661 inci (p_matchGroup (Function psb_id) mgroup)
666662p_patSynBind (XPatSynBind NoExt) = notImplemented "XPatSynBind"
@@ -668,9 +664,13 @@ p_patSynBind (XPatSynBind NoExt) = notImplemented "XPatSynBind"
668664p_patSynDetails :: HsPatSynDetails (Located RdrName) -> R ()
669665p_patSynDetails = \case
670666 PrefixCon xs ->
671− sitcc $ sep breakpoint p_rdrName xs
667+ switchLayout (getLoc <$> xs) $ do
668+ unless (null xs) breakpoint
669+ sitcc (sep breakpoint p_rdrName xs)
672670 RecCon xs ->
673− sitcc $ sep breakpoint (p_rdrName . recordPatSynPatVar) xs
671+ switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do
672+ unless (null xs) breakpoint
673+ braces . sitcc $ sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs
674674 InfixCon _ _ -> notImplemented "InfixCon"
675675
676676p_pat :: Pat GhcPs -> R ()