c05d9d6 · ormolu · git.iko.soy

git.iko.soy/ormolu

Support associated data types and open data family instances

commitc05d9d62e0689929b83987776105fc988dda04ea authoryumiova <yumiova@protonmail.ch> dateSat 8 Jun 2019, 21:10 (7 years ago) parent2dfd181

10 files changed+174−18

compare with master

unifiedsplit

data/examples/declaration/instance/associated-data-out.hs+15 data/examples/declaration/instance/associated-data.hs+19 data/examples/declaration/instance/data-family-instances-out.hs+31 data/examples/declaration/instance/data-family-instances.hs+32 data/examples/declaration/instance/type-family-instances-out.hs+7 data/examples/declaration/instance/type-family-instances.hs+12 src/Ormolu/Printer/Meat/Common.hs+8−1 src/Ormolu/Printer/Meat/Declaration.hs+20−1 src/Ormolu/Printer/Meat/Declaration/Data.hs+10−7 src/Ormolu/Printer/Meat/Declaration/Instance.hs+20−9

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

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

1+{-# LANGUAGE TypeFamilies #-}

2+instance Foo Int where

3+ data Bar Int = IntBar Int Int

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 #-}

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

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

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

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] =

55 ( Int

66 , Int

77 )

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

77 [Int] = ( Int,

88 Int

99 )

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 @@

44-- | Rendering of commonly useful bits.

66module Ormolu.Printer.Meat.Common

7− ( p_hsmodName

7+ ( FamilyStyle (..)

8+ , p_hsmodName

89 , p_ieWrappedName

910 , p_rdrName

1011 , p_qualName

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

2021import Ormolu.Utils (getSpan)

2122import RdrName (RdrName (..))

2223

24+-- | Data and type family style.

25+

26+data FamilyStyle

27+ = Associated

28+ | Free

29+

2330p_hsmodName :: ModuleName -> R ()

2431p_hsmodName mname = do

2532 txt "module "

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

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

1010

1111import GHC

1212import Ormolu.Printer.Combinators

13+import Ormolu.Printer.Meat.Common

1314import Ormolu.Printer.Meat.Declaration.Data

1415import Ormolu.Printer.Meat.Declaration.Instance

1516import Ormolu.Printer.Meat.Declaration.Signature

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

3031p_tyClDecl = \case

3132 FamDecl NoExt x -> p_famDecl x

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

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

34+ DataDecl {..} ->

35+ p_dataDecl Associated tcdLName (tyVarsToTypes tcdTyVars) tcdDataDefn

3436 _ -> notImplemented "certain kinds of declarations"

3537

3638p_instDecl :: InstDecl GhcPs -> R ()

3739p_instDecl = \case

3840 ClsInstD NoExt x -> p_clsInstDecl x

3941 TyFamInstD NoExt x -> p_tyFamInstDecl Free x

42+ DataFamInstD NoExt x -> p_dataFamInstDecl Free x

4043 _ -> 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 (..))

2121import SrcLoc (Located)

2222

2323p_dataDecl

24− :: Located RdrName -- ^ Type constructor

25− -> LHsQTyVars GhcPs -- ^ Type variables

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

25+ -> Located RdrName -- ^ Type constructor

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

2627 -> HsDataDefn GhcPs -- ^ Data definition

2728 -> R ()

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

29− let HsQTvs {..} = tvars

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

3030 txt $ case dd_ND of

3131 NewType -> "newtype "

3232 DataType -> "data "

33+ txt $ case style of

34+ Associated -> mempty

35+ Free -> "instance "

3336 p_rdrName name

34− unless (null hsq_explicit) space

35− spaceSep (located' p_hsTyVarBndr) hsq_explicit

37+ unless (null tpats) space

38+ spaceSep (located' p_hsType) tpats

3639 case dd_kindSig of

3740 Nothing -> return ()

3841 Just k -> do

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

5457 newline

5558 inci . located dd_derivs $ \xs ->

5659 forM_ xs (line . located' p_hsDerivingClause)

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

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

5861

5962p_conDecl :: ConDecl GhcPs -> R ()

6063p_conDecl = \case

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

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

22{-# LANGUAGE OverloadedStrings #-}

33{-# LANGUAGE RecordWildCards #-}

5−-- | Type class instance declarations.

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

77module Ormolu.Printer.Meat.Declaration.Instance

88 ( p_clsInstDecl

9− , FamilyStyle (Associate, Free)

109 , p_tyFamInstDecl

10+ , p_dataFamInstDecl

1111 )

1212where

1313

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

1818import Data.List (sortBy)

1919import GHC

2020import Ormolu.Printer.Combinators

21+import Ormolu.Printer.Meat.Common

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

2123import Ormolu.Printer.Meat.Declaration.Signature

2224import Ormolu.Printer.Meat.Declaration.TypeFamily

2325import Ormolu.Printer.Meat.Declaration.Value

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

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

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

4648 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

4854 decls =

4955 snd <$>

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

56+ sortBy

57+ (compare `on` fst)

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

5159 if not (null decls)

5260 then do

5361 txt " where"

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

5765 newline

5866 XClsInstDecl NoExt -> notImplemented "XClsInstDecl"

5967

60−data FamilyStyle

61− = Associate

62− | Free

63−

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

6569p_tyFamInstDecl style = \case

6670 TyFamInstDecl {..} -> do

6771 txt $ case style of

68− Associate -> "type "

72+ Associated -> "type "

6973 Free -> "type instance "

7074 p_tyFamInstEqn tfid_eqn

7175 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