c05d9d6 · ormolu · git.iko.soy

data/examples/declaration/instance/associated-data-out.hsnew file+15

compare with master

unifiedsplit

@@ -0,0 +1,15 @@

1+{-# LANGUAGE TypeFamilies #-}

2+instance Foo Int where

3+ data Bar Int = IntBar Int Int

4+

5+instance Foo Double where

6+ newtype Bar Double

7+ = DoubleBar

8+ Double

9+ Double

10+

11+instance Foo [a] where

12+ data Bar [a]

13+ = ListBar [Bar a]

14+ data Baz [a]

15+ = ListBaz

data/examples/declaration/instance/associated-data.hsnew file+19

@@ -0,0 +1,19 @@

1+{-# LANGUAGE TypeFamilies #-}

2+

3+instance Foo Int where data Bar Int = IntBar Int Int

4+

5+instance Foo Double where

6+ newtype

7+ Bar

8+ Double

9+ =

10+ DoubleBar

11+ Double

12+ Double

13+

14+instance Foo [a]

15+ where

16+ data Bar [a] =

17+ ListBar [Bar a]

18+ data Baz [a] =

19+ ListBaz

data/examples/declaration/instance/data-family-instances-out.hsnew file+31

@@ -0,0 +1,31 @@

1+{-# LANGUAGE GADTSyntax #-}

2+{-# LANGUAGE TypeFamilies #-}

3+data instance Foo Int = FooInt Int

4+

5+data instance Foo [Int]

6+ = IntListFoo

7+ ( Int

8+ , Int

9+ )

10+ ( Double

11+ , Double

12+ )

13+

14+newtype instance Foo [Double]

15+ = DoubleListFoo

16+ { unDoubleListFoo :: Double

17+ }

18+

19+data instance Bar Double a

20+ = DoubleBar

21+ Double

22+ (Bar a)

23+

24+data instance Bar Int a where

25+ SameBar

26+ :: Bar Int

27+ Int

28+ CloseBar :: Bar Int Double

29+ OtherBar

30+ :: Bar Int

31+ a

data/examples/declaration/instance/data-family-instances.hsnew file+32

@@ -0,0 +1,32 @@

1+{-# LANGUAGE GADTSyntax #-}

2+{-# LANGUAGE TypeFamilies #-}

3+data instance Foo Int = FooInt Int

4+

5+data instance

6+ Foo [

7+ Int

8+ ] = IntListFoo (

9+ Int,

10+ Int

11+ ) (

12+ Double,

13+ Double

14+ )

15+

16+newtype instance Foo [Double] = DoubleListFoo {

17+ unDoubleListFoo :: Double

18+}

19+

20+data instance Bar Double a =

21+ DoubleBar

22+ Double

23+ (Bar a)

24+

25+data instance Bar Int a where

26+ SameBar

27+ :: Bar Int

28+ Int

29+ CloseBar :: Bar Int Double

30+ OtherBar

31+ :: Bar Int

32+ a

data/examples/declaration/instance/type-family-instances-out.hs+7

@@ -5,3 +5,10 @@ type instance Foo [Int] =

5 ( Int

6 , Int

7 )

8+

9+type instance Bar Int [Int] Double = (Int, Double)

10+

11+type instance Bar [Int] [Int] Double =

12+ ( Int

13+ , Double

14+ )

data/examples/declaration/instance/type-family-instances.hs+12

@@ -7,3 +7,15 @@ type instance

7 [Int] = ( Int,

8 Int

9 )

10+

11+type instance Bar Int [Int] Double = ( Int, Double )

12+

13+type instance

14+ Bar

15+ [Int]

16+ [Int]

17+ Double

18+ = (

19+ Int,

20+ Double

21+ )

src/Ormolu/Printer/Meat/Common.hs+8−1

@@ -4,7 +4,8 @@

4-- | Rendering of commonly useful bits.

5

6module Ormolu.Printer.Meat.Common

7+ ( FamilyStyle (..)

7− ( p_hsmodName

8+ , p_hsmodName

8 , p_ieWrappedName

9 , p_ieWrappedName

9 , p_rdrName

10 , p_rdrName

10 , p_qualName

11 , p_qualName

@@ -20,6 +21,12 @@ import Ormolu.Printer.Internal (getAnns)

20import Ormolu.Utils (getSpan)

21import Ormolu.Utils (getSpan)

21import RdrName (RdrName (..))

22import RdrName (RdrName (..))

22

23

24+-- | Data and type family style.

25+

26+data FamilyStyle

27+ = Associated

28+ | Free

29+

23p_hsmodName :: ModuleName -> R ()

30p_hsmodName :: ModuleName -> R ()

24p_hsmodName mname = do

31p_hsmodName mname = do

25 txt "module "

32 txt "module "

src/Ormolu/Printer/Meat/Declaration.hs+20−1

@@ -10,6 +10,7 @@ where

10

11import GHC

12import Ormolu.Printer.Combinators

13+import Ormolu.Printer.Meat.Common

13import Ormolu.Printer.Meat.Declaration.Data

14import Ormolu.Printer.Meat.Declaration.Data

14import Ormolu.Printer.Meat.Declaration.Instance

15import Ormolu.Printer.Meat.Declaration.Instance

15import Ormolu.Printer.Meat.Declaration.Signature

16import Ormolu.Printer.Meat.Declaration.Signature

@@ -30,11 +31,29 @@ p_tyClDecl :: TyClDecl GhcPs -> R ()

30p_tyClDecl = \case

31p_tyClDecl = \case

31 FamDecl NoExt x -> p_famDecl x

32 FamDecl NoExt x -> p_famDecl x

32 SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs

33 SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs

34+ DataDecl {..} ->

33− DataDecl {..} -> p_dataDecl tcdLName tcdTyVars tcdDataDefn

35+ p_dataDecl Associated tcdLName (tyVarsToTypes tcdTyVars) tcdDataDefn

34 _ -> notImplemented "certain kinds of declarations"

36 _ -> notImplemented "certain kinds of declarations"

35

37

36p_instDecl :: InstDecl GhcPs -> R ()

38p_instDecl :: InstDecl GhcPs -> R ()

37p_instDecl = \case

39p_instDecl = \case

38 ClsInstD NoExt x -> p_clsInstDecl x

40 ClsInstD NoExt x -> p_clsInstDecl x

39 TyFamInstD NoExt x -> p_tyFamInstDecl Free x

41 TyFamInstD NoExt x -> p_tyFamInstDecl Free x

42+ DataFamInstD NoExt x -> p_dataFamInstDecl Free x

40 _ -> notImplemented "certain kinds of declarations"

43 _ -> notImplemented "certain kinds of declarations"

44+

45+----------------------------------------------------------------------------

46+-- Helpers

47+

48+tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]

49+tyVarsToTypes = \case

50+ HsQTvs {..} -> fmap tyVarToType <$> hsq_explicit

51+ XLHsQTyVars {} -> notImplemented "XLHsQTyVars"

52+

53+tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs

54+tyVarToType = \case

55+ UserTyVar NoExt tvar -> HsTyVar NoExt NotPromoted tvar

56+ KindedTyVar NoExt tvar kind ->

57+ HsParTy NoExt $ noLoc $

58+ HsKindSig NoExt (noLoc (HsTyVar NoExt NotPromoted tvar)) kind

59+ XTyVarBndr {} -> notImplemented "XTyVarBndr"

src/Ormolu/Printer/Meat/Declaration/Data.hs+10−7

@@ -21,18 +21,21 @@ import RdrName (RdrName (..))

21import SrcLoc (Located)

22

23p_dataDecl

24+ :: FamilyStyle -- ^ Whether to format as data family

24− :: Located RdrName -- ^ Type constructor

25+ -> Located RdrName -- ^ Type constructor

25− -> LHsQTyVars GhcPs -- ^ Type variables

26+ -> [LHsType GhcPs] -- ^ Type patterns

26 -> HsDataDefn GhcPs -- ^ Data definition

27 -> HsDataDefn GhcPs -- ^ Data definition

27 -> R ()

28 -> R ()

28−p_dataDecl name tvars HsDataDefn {..} = do

29+p_dataDecl style name tpats HsDataDefn {..} = do

29− let HsQTvs {..} = tvars

30 txt $ case dd_ND of

31 NewType -> "newtype "

32 DataType -> "data "

33+ txt $ case style of

34+ Associated -> mempty

35+ Free -> "instance "

33 p_rdrName name

36 p_rdrName name

34− unless (null hsq_explicit) space

37+ unless (null tpats) space

35− spaceSep (located' p_hsTyVarBndr) hsq_explicit

38+ spaceSep (located' p_hsType) tpats

36 case dd_kindSig of

39 case dd_kindSig of

37 Nothing -> return ()

40 Nothing -> return ()

38 Just k -> do

41 Just k -> do

@@ -54,7 +57,7 @@ p_dataDecl name tvars HsDataDefn {..} = do

54 newline

57 newline

55 inci . located dd_derivs $ \xs ->

58 inci . located dd_derivs $ \xs ->

56 forM_ xs (line . located' p_hsDerivingClause)

59 forM_ xs (line . located' p_hsDerivingClause)

57−p_dataDecl _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"

60+p_dataDecl _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"

58

61

59p_conDecl :: ConDecl GhcPs -> R ()

62p_conDecl :: ConDecl GhcPs -> R ()

60p_conDecl = \case

63p_conDecl = \case

src/Ormolu/Printer/Meat/Declaration/Instance.hs+20−9

@@ -2,12 +2,12 @@

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE RecordWildCards #-}

4

5−-- | Type class instance declarations.

5+-- | Type class, type family, and data family instance declarations.

6

7module Ormolu.Printer.Meat.Declaration.Instance

8 ( p_clsInstDecl

9− , FamilyStyle (Associate, Free)

10 , p_tyFamInstDecl

9 , p_tyFamInstDecl

10+ , p_dataFamInstDecl

11 )

12where

13

@@ -18,6 +18,8 @@ import Data.Function

18import Data.List (sortBy)

19import GHC

20import Ormolu.Printer.Combinators

21+import Ormolu.Printer.Meat.Common

22+import Ormolu.Printer.Meat.Declaration.Data

21import Ormolu.Printer.Meat.Declaration.Signature

23import Ormolu.Printer.Meat.Declaration.Signature

22import Ormolu.Printer.Meat.Declaration.TypeFamily

24import Ormolu.Printer.Meat.Declaration.TypeFamily

23import Ormolu.Printer.Meat.Declaration.Value

25import Ormolu.Printer.Meat.Declaration.Value

@@ -44,10 +46,16 @@ p_clsInstDecl = \case

44 let binds = (getLoc &&& located' p_valDecl) <$> cid_binds

46 let binds = (getLoc &&& located' p_valDecl) <$> cid_binds

45 sigs = (getLoc &&& located' p_sigDecl) <$> cid_sigs

47 sigs = (getLoc &&& located' p_sigDecl) <$> cid_sigs

46 tyfam_insts =

48 tyfam_insts =

47− (getLoc &&& located' (p_tyFamInstDecl Associate)) <$> cid_tyfam_insts

49+ (getLoc &&& located' (p_tyFamInstDecl Associated)) <$>

50+ cid_tyfam_insts

51+ datafam_insts =

52+ (getLoc &&& located' (p_dataFamInstDecl Associated)) <$>

53+ cid_datafam_insts

48 decls =

54 decls =

49 snd <$>

55 snd <$>

56+ sortBy

57+ (compare `on` fst)

50− sortBy (compare `on` fst) (toList binds <> sigs <> tyfam_insts)

58+ (toList binds <> sigs <> tyfam_insts <> datafam_insts)

51 if not (null decls)

59 if not (null decls)

52 then do

60 then do

53 txt " where"

61 txt " where"

@@ -57,15 +65,18 @@ p_clsInstDecl = \case

57 newline

65 newline

58 XClsInstDecl NoExt -> notImplemented "XClsInstDecl"

66 XClsInstDecl NoExt -> notImplemented "XClsInstDecl"

59

67

60−data FamilyStyle

61− = Associate

62− | Free

63−

64p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()

68p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()

65p_tyFamInstDecl style = \case

69p_tyFamInstDecl style = \case

66 TyFamInstDecl {..} -> do

70 TyFamInstDecl {..} -> do

67 txt $ case style of

71 txt $ case style of

68− Associate -> "type "

72+ Associated -> "type "

69 Free -> "type instance "

73 Free -> "type instance "

70 p_tyFamInstEqn tfid_eqn

74 p_tyFamInstEqn tfid_eqn

71 newline

75 newline

76+

77+p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R ()

78+p_dataFamInstDecl style = \case

79+ DataFamInstDecl {..} -> do

80+ let HsIB {..} = dfid_eqn

81+ FamEqn {..} = hsib_body

82+ p_dataDecl style feqn_tycon feqn_pats feqn_rhs