5f5f922 · ormolu · git.iko.soy

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

compare with master

unifiedsplit

@@ -0,0 +1,9 @@

1+{-# LANGUAGE TypeFamilies #-}

2+instance Foo Int where

3+ type Bar Int = Double

4+

5+instance Foo Double where

6+ type Bar Double =

7+ [Double]

8+ type Baz Double =

9+ [Double]

data/examples/declaration/instance/associated-types.hsnew file+13

@@ -0,0 +1,13 @@

1+{-# LANGUAGE TypeFamilies #-}

2+

3+instance Foo Int where type Bar Int = Double

4+

5+instance Foo Double

6+ where

7+ type

8+ Bar

9+ Double

10+ =

11+ [Double]

12+ type instance Baz Double

13+ = [Double]

data/examples/declaration/instance/contexts-out.hsnew file+9

@@ -0,0 +1,9 @@

1+instance Eq a => Eq [a] where

2+ (==) _ _ = False

3+

4+instance ( Ord a

5+ , Ord b

6+ )

7+ => Ord

8+ (a, b) where

9+ compare _ _ = GT

data/examples/declaration/instance/contexts.hsnew file+7

@@ -0,0 +1,7 @@

1+instance Eq a=>Eq [a] where (==) _ _ = False

2+

3+instance (

4+ Ord a,

5+ Ord b

6+ ) => Ord (a,b) where

7+ compare _ _ = GT

data/examples/declaration/instance/empty-instance-out.hsnew file+3

@@ -0,0 +1,3 @@

1+instance Typeable Int

2+

3+instance Generic Int

data/examples/declaration/instance/empty-instance.hsnew file+2

@@ -0,0 +1,2 @@

1+instance Typeable Int

2+instance Generic Int where

data/examples/declaration/instance/instance-sigs-out.hsnew file+22

@@ -0,0 +1,22 @@

1+{-# LANGUAGE InstanceSigs #-}

2+instance Eq Int where

3+ (==) :: Int -> Int -> Bool

4+ (==) _ _ = False

5+

6+instance Ord Int where

7+ compare

8+ :: Int

9+ -> Int

10+ -> Ordering

11+ compare

12+ _

13+ _ = GT

14+

15+instance Applicative [] where

16+ pure

17+ :: a

18+ -> [a]

19+ pure a = [a]

20+ (<*>)

21+ :: [a] -> [a] -> [a]

22+ (<*>) _ _ = []

data/examples/declaration/instance/instance-sigs.hsnew file+25

@@ -0,0 +1,25 @@

1+{-# LANGUAGE InstanceSigs #-}

2+

3+instance Eq Int

4+ where

5+ (==) :: Int -> Int -> Bool

6+ (==) _ _ = False

7+

8+instance Ord Int where

9+ compare ::

10+ Int

11+ -> Int

12+ -> Ordering

13+ compare

14+ _

15+ _

16+ = GT

17+

18+instance Applicative [] where

19+ pure ::

20+ a

21+ -> [a]

22+ pure a = [a]

23+ (<*>)

24+ :: [ a ] -> [ a ] -> [ a ]

25+ (<*>) _ _ = []

data/examples/declaration/instance/multi-parameter-out.hsnew file+6

@@ -0,0 +1,6 @@

1+instance MonadReader a ((->) a) where

2+ ask = id

3+

4+instance MonadState s (State s) where

5+ get = State.get

6+ put = State.put

data/examples/declaration/instance/multi-parameter.hsnew file+6

@@ -0,0 +1,6 @@

1+instance MonadReader a ((->) a) where ask = id

2+

3+instance MonadState s (State s)

4+ where

5+ get = State.get

6+ put = State.put

data/examples/declaration/instance/overlappable-instances-out.hsnew file+16

@@ -0,0 +1,16 @@

1+-- Test should have tested different whitespaces inside pragma. However, the

2+-- pragmas contain a "SourceText" which compares as equal only if the whitespace

3+-- inside the pragma is printed exactly identically (i.e. including newlines and

4+-- all.) In practice, removing this whitespace is desirable, so whitespace is

5+-- not varied to avoid spurious and difficult-to-avoid test case errors.

6+instance {-# OVERLAPPABLE #-} Eq Int where

7+ (==) _ _ = False

8+

9+instance {-# OVERLAPPING #-} Ord Int where

10+ compare _ _ = GT

11+

12+instance {-# OVERLAPS #-} Eq Double where

13+ (==) _ _ = False

14+

15+instance {-# INCOHERENT #-} Ord Double where

16+ compare _ _ = GT

data/examples/declaration/instance/overlappable-instances.hsnew file+17

@@ -0,0 +1,17 @@

1+-- Test should have tested different whitespaces inside pragma. However, the

2+-- pragmas contain a "SourceText" which compares as equal only if the whitespace

3+-- inside the pragma is printed exactly identically (i.e. including newlines and

4+-- all.) In practice, removing this whitespace is desirable, so whitespace is

5+-- not varied to avoid spurious and difficult-to-avoid test case errors.

6+

7+instance {-# OVERLAPPABLE #-} Eq Int where (==) _ _ = False

8+

9+instance

10+ {-# OVERLAPPING #-} Ord Int where compare _ _ = GT

11+

12+instance {-# OVERLAPS #-} Eq Double where

13+ (==) _ _ = False

14+

15+instance

16+ {-# INCOHERENT #-} Ord Double where

17+ compare _ _ = GT

data/examples/declaration/instance/single-parameter-out.hsnew file+7

@@ -0,0 +1,7 @@

1+instance Monoid Int where

2+ (<>) x y = x + y

3+

4+instance Enum Int where

5+ fromEnum x = x

6+ toEnum = \x ->

7+ x

data/examples/declaration/instance/single-parameter.hsnew file+8

@@ -0,0 +1,8 @@

1+instance Monoid Int where (<>) x y = x+y

2+

3+instance Enum Int

4+ where

5+ fromEnum x = x

6+ toEnum

7+ = \x ->

8+ x

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

@@ -0,0 +1,7 @@

1+{-# LANGUAGE TypeFamilies #-}

2+type instance Foo Int = Int

3+

4+type instance Foo [Int] =

5+ ( Int

6+ , Int

7+ )

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

@@ -0,0 +1,9 @@

1+{-# LANGUAGE TypeFamilies #-}

2+

3+type instance Foo Int = Int

4+

5+type instance

6+ Foo

7+ [Int] = ( Int,

8+ Int

9+ )

ormolu.cabal+1

@@ -60,6 +60,7 @@ library

60 , Ormolu.Printer.Internal

61 , Ormolu.Printer.Meat.Common

62 , Ormolu.Printer.Meat.Declaration

63+ , Ormolu.Printer.Meat.Declaration.Instance

63 , Ormolu.Printer.Meat.Declaration.Data

64 , Ormolu.Printer.Meat.Declaration.Data

64 , Ormolu.Printer.Meat.Declaration.Signature

65 , Ormolu.Printer.Meat.Declaration.Signature

65 , Ormolu.Printer.Meat.Declaration.Type

66 , Ormolu.Printer.Meat.Declaration.Type

src/Ormolu/Printer/Meat/Declaration.hs+8

@@ -11,6 +11,7 @@ where

11import GHC

12import Ormolu.Printer.Combinators

13import Ormolu.Printer.Meat.Declaration.Data

14+import Ormolu.Printer.Meat.Declaration.Instance

14import Ormolu.Printer.Meat.Declaration.Signature

15import Ormolu.Printer.Meat.Declaration.Signature

15import Ormolu.Printer.Meat.Declaration.Type

16import Ormolu.Printer.Meat.Declaration.Type

16import Ormolu.Printer.Meat.Declaration.TypeFamily

17import Ormolu.Printer.Meat.Declaration.TypeFamily

@@ -22,6 +23,7 @@ p_hsDecl = \case

22 TyClD NoExt x -> p_tyClDecl x

23 TyClD NoExt x -> p_tyClDecl x

23 ValD NoExt x -> p_valDecl x

24 ValD NoExt x -> p_valDecl x

24 SigD NoExt x -> p_sigDecl x

25 SigD NoExt x -> p_sigDecl x

26+ InstD NoExt x -> p_instDecl x

25 _ -> notImplemented "certain kinds of declarations"

27 _ -> notImplemented "certain kinds of declarations"

26

28

27p_tyClDecl :: TyClDecl GhcPs -> R ()

29p_tyClDecl :: TyClDecl GhcPs -> R ()

@@ -30,3 +32,9 @@ p_tyClDecl = \case

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

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

31 DataDecl {..} -> p_dataDecl tcdLName tcdTyVars tcdDataDefn

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

32 _ -> notImplemented "certain kinds of declarations"

34 _ -> notImplemented "certain kinds of declarations"

35+

36+p_instDecl :: InstDecl GhcPs -> R ()

37+p_instDecl = \case

38+ ClsInstD NoExt x -> p_clsInstDecl x

39+ TyFamInstD NoExt x -> p_tyFamInstDecl Free x

40+ _ -> notImplemented "certain kinds of declarations"

src/Ormolu/Printer/Meat/Declaration/Instance.hsnew file+71

@@ -0,0 +1,71 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE RecordWildCards #-}

4+

5+-- | Type class instance declarations.

6+

7+module Ormolu.Printer.Meat.Declaration.Instance

8+ ( p_clsInstDecl

9+ , FamilyStyle (Associate, Free)

10+ , p_tyFamInstDecl

11+ )

12+where

13+

14+import BasicTypes

15+import Control.Arrow

16+import Data.Foldable

17+import Data.Function

18+import Data.List (sortBy)

19+import GHC

20+import Ormolu.Printer.Combinators

21+import Ormolu.Printer.Meat.Declaration.Signature

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

23+import Ormolu.Printer.Meat.Declaration.Value

24+import Ormolu.Printer.Meat.Type

25+import Ormolu.Utils

26+

27+p_clsInstDecl :: ClsInstDecl GhcPs -> R ()

28+p_clsInstDecl = \case

29+ ClsInstDecl {..} -> do

30+ txt "instance "

31+ case unLoc <$> cid_overlap_mode of

32+ Just Overlappable {} -> txt "{-# OVERLAPPABLE #-} "

33+ Just Overlapping {} -> txt "{-# OVERLAPPING #-} "

34+ Just Overlaps {} -> txt "{-# OVERLAPS #-} "

35+ Just Incoherent {} -> txt "{-# INCOHERENT #-} "

36+ _ -> pure ()

37+ case cid_poly_ty of

38+ HsIB {..} -> sitcc (located hsib_body p_hsType)

39+ XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"

40+ -- GHC's AST does not necessarily store each kind of element in source

41+ -- location order. This happens because different declarations are stored in

42+ -- different lists. Consequently, to get all the declarations in proper

43+ -- order, they need to be manually sorted.

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

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

46+ tyfam_insts =

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

48+ decls =

49+ snd <$>

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

51+ if not (null decls)

52+ then do

53+ txt " where"

54+ newline

55+ inci (sequence_ decls)

56+ else do

57+ newline

58+ XClsInstDecl NoExt -> notImplemented "XClsInstDecl"

59+

60+data FamilyStyle

61+ = Associate

62+ | Free

63+

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

65+p_tyFamInstDecl style = \case

66+ TyFamInstDecl {..} -> do

67+ txt $ case style of

68+ Associate -> "type "

69+ Free -> "type instance "

70+ p_tyFamInstEqn tfid_eqn

71+ newline

src/Ormolu/Printer/Meat/Declaration/Signature.hs+4

@@ -10,6 +10,7 @@ module Ormolu.Printer.Meat.Declaration.Signature

10 )

11where

12

13+import Control.Monad

13import GHC

14import GHC

14import Ormolu.Printer.Combinators

15import Ormolu.Printer.Combinators

15import Ormolu.Printer.Meat.Common

16import Ormolu.Printer.Meat.Common

@@ -22,6 +23,9 @@ p_sigDecl = line . p_sigDecl'

22p_sigDecl' :: Sig GhcPs -> R ()

23p_sigDecl' :: Sig GhcPs -> R ()

23p_sigDecl' = \case

24p_sigDecl' = \case

24 TypeSig NoExt names hswc -> p_typeSig names hswc

25 TypeSig NoExt names hswc -> p_typeSig names hswc

26+ ClassOpSig NoExt def names hsib -> do

27+ when def (txt "default ")

28+ p_typeSig names HsWC {hswc_ext = NoExt, hswc_body = hsib}

25 _ -> notImplemented "certain types of signature declarations"

29 _ -> notImplemented "certain types of signature declarations"

26

30

27p_typeSig

31p_typeSig

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+1

@@ -6,6 +6,7 @@

6

7module Ormolu.Printer.Meat.Declaration.TypeFamily

8 ( p_famDecl

9+ , p_tyFamInstEqn

9 )

10 )

10where

11where

11

12