git.iko.soy/ormolu
on master help sign in
Implement view patterns
59bc871waddlaw
data/examples/declaration/value/function/view-pattern-out.hsnew file+14
compare with master
unifiedsplit
@@ -0,0 +1,14 @@
1+{-# LANGUAGE ViewPatterns #-}
2+example f (f -> 4) = True
3+
4+f (t -> Nothing) = "Nothing"
5+f (t -> Just _) = "Just"
6+
7+g ((f, _), f -> 4) = True
8+
9+multiline
10+ ( t ->
11+ Foo
12+ bar
13+ baz
14+ ) = True
data/examples/declaration/value/function/view-pattern.hsnew file+12
@@ -0,0 +1,12 @@
1+{-# LANGUAGE ViewPatterns #-}
2+
3+example f ( f -> 4 ) = True
4+
5+f (t -> Nothing) = "Nothing"
6+f (t -> Just _) = "Just"
7+
8+g ((f, _), f -> 4) = True
9+
10+multiline (t -> Foo
11+ bar
12+ baz) = True
ormolu.cabal−1
@@ -61,7 +61,6 @@ library
61 , Ormolu.Printer.Meat.Common
61 , Ormolu.Printer.Meat.Common
62 , Ormolu.Printer.Meat.Declaration
62 , Ormolu.Printer.Meat.Declaration
63 , Ormolu.Printer.Meat.Declaration.Data
63 , Ormolu.Printer.Meat.Declaration.Data
64− , Ormolu.Printer.Meat.Declaration.Pat
65 , Ormolu.Printer.Meat.Declaration.Signature
64 , Ormolu.Printer.Meat.Declaration.Signature
66 , Ormolu.Printer.Meat.Declaration.Type
65 , Ormolu.Printer.Meat.Declaration.Type
67 , Ormolu.Printer.Meat.Declaration.TypeFamily
66 , Ormolu.Printer.Meat.Declaration.TypeFamily
src/Ormolu/Printer/Meat/Declaration/Pat.hsdeleted−83
@@ -1,83 +0,0 @@
1−{-# LANGUAGE LambdaCase #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE RecordWildCards #-}
4−
5−module Ormolu.Printer.Meat.Declaration.Pat
6− ( p_pat
7− )
8−where
9−
10−import BasicTypes
11−import Control.Monad
12−import GHC
13−import Ormolu.Printer.Combinators
14−import Ormolu.Printer.Meat.Common
15−import Ormolu.Utils
16−
17−p_pat :: Pat GhcPs -> R ()
18−p_pat = \case
19− WildPat NoExt -> txt "_"
20− VarPat NoExt name -> p_rdrName name
21− LazyPat NoExt pat -> do
22− txt "~"
23− located pat p_pat
24− AsPat NoExt name pat -> do
25− p_rdrName name
26− txt "@"
27− located pat p_pat
28− ParPat NoExt pat ->
29− located pat (parens . p_pat)
30− BangPat NoExt pat -> do
31− txt "!"
32− located pat p_pat
33− ListPat NoExt pats -> do
34− brackets $ velt (withSep comma (located' p_pat) pats)
35− TuplePat NoExt pats boxing -> do
36− let f =
37− case boxing of
38− Boxed -> parens
39− Unboxed -> parensHash
40− f $ velt (withSep comma (located' p_pat) pats)
41− SumPat NoExt pat _ _ -> do
42− -- XXX I'm not sure about this one.
43− located pat p_pat
44− ConPatIn pat details ->
45− case details of
46− PrefixCon xs -> sitcc $ do
47− p_rdrName pat
48− unless (null xs) $ do
49− breakpoint
50− inci $ velt' (located' p_pat <$> xs)
51− RecCon (HsRecFields fields dotdot) -> do
52− p_rdrName pat
53− breakpoint
54− let f = \case
55− Nothing -> txt ".."
56− Just x -> located x p_hsRecField
57− inci . braces . velt . withSep comma f $ case dotdot of
58− Nothing -> Just <$> fields
59− Just n -> (Just <$> take n fields) ++ [Nothing]
60− InfixCon x y -> do
61− located x p_pat
62− space
63− p_rdrName pat
64− breakpoint
65− inci (located y p_pat)
66− ConPatOut {} -> notImplemented "ConPatOut"
67− ViewPat {} -> notImplemented "ViewPat"
68− SplicePat {} -> notImplemented "SplicePat"
69− LitPat NoExt p -> atom p
70− NPat NoExt v _ _ -> located v (atom . ol_val)
71− NPlusKPat {} -> notImplemented "NPlusKPat"
72− SigPat {} -> notImplemented "SigPat"
73− CoPat {} -> notImplemented "CoPat"
74− XPat NoExt -> notImplemented "XPat"
75−
76−p_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
77−p_hsRecField HsRecField {..} = do
78− located hsRecFieldLbl $ \x ->
79− p_rdrName (rdrNameFieldOcc x)
80− unless hsRecPun $ do
81− txt " ="
82− breakpoint
83− inci (located hsRecFieldArg p_pat)
src/Ormolu/Printer/Meat/Declaration/Value.hs+73−1
@@ -4,6 +4,7 @@
4
4
5module Ormolu.Printer.Meat.Declaration.Value
5module Ormolu.Printer.Meat.Declaration.Value
6 ( p_valDecl
6 ( p_valDecl
7+ , p_pat
7 )
8 )
8where
9where
9
10
@@ -15,7 +16,6 @@ import Data.List (sortOn)
15import GHC
16import GHC
16import Ormolu.Printer.Combinators
17import Ormolu.Printer.Combinators
17import Ormolu.Printer.Meat.Common
18import Ormolu.Printer.Meat.Common
18−import Ormolu.Printer.Meat.Declaration.Pat
19import Ormolu.Printer.Meat.Declaration.Signature
19import Ormolu.Printer.Meat.Declaration.Signature
20import Ormolu.Printer.Meat.Type
20import Ormolu.Printer.Meat.Type
21import Ormolu.Utils
21import Ormolu.Utils
@@ -428,6 +428,78 @@ p_patSynDetails = \case
428 velt' (p_rdrName . recordPatSynPatVar <$> xs)
428 velt' (p_rdrName . recordPatSynPatVar <$> xs)
429 InfixCon _ _ -> notImplemented "InfixCon"
429 InfixCon _ _ -> notImplemented "InfixCon"
430
430
431+p_pat :: Pat GhcPs -> R ()
432+p_pat = \case
433+ WildPat NoExt -> txt "_"
434+ VarPat NoExt name -> p_rdrName name
435+ LazyPat NoExt pat -> do
436+ txt "~"
437+ located pat p_pat
438+ AsPat NoExt name pat -> do
439+ p_rdrName name
440+ txt "@"
441+ located pat p_pat
442+ ParPat NoExt pat ->
443+ located pat (parens . p_pat)
444+ BangPat NoExt pat -> do
445+ txt "!"
446+ located pat p_pat
447+ ListPat NoExt pats -> do
448+ brackets $ velt (withSep comma (located' p_pat) pats)
449+ TuplePat NoExt pats boxing -> do
450+ let f =
451+ case boxing of
452+ Boxed -> parens
453+ Unboxed -> parensHash
454+ f $ velt (withSep comma (located' p_pat) pats)
455+ SumPat NoExt pat _ _ -> do
456+ -- XXX I'm not sure about this one.
457+ located pat p_pat
458+ ConPatIn pat details ->
459+ case details of
460+ PrefixCon xs -> sitcc $ do
461+ p_rdrName pat
462+ unless (null xs) $ do
463+ breakpoint
464+ inci $ velt' (located' p_pat <$> xs)
465+ RecCon (HsRecFields fields dotdot) -> do
466+ p_rdrName pat
467+ breakpoint
468+ let f = \case
469+ Nothing -> txt ".."
470+ Just x -> located x p_pat_hsRecField
471+ inci . braces . velt . withSep comma f $ case dotdot of
472+ Nothing -> Just <$> fields
473+ Just n -> (Just <$> take n fields) ++ [Nothing]
474+ InfixCon x y -> do
475+ located x p_pat
476+ space
477+ p_rdrName pat
478+ breakpoint
479+ inci (located y p_pat)
480+ ConPatOut {} -> notImplemented "ConPatOut"
481+ ViewPat NoExt expr pat -> sitcc $ do
482+ located expr p_hsExpr
483+ txt " ->"
484+ breakpoint
485+ inci (located pat p_pat)
486+ SplicePat {} -> notImplemented "SplicePat"
487+ LitPat NoExt p -> atom p
488+ NPat NoExt v _ _ -> located v (atom . ol_val)
489+ NPlusKPat {} -> notImplemented "NPlusKPat"
490+ SigPat {} -> notImplemented "SigPat"
491+ CoPat {} -> notImplemented "CoPat"
492+ XPat NoExt -> notImplemented "XPat"
493+
494+p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
495+p_pat_hsRecField HsRecField {..} = do
496+ located hsRecFieldLbl $ \x ->
497+ p_rdrName (rdrNameFieldOcc x)
498+ unless hsRecPun $ do
499+ txt " ="
500+ breakpoint
501+ inci (located hsRecFieldArg p_pat)
502+
431----------------------------------------------------------------------------
503----------------------------------------------------------------------------
432-- Helpers
504-- Helpers
433
505