Implement signature declarations
This implements not everything, but the most common case: simple top-level
declarations for functions.
commit3553fc35d0493112fd9d7074f9398cea0f28be58
authormrkkrp <mark.karpov@tweag.io>
dateThu 16 May 2019, 16:29 (7 years ago)
parent4e087ff
data/examples/declaration/data/gadt/multiline-out.hs+1−3
@@ -4,9 +4,7 @@
44data Foo a where
55 -- | 'Foo' is wonderful.
66 Foo
7− :: forall a b. ( Show a
8− , Eq b -- foo
9− )
7+ :: forall a b. (Show a, Eq b) -- foo
108 => -- bar
119 a
1210 -> b
data/examples/declaration/type/arguments-out.hsnew file+14
@@ -0,0 +1,14 @@
1+{-# LANGUAGE RankNTypes #-}
2+functionName
3+ :: (C1, C2, C3, C4, C5)
4+ => a
5+ -> b
6+ -> ( forall a. (C6, C7)
7+ => LongDataTypeName
8+ -> a
9+ -> AnotherLongDataTypeName
10+ -> b
11+ -> c
12+ )
13+ -> (c -> d)
14+ -> (a, b, c, d)
data/examples/declaration/type/arguments.hsnew file+16
@@ -0,0 +1,16 @@
1+{-# LANGUAGE RankNTypes #-}
2+
3+functionName
4+ :: (C1, C2, C3, C4, C5)
5+ => a
6+ -> b
7+ -> (forall a.
8+ (C6, C7)
9+ => LongDataTypeName
10+ -> a
11+ -> AnotherLongDataTypeName
12+ -> b
13+ -> c
14+ )
15+ -> (c -> d)
16+ -> (a, b, c, d)
data/examples/declaration/type/context-multi-line-out.hsnew file+10
@@ -0,0 +1,10 @@
1+functionName
2+ :: ( C1
3+ , C2
4+ , C3
5+ )
6+ => a
7+ -> b
8+ -> c
9+ -> d
10+ -> (a, b, c, d)
data/examples/declaration/type/context-multi-line.hsnew file+10
@@ -0,0 +1,10 @@
1+functionName
2+ :: ( C1
3+ , C2
4+ , C3
5+ )
6+ => a
7+ -> b
8+ -> c
9+ -> d
10+ -> (a, b, c, d)
data/examples/declaration/type/context-single-line-out.hsnew file+7
@@ -0,0 +1,7 @@
1+functionName
2+ :: (C1, C2, C3)
3+ => a
4+ -> b
5+ -> c
6+ -> d
7+ -> (a, b, c, d)
data/examples/declaration/type/context-single-line.hsnew file+7
@@ -0,0 +1,7 @@
1+functionName
2+ :: (C1, C2, C3)
3+ => a
4+ -> b
5+ -> c
6+ -> d
7+ -> (a, b, c, d)
data/examples/declaration/type/infix-promoted-type-constructor-out.hsnew file+3
@@ -0,0 +1,3 @@
1+fun1 :: Def ('[Ref s (Stored Uint32), IBool] T.:-> IBool)
2+
3+fun2 :: Def ('[Ref s (Stored Uint32), IBool] :-> IBool)
data/examples/declaration/type/infix-promoted-type-constructor.hsnew file+2
@@ -0,0 +1,2 @@
1+fun1 :: Def ('[ Ref s (Stored Uint32), IBool] 'T.:-> IBool)
2+fun2 :: Def ('[ Ref s (Stored Uint32), IBool] ':-> IBool)
data/examples/declaration/type/long-function-name-out.hsnew file+6
@@ -0,0 +1,6 @@
1+longFunctionName
2+ :: a
3+ -> b
4+ -> c
5+ -> d
6+ -> (a, b, c, d)
data/examples/declaration/type/long-function-name.hsnew file+6
@@ -0,0 +1,6 @@
1+longFunctionName
2+ :: a
3+ -> b
4+ -> c
5+ -> d
6+ -> (a, b, c, d)
data/examples/declaration/type/long-multiline-applications-out.hsnew file+15
@@ -0,0 +1,15 @@
1+functionName
2+ :: (C1, C2, C3, C4, C5)
3+ => a
4+ -> b
5+ -> ( LongDataTypeName
6+ AnotherLongDataTypeName
7+ AnotherLongDataTypeName2
8+ AnotherLongDataTypeName3
9+ -> a
10+ -> AnotherLongDataTypeName4
11+ -> b
12+ -> c
13+ )
14+ -> (c -> d)
15+ -> (a, b, c, d)
data/examples/declaration/type/long-multiline-applications.hsnew file+15
@@ -0,0 +1,15 @@
1+functionName
2+ :: (C1, C2, C3, C4, C5)
3+ => a
4+ -> b
5+ -> ( LongDataTypeName
6+ AnotherLongDataTypeName
7+ AnotherLongDataTypeName2
8+ AnotherLongDataTypeName3
9+ -> a
10+ -> AnotherLongDataTypeName4
11+ -> b
12+ -> c
13+ )
14+ -> (c -> d)
15+ -> (a, b, c, d)
ormolu.cabal+1
@@ -60,6 +60,7 @@ library
6060 , Ormolu.Printer.Meat.Common
6161 , Ormolu.Printer.Meat.Declaration
6262 , Ormolu.Printer.Meat.Declaration.Data
63+ , Ormolu.Printer.Meat.Declaration.Signature
6364 , Ormolu.Printer.Meat.Declaration.Type
6465 , Ormolu.Printer.Meat.Declaration.TypeFamily
6566 , Ormolu.Printer.Meat.ImportExport
src/Ormolu/Printer/Meat/Declaration.hs+2
@@ -11,12 +11,14 @@ where
1111import GHC
1212import Ormolu.Printer.Combinators
1313import Ormolu.Printer.Meat.Declaration.Data
14+import Ormolu.Printer.Meat.Declaration.Signature
1415import Ormolu.Printer.Meat.Declaration.Type
1516import Ormolu.Printer.Meat.Declaration.TypeFamily
1617
1718p_hsDecl :: HsDecl GhcPs -> R ()
1819p_hsDecl = \case
1920 TyClD x -> p_tyClDecl x
21+ SigD x -> p_sigDecl x
2022 _ -> error "this is not yet supported"
2123
2224p_tyClDecl :: TyClDecl GhcPs -> R ()
src/Ormolu/Printer/Meat/Declaration/Signature.hsnew file+30
@@ -0,0 +1,30 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+
5+-- | Type signature declarations.
6+
7+module Ormolu.Printer.Meat.Declaration.Signature
8+ ( p_sigDecl )
9+where
10+
11+import GHC
12+import Ormolu.Printer.Combinators
13+import Ormolu.Printer.Meat.Common
14+import Ormolu.Printer.Meat.Type
15+
16+p_sigDecl :: Sig GhcPs -> R ()
17+p_sigDecl = \case
18+ TypeSig names hswc -> line (p_typeSig names hswc)
19+ _ -> error "Ormolu.Printer.Meat.Declaration.Signature: unimplemented signatures"
20+
21+p_typeSig
22+ :: [Located RdrName]
23+ -> LHsSigWcType GhcPs
24+ -> R ()
25+p_typeSig names HsWC {..} = do
26+ spaceSep (located' p_rdrName) names
27+ breakpoint
28+ inci $ do
29+ txt ":: "
30+ relaxComments $ located (hsib_body hswc_body) p_hsType
src/Ormolu/Printer/Meat/Type.hs+1−1
@@ -24,7 +24,7 @@ p_hsType = \case
2424 txt ". "
2525 locatedVia Nothing t p_hsType
2626 HsQualTy qs t -> do
27− locatedVia Nothing qs p_hsContext
27+ located qs p_hsContext
2828 breakpoint
2929 txt "=> "
3030 locatedVia Nothing t p_hsType