summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVladislav Zavialov <vlad.z.4096@gmail.com>2021-11-05 20:30:55 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-11-06 11:25:25 -0400
commit7045b7831cae974ed3a96aa8246ec93846aa868b (patch)
tree57457d56bc0a9a98750926c76b56903b96dc7b52
parent6f2d6a5d833810515b1e2ab11e10196ca2ba24ce (diff)
downloadhaskell-7045b7831cae974ed3a96aa8246ec93846aa868b.tar.gz
Refactor HdkM using deriving via
* No more need for InlineHdkM, mkHdkM * unHdkM is now just a record selector * Update comments
-rw-r--r--compiler/GHC/Parser/PostProcess/Haddock.hs41
1 files changed, 14 insertions, 27 deletions
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index 540a807428..4d85c65ef5 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -66,7 +66,6 @@ import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Writer
import Data.Functor.Identity
-import Data.Coerce
import qualified Data.Monoid
import GHC.Parser.Lexer
@@ -1049,7 +1048,7 @@ instance Applicative HdkA where
-- without any smart reordering strategy. So users of this
-- operation must take care to traverse the AST
-- in concrete syntax order.
- -- See Note [Smart reordering in HdkA (or lack of thereof)]
+ -- See Note [Smart reordering in HdkA (or lack thereof)]
--
-- Each computation is delimited ("sandboxed")
-- in a way that it doesn't see any Haddock
@@ -1066,8 +1065,8 @@ instance Applicative HdkA where
-- any delimiting effect on the surrounding computations.
liftHdkA (pure a)
-{- Note [Smart reordering in HdkA (or lack of thereof)]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Smart reordering in HdkA (or lack thereof)]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When traversing the AST, the user must take care to traverse it in concrete
syntax order.
@@ -1182,8 +1181,8 @@ extendHdkA l' (HdkA l m) = HdkA (getBufSpan l' <> l) m
-- Haddock twice.
--
-- See Note [Adding Haddock comments to the syntax tree].
-newtype HdkM a = HdkM (ReaderT LocRange (State HdkSt) a)
- deriving (Functor, Applicative, Monad)
+newtype HdkM a = HdkM { unHdkM :: LocRange -> HdkSt -> (a, HdkSt) }
+ deriving (Functor, Applicative, Monad) via (ReaderT LocRange (State HdkSt))
-- | The state of HdkM.
data HdkSt =
@@ -1200,14 +1199,6 @@ data HdkWarn
= HdkWarnInvalidComment (PsLocated HdkComment)
| HdkWarnExtraComment LHsDocString
--- 'HdkM' without newtype wrapping/unwrapping.
-type InlineHdkM a = LocRange -> HdkSt -> (a, HdkSt)
-
-mkHdkM :: InlineHdkM a -> HdkM a
-unHdkM :: HdkM a -> InlineHdkM a
-mkHdkM = coerce
-unHdkM = coerce
-
-- Restrict the range in which a HdkM computation will look up comments:
--
-- inLocRange r1 $
@@ -1232,13 +1223,13 @@ unHdkM = coerce
-- In 'HdkA', every (<*>) may restrict the location range of its
-- subcomputations.
inLocRange :: LocRange -> HdkM a -> HdkM a
-inLocRange r (HdkM m) = HdkM (local (mappend r) m)
+inLocRange r (HdkM m) = HdkM (\r' -> m (r <> r'))
-- Take the Haddock comments that satisfy the matching function,
-- leaving the rest pending.
takeHdkComments :: forall a. (PsLocated HdkComment -> Maybe a) -> HdkM [a]
takeHdkComments f =
- mkHdkM $
+ HdkM $
\(LocRange hdk_from hdk_to hdk_col) ->
\hdk_st ->
let
@@ -1277,9 +1268,9 @@ getPrevNextDoc l = do
selectDocString (nextDocs ++ prevDocs)
appendHdkWarning :: HdkWarn -> HdkM ()
-appendHdkWarning e = HdkM (ReaderT (\_ -> modify append_warn))
- where
- append_warn hdk_st = hdk_st { hdk_st_warnings = e : hdk_st_warnings hdk_st }
+appendHdkWarning e = HdkM $ \_ hdk_st ->
+ let hdk_st' = hdk_st { hdk_st_warnings = e : hdk_st_warnings hdk_st }
+ in ((), hdk_st')
selectDocString :: [LHsDocString] -> HdkM (Maybe LHsDocString)
selectDocString = select . filterOut (isEmptyDocString . unLoc)
@@ -1562,13 +1553,9 @@ constructs that are separated by a keyword. For example:
data Foo -- | Comment for MkFoo
where MkFoo :: Foo
-The issue stems from the lack of location information for keywords. We could
-utilize API Annotations for this purpose, but not without modification. For
-example, API Annotations operate on RealSrcSpan, whereas we need BufSpan.
-
-Also, there's work towards making API Annotations available in-tree (not in
-a separate Map), see #17638. This change should make the fix very easy (it
-is not as easy with the current design).
+We could use EPA (exactprint annotations) to fix this, but not without
+modification. For example, EpaLocation contains RealSrcSpan but not BufSpan.
+Also, the fix would be more straghtforward after #19623.
-See also testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.hs
+For examples, see tests/haddock/should_compile_flag_haddock/T17544_kw.hs
-}