[commit: ghc] master: Add flag to show docs of valid hole fits (c4d9834)
git at git.haskell.org
git at git.haskell.org
Thu Jul 12 15:40:33 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/c4d983412dc8128ac85d3bce0c8e91718af38ed2/ghc
>---------------------------------------------------------------
commit c4d983412dc8128ac85d3bce0c8e91718af38ed2
Author: Matthías Páll Gissurarson <mpg at mpg.is>
Date: Thu Jul 12 09:57:00 2018 -0400
Add flag to show docs of valid hole fits
One issue with valid hole fits is that the function names can often be
opaque for the uninitiated, such as `($)`. This diff adds a new flag,
`-fshow-docs-of-hole-fits` that adds the documentation of the identifier
in question to the message, using the same mechanism as the `:doc`
command.
As an example, with this flag enabled, the valid hole fits for `_ ::
[Int] -> Int` will include:
```
Valid hole fits include
head :: forall a. [a] -> a
{-^ Extract the first element of a list, which must be non-empty.-}
with head @Int
(imported from ‘Prelude’ (and originally defined in ‘GHC.List’))
```
And one of the refinement hole fits, `($) _`, will read:
```
Valid refinement hole fits include
...
($) (_ :: [Int] -> Int)
where ($) :: forall a b. (a -> b) -> a -> b
{-^ Application operator. This operator is redundant, since ordinary
application @(f x)@ means the same as @(f '$' x)@. However, '$' has
low, right-associative binding precedence, so it sometimes allows
parentheses to be omitted; for example:
> f $ g $ h x = f (g (h x))
It is also useful in higher-order situations, such as @'map' ('$' 0) xs@,
or @'Data.List.zipWith' ('$') fs xs at .
Note that @($)@ is levity-polymorphic in its result type, so that
foo $ True where foo :: Bool -> Int#
is well-typed-}
with ($) @'GHC.Types.LiftedRep @[Int] @Int
(imported from ‘Prelude’ (and originally defined in ‘GHC.Base’))
```
Another example of where documentation can come in very handy, is when
working with the `lens` library.
When you compile
```
{-# OPTIONS_GHC -fno-show-provenance-of-hole-fits -fshow-docs-of-hole-fits #-}
module LensDemo where
import Control.Lens
import Control.Monad.State
newtype Test = Test { _value :: Int } deriving (Show)
value :: Lens' Test Int
value f (Test i) = Test <$> f i
updTest :: Test -> Test
updTest t = t &~ do
_ value (1 :: Int)
```
You get:
```
Valid hole fits include
(#=) :: forall s (m :: * -> *) a b.
MonadState s m =>
ALens s s a b -> b -> m ()
{-^ A version of ('Control.Lens.Setter..=') that works on 'ALens'.-}
with (#=) @Test @(StateT Test Identity) @Int @Int
(<#=) :: forall s (m :: * -> *) a b.
MonadState s m =>
ALens s s a b -> b -> m b
{-^ A version of ('Control.Lens.Setter.<.=') that works on 'ALens'.-}
with (<#=) @Test @(StateT Test Identity) @Int @Int
(<*=) :: forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
LensLike' ((,) a) s a -> a -> m a
{-^ Multiply the target of a numerically valued 'Lens' into your 'Monad''s
state and return the result.
When you do not need the result of the multiplication,
('Control.Lens.Setter.*=') is more flexible.
@
('<*=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a
('<*=') :: ('MonadState' s m, 'Num' a) => 'Control.Lens.Iso.Iso'' s a -> a -> m a
@-}
with (<*=) @Test @(StateT Test Identity) @Int
(<+=) :: forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
LensLike' ((,) a) s a -> a -> m a
{-^ Add to the target of a numerically valued 'Lens' into your 'Monad''s state
and return the result.
When you do not need the result of the addition,
('Control.Lens.Setter.+=') is more flexible.
@
('<+=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a
('<+=') :: ('MonadState' s m, 'Num' a) => 'Control.Lens.Iso.Iso'' s a -> a -> m a
@-}
with (<+=) @Test @(StateT Test Identity) @Int
(<-=) :: forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
LensLike' ((,) a) s a -> a -> m a
{-^ Subtract from the target of a numerically valued 'Lens' into your 'Monad''s
state and return the result.
When you do not need the result of the subtraction,
('Control.Lens.Setter.-=') is more flexible.
@
('<-=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a
('<-=') :: ('MonadState' s m, 'Num' a) => 'Control.Lens.Iso.Iso'' s a -> a -> m a
@-}
with (<-=) @Test @(StateT Test Identity) @Int
(<<*=) :: forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
LensLike' ((,) a) s a -> a -> m a
{-^ Modify the target of a 'Lens' into your 'Monad''s state by multipling a value
and return the /old/ value that was replaced.
When you do not need the result of the operation,
('Control.Lens.Setter.*=') is more flexible.
@
('<<*=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a
('<<*=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m a
@-}
with (<<*=) @Test @(StateT Test Identity) @Int
(Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits)
```
Which allows you to see at a glance what opaque operators like `(<<*=)`
and `(<#=)` do.
Reviewers: bgamari, sjakobi
Reviewed By: sjakobi
Subscribers: sjakobi, alexbiehl, rwbarton, thomie, carter
Differential Revision: https://phabricator.haskell.org/D4848
>---------------------------------------------------------------
c4d983412dc8128ac85d3bce0c8e91718af38ed2
compiler/iface/LoadIface.hs | 11 ++++-
compiler/main/DynFlags.hs | 3 ++
compiler/typecheck/TcHoleErrors.hs | 82 ++++++++++++++++++++++++++++----------
docs/users_guide/glasgow_exts.rst | 15 +++++++
4 files changed, 89 insertions(+), 22 deletions(-)
Diff suppressed because of size. To see it, use:
git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c4d983412dc8128ac85d3bce0c8e91718af38ed2
More information about the ghc-commits
mailing list