diff --git a/data/examples/declaration/value/pattern-synonyms/bidirectional-out.hs b/data/examples/declaration/value/pattern-synonyms/bidirectional-out.hs index 4577887..f205689 100644 --- a/data/examples/declaration/value/pattern-synonyms/bidirectional-out.hs +++ b/data/examples/declaration/value/pattern-synonyms/bidirectional-out.hs @@ -1,10 +1,24 @@ +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} pattern Arrow t1 t2 = App "->" [t1, t2] +pattern Arrow {t1, t2} = App "->" [t1, t2] + +pattern Arrow + { t1, + t2 + } = + App "->" [t1, t2] + pattern Int = App "Int" [] +pattern Maybe {t} = + App + "Maybe" + [t] + pattern Maybe t = App "Maybe" diff --git a/data/examples/declaration/value/pattern-synonyms/bidirectional.hs b/data/examples/declaration/value/pattern-synonyms/bidirectional.hs index 59c35ad..3cfa873 100644 --- a/data/examples/declaration/value/pattern-synonyms/bidirectional.hs +++ b/data/examples/declaration/value/pattern-synonyms/bidirectional.hs @@ -1,8 +1,16 @@ {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE NamedFieldPuns #-} pattern Arrow t1 t2 = App "->" [t1, t2] +pattern Arrow{t1,t2} = App "->" [t1,t2] +pattern Arrow{t1 + , t2} = App "->" [t1, t2] pattern Int = App "Int" [] +pattern Maybe{t} = + App + "Maybe" + [t] pattern Maybe t = App "Maybe" diff --git a/data/examples/declaration/value/pattern-synonyms/unidirectional-out.hs b/data/examples/declaration/value/pattern-synonyms/unidirectional-out.hs index bb5d651..023ceb0 100644 --- a/data/examples/declaration/value/pattern-synonyms/unidirectional-out.hs +++ b/data/examples/declaration/value/pattern-synonyms/unidirectional-out.hs @@ -5,6 +5,18 @@ pattern Head x <- x : xs pattern Head' x <- x : xs +pattern Head'' {x} <- + x : xs + +pattern FirstTwo {x, y} <- + x : (y : xs) + +pattern FirstTwo' + { x, + y + } <- + x : (y : xs) + pattern Simple <- "Simple" pattern WithTypeSig :: String diff --git a/data/examples/declaration/value/pattern-synonyms/unidirectional.hs b/data/examples/declaration/value/pattern-synonyms/unidirectional.hs index 17ecaf9..d94a890 100644 --- a/data/examples/declaration/value/pattern-synonyms/unidirectional.hs +++ b/data/examples/declaration/value/pattern-synonyms/unidirectional.hs @@ -5,6 +5,15 @@ pattern Head x <- x:xs pattern Head' x <- x:xs +pattern Head''{x} + <- x:xs + +pattern FirstTwo{x,y} + <- x : (y : xs) + +pattern FirstTwo'{x + , y} <- x : (y:xs) + pattern Simple <- "Simple" pattern WithTypeSig :: String diff --git a/src/Ormolu/Printer/Meat/Declaration/Value.hs b/src/Ormolu/Printer/Meat/Declaration/Value.hs index 2f50c57..632bfe0 100644 --- a/src/Ormolu/Printer/Meat/Declaration/Value.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Value.hs @@ -10,6 +10,7 @@ module Ormolu.Printer.Meat.Declaration.Value ) where +import Ormolu.Printer.Internal import Bag (bagToList) import BasicTypes import Control.Monad @@ -633,34 +634,29 @@ p_hsExpr = \case p_patSynBind :: PatSynBind GhcPs GhcPs -> R () p_patSynBind PSB {..} = do txt "pattern " - let nonEmptySynDetails = \case - PrefixCon (_:_) -> True - RecCon (_:_) -> True - _ -> False case psb_dir of Unidirectional -> do p_rdrName psb_id - when (nonEmptySynDetails psb_args) space - p_patSynDetails psb_args - txt " <-" - breakpoint - inci (located psb_def p_pat) + inci $ do + p_patSynDetails psb_args + txt " <-" + breakpoint + located psb_def p_pat ImplicitBidirectional -> do p_rdrName psb_id - when (nonEmptySynDetails psb_args) space - p_patSynDetails psb_args - txt " =" - breakpoint - inci (located psb_def p_pat) + inci $ do + p_patSynDetails psb_args + txt " =" + breakpoint + located psb_def p_pat ExplicitBidirectional mgroup -> do p_rdrName psb_id - when (nonEmptySynDetails psb_args) space - p_patSynDetails psb_args - txt " <-" - breakpoint - inci (located psb_def p_pat) - newline inci $ do + p_patSynDetails psb_args + txt " <-" + breakpoint + located psb_def p_pat + newline line (txt "where") inci (p_matchGroup (Function psb_id) mgroup) p_patSynBind (XPatSynBind NoExt) = notImplemented "XPatSynBind" @@ -668,9 +664,13 @@ p_patSynBind (XPatSynBind NoExt) = notImplemented "XPatSynBind" p_patSynDetails :: HsPatSynDetails (Located RdrName) -> R () p_patSynDetails = \case PrefixCon xs -> - sitcc $ sep breakpoint p_rdrName xs + switchLayout (getLoc <$> xs) $ do + unless (null xs) breakpoint + sitcc (sep breakpoint p_rdrName xs) RecCon xs -> - sitcc $ sep breakpoint (p_rdrName . recordPatSynPatVar) xs + switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do + unless (null xs) breakpoint + braces . sitcc $ sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs InfixCon _ _ -> notImplemented "InfixCon" p_pat :: Pat GhcPs -> R ()