-- | Extract highlighting syntax from abstract syntax.
--
-- Implements one big fold over abstract syntax.

{-# OPTIONS_GHC -Wunused-imports #-}
{-# OPTIONS_GHC -Wunused-binds   #-}

module Agda.Interaction.Highlighting.FromAbstract
  ( runHighlighter
  , NameKinds
  ) where

import Prelude hiding (null)

import Control.Monad.Reader  ( MonadReader(..), asks, Reader, runReader )

import           Data.Maybe
import           Data.Void            ( Void )

import           Agda.Interaction.Highlighting.Precise hiding ( singleton )
import qualified Agda.Interaction.Highlighting.Precise as H
import           Agda.Interaction.Highlighting.Range   ( rToR )  -- Range is ambiguous

import           Agda.Syntax.Abstract                ( IsProjP(..), anameName, getAmbiguous, nameBindingSite )
import qualified Agda.Syntax.Abstract      as A
import           Agda.Syntax.Common        as Common
import           Agda.Syntax.Concrete                ( FieldAssignment'(..), TacticAttribute' )
import qualified Agda.Syntax.Concrete.Name as C
import           Agda.Syntax.Info                    ( ModuleInfo(..) )
import           Agda.Syntax.Literal
import qualified Agda.Syntax.Position      as P
import           Agda.Syntax.Position                ( Range, HasRange, getRange, noRange )
import           Agda.Syntax.Scope.Base              ( ResolvedName(..), exactConName )
import           Agda.Syntax.TopLevelModuleName

import Agda.TypeChecking.Monad
  hiding (ModuleInfo, MetaInfo, Primitive, Constructor, Record, Function, Datatype)

import           Agda.Utils.Function
import           Agda.Utils.List                     ( initLast1 )
import           Agda.Utils.List1                    ( List1 )
import qualified Agda.Utils.List1          as List1
import           Agda.Utils.Maybe
import qualified Agda.Utils.Maybe.Strict   as Strict
import           Agda.Syntax.Common.Pretty
import           Agda.Utils.Singleton
import           Agda.Utils.Size

-- Entry point:
-- | Create highlighting info for some piece of syntax.
runHighlighter
  :: Hilite a
  => TopLevelModuleName
     -- ^ The current top-level module's name.
  -> NameKinds -> a -> HighlightingInfoBuilder
runHighlighter :: forall a.
Hilite a =>
TopLevelModuleName' Range
-> NameKinds -> a -> DelayedMerge RangePair
runHighlighter TopLevelModuleName' Range
top NameKinds
kinds a
x =
  ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> HiliteEnv -> DelayedMerge RangePair
forall r a. Reader r a -> r -> a
runReader (a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite a
x) (HiliteEnv -> DelayedMerge RangePair)
-> HiliteEnv -> DelayedMerge RangePair
forall a b. (a -> b) -> a -> b
$
  HiliteEnv
    { hleNameKinds :: NameKinds
hleNameKinds         = NameKinds
kinds
    , hleCurrentModuleName :: TopLevelModuleName' Range
hleCurrentModuleName = TopLevelModuleName' Range
top
    }

-- | Environment of the highlighter.
data HiliteEnv = HiliteEnv
  { HiliteEnv -> NameKinds
hleNameKinds :: NameKinds
      -- ^ Function mapping qualified names to their kind.
  , HiliteEnv -> TopLevelModuleName' Range
hleCurrentModuleName :: TopLevelModuleName
      -- ^ The current top-level module's name. Used for consistency
      -- checking.
  }

-- | A function mapping names to the kind of name they stand for.
type NameKinds = A.QName -> Maybe NameKind

-- | Highlighting monad.
type HiliteM = Reader HiliteEnv

-- | Highlighter.

type Hiliter = HiliteM HighlightingInfoBuilder

instance Monoid Hiliter where
  mempty :: ReaderT HiliteEnv Identity (DelayedMerge RangePair)
mempty  = DelayedMerge RangePair
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. a -> ReaderT HiliteEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DelayedMerge RangePair
forall a. Monoid a => a
mempty
  mappend :: ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
mappend = ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
(<>)

-- | Traversal to extract highlighting information.

class Hilite a where
  hilite :: a -> Hiliter

  default hilite :: (Foldable t, Hilite b, t b ~ a) => a -> Hiliter
  hilite = (b -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> t b -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite

-- * Generic instances
---------------------------------------------------------------------------

instance Hilite a => Hilite [a]
instance Hilite a => Hilite (List1 a)
instance Hilite a => Hilite (Maybe a)
instance Hilite a => Hilite (Ranged a)
instance Hilite a => Hilite (TacticAttribute' a)
instance Hilite a => Hilite (WithHiding a)

instance Hilite Void where
  hilite :: Void -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite Void
_ = ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty

instance (Hilite a, Hilite b) => Hilite (Either a b) where
  hilite :: Either a b -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = (a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> (b -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> Either a b
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite b -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite

instance (Hilite a, Hilite b) => Hilite (a, b) where
  hilite :: (a, b) -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (a
a, b
b) = a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite a
a ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> b -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite b
b

-- * Major syntactic categories
---------------------------------------------------------------------------

-- | Reengineered from the old Geniplate-implemented highlighting extraction.
-- This was the old procedure:
--
-- Traversal over declaration in abstract syntax that collects the
-- following hiliting information:
--
-- [1. @constructorInfo@ (highest prio)]
-- 2. @theRest@ (medium prio)
-- 3. @nameInfo@ (lowest prio)
--
-- @nameInfo@:
--   "All names mentioned in the syntax tree (not bound variables)."
-- For each possibly ambiguous name (QName and AmbiguousQName)
-- that not isExtendedLambdaName,
-- do @hiliteAmbiguous@ (used to be called@generate@).
--
-- @constructorInfo@ (only when highlighting level == Full):
--   "After the code has been type checked more information may be
--   available for overloaded constructors, and
--   generateConstructorInfo takes advantage of this information.
--   Note, however, that highlighting for overloaded constructors is
--   included also in nameInfo."
-- This is not computed by recursion over the abstract syntax,
-- but gets the constructor names stDisambiguatedNames
-- that fall within the bounds of the current declaration.
--
-- @theRest@:
--   Bound variables, dotted patterns, record fields, module names,
--   the "as" and "to" symbols and some other things.
--
-- Here is a table what @theRest@ used to collect:
--
-- ---------------------------------------------------------------------
-- | A.Expr
-- ---------------------------------------------------------------------
-- | getVarAndField (Expr) | A.Var                       | bound
-- | getVarAndField        | A.Rec(Update)               | field
-- | getExpr        (Expr) | A.PatternSyn                | patsyn
-- | getExpr               | A.Macro                     | macro
-- ---------------------------------------------------------------------
-- | A.LetBinding
-- ---------------------------------------------------------------------
-- | getLet                | A.LetBind                   | bound
-- ---------------------------------------------------------------------
-- | A.LamBinding
-- ---------------------------------------------------------------------
-- | getLam                | A.Binder under A.DomainFree | bound
-- | getTyped              | A.Binder under A.TBind      | bound
-- ---------------------------------------------------------------------
-- | A.Pattern'
-- ---------------------------------------------------------------------
-- | getPattern(Syn)       | A.VarP                      | bound
-- | getPattern(Syn)       | A.AsP                       | bound
-- | getPattern(Syn)       | A.DotP (not isProjP)        | DottedPattern
-- | getPattern(Syn)       | A.RecP                      | field
-- | getPattern(Syn)       | A.PatternSynP               | patsyn
-- ---------------------------------------------------------------------
-- | A.Declaration
-- ---------------------------------------------------------------------
-- | getFieldDecl          | A.Field under A.RecDef      | field
-- | getPatSynArgs         | A.PatternSynDef             | bound
-- | getPragma             | A.BuiltinPragma...          | keyword
-- ---------------------------------------------------------------------
-- | A.NamedArg (polymorphism not supported in geniplate)
-- ---------------------------------------------------------------------
-- | getNamedArg           | NamedArg a                  | nameOf
-- | getNamedArgE          | NamedArg Exp                | nameOf
-- | getNamedArgP          | NamedArg Pattern            | nameOf
-- | getNamedArgB          | NamedArg BindName           | nameOf
-- | getNamedArgL          | NamedArg LHSCore            | nameOf
--
-- | getModuleName         | A.MName                     | mod
-- | getModuleInfo         | ModuleInfo                  | asName, (range of as,to)
-- | getQuantityAttr       | Common.Quantity             | Symbol (if range)

instance Hilite A.RecordDirectives where
  hilite :: RecordDirectives
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (RecordDirectives Maybe (Ranged Induction)
_ Maybe (Ranged HasEta0)
_ Maybe Range
_ RecordConName
c) = RecordConName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite RecordConName
c

instance Hilite A.RecordConName where
  hilite :: RecordConName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
    A.NamedRecCon QName
x -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite QName
x
    A.FreshRecCon{} -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty

instance Hilite A.Declaration where
  hilite :: Declaration -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
      A.Axiom KindOfName
_ax DefInfo
_di ArgInfo
ai Maybe PragmaPolarities
_occ QName
x Expr
e            -> ArgInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ArgInfo
ai ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl QName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.Generalize Set QName
_names DefInfo
_di ArgInfo
ai QName
x Expr
e         -> ArgInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ArgInfo
ai ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl QName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.Field DefInfo
_di QName
x Arg Expr
e                        -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hlField QName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Arg Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Arg Expr
e
      A.Primitive DefInfo
_di QName
x Arg Expr
e                    -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl QName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Arg Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Arg Expr
e
      A.Mutual MutualInfo
_mi NonEmpty Declaration
ds                        -> NonEmpty Declaration
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl NonEmpty Declaration
ds
      A.Section Range
_r Erased
er ModuleName
x GeneralizeTelescope
tel [Declaration]
ds               -> Erased -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Erased
er ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ModuleName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> GeneralizeTelescope
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl GeneralizeTelescope
tel ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [Declaration]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [Declaration]
ds
      A.Apply ModuleInfo
mi Erased
er ModuleName
x ModuleApplication
a ScopeCopyInfo
_ci ImportDirective' QName ModuleName
dir              -> ModuleInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleInfo
mi ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Erased -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Erased
er ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ModuleName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<>
                                                ModuleApplication
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleApplication
a ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ImportDirective' QName ModuleName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ImportDirective' QName ModuleName
dir
      A.Import ModuleInfo
mi ModuleName
x ImportDirective' QName ModuleName
dir                      -> ModuleInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleInfo
mi ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ModuleName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ImportDirective' QName ModuleName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ImportDirective' QName ModuleName
dir
      A.Open ModuleInfo
mi ModuleName
x ImportDirective' QName ModuleName
dir                        -> ModuleInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleInfo
mi ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ModuleName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ImportDirective' QName ModuleName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ImportDirective' QName ModuleName
dir
      A.FunDef DefInfo
_di QName
x NonEmpty Clause
cs                      -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl QName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> NonEmpty Clause
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl NonEmpty Clause
cs
      A.DataSig DefInfo
_di Erased
er QName
x GeneralizeTelescope
tel Expr
e               -> Erased -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Erased
er ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl QName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> GeneralizeTelescope
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl GeneralizeTelescope
tel ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.DataDef DefInfo
_di QName
x PositivityCheck
_pc UniverseCheck
_uc DataDefParams
pars [Declaration]
cs        -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl QName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> DataDefParams
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl DataDefParams
pars ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [Declaration]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [Declaration]
cs
      A.RecSig DefInfo
_di Erased
er QName
x GeneralizeTelescope
tel Expr
e                -> Erased -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Erased
er ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl QName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> GeneralizeTelescope
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl GeneralizeTelescope
tel ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.RecDef DefInfo
_di QName
x PositivityCheck
_pc UniverseCheck
_uc ForceRecordEta
_eta RecordDirectives
dir DataDefParams
bs Expr
e [Declaration]
ds-> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl QName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> RecordDirectives
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl RecordDirectives
dir ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> DataDefParams
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl DataDefParams
bs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [Declaration]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [Declaration]
ds
      A.PatternSynDef QName
x [WithHiding BindName]
xs Pattern' Void
p                 -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl QName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [WithHiding BindName]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [WithHiding BindName]
xs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Pattern' Void
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Pattern' Void
p
      A.UnquoteDecl MutualInfo
_mi [DefInfo]
_di [QName]
xs Expr
e             -> [QName] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [QName]
xs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.UnquoteDef [DefInfo]
_di [QName]
xs Expr
e                  -> [QName] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [QName]
xs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.UnquoteData [DefInfo]
_i QName
xs UniverseCheck
_uc [DefInfo]
_j [QName]
cs Expr
e        -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl QName
xs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [QName] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [QName]
cs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.ScopedDecl ScopeInfo
s NonEmpty Declaration
ds                      -> NonEmpty Declaration
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl NonEmpty Declaration
ds
      A.Pragma Range
_r Pragma
pragma                     -> Pragma -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Pragma
pragma
      A.UnfoldingDecl Range
_r [QName]
names               -> [QName] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [QName]
names
    where
    hl :: a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl      a
a = a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite a
a
    hlField :: QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hlField QName
x = [Name]
-> Name
-> Maybe Range
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteField (QName -> [Name]
concreteQualifier QName
x) (QName -> Name
concreteBase QName
x) (Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$ QName -> Range
forall a. HasNameBindingSite a => a -> Range
nameBindingSite QName
x)

instance Hilite A.Pragma where
  hilite :: Pragma -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
    A.OptionsPragma [RawName]
_strings        -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
    A.BuiltinPragma Ranged RawName
b ResolvedName
x             -> Aspect
-> Ranged RawName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
HasRange a =>
Aspect -> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
singleAspect Aspect
Keyword Ranged RawName
b ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ResolvedName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite ResolvedName
x
    A.BuiltinNoDefPragma Ranged RawName
b KindOfName
k QName
x      -> Aspect
-> Ranged RawName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
HasRange a =>
Aspect -> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
singleAspect Aspect
Keyword Ranged RawName
b ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Maybe NameKind
-> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteQName (NameKind -> Maybe NameKind
forall a. a -> Maybe a
Just (NameKind -> Maybe NameKind) -> NameKind -> Maybe NameKind
forall a b. (a -> b) -> a -> b
$ KindOfName -> NameKind
kindOfNameToNameKind KindOfName
k) QName
x
    A.CompilePragma Ranged BackendName
b QName
x RawName
_foreign    -> Aspect
-> Ranged BackendName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
HasRange a =>
Aspect -> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
singleAspect Aspect
Keyword Ranged BackendName
b ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite QName
x
    A.RewritePragma Range
r [QName]
xs            -> Aspect
-> Range -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
HasRange a =>
Aspect -> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
singleAspect Aspect
Keyword Range
r ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [QName] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [QName]
xs
    A.StaticPragma QName
x                -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite QName
x
    A.InjectivePragma QName
x             -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite QName
x
    A.InjectiveForInferencePragma QName
x -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite QName
x
    A.NotProjectionLikePragma QName
x     -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite QName
x
    A.OverlapPragma QName
x OverlapMode
_             -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite QName
x
    A.InlinePragma Bool
_inline QName
x        -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite QName
x
    A.DisplayPragma QName
x [NamedArg Pattern]
ps Expr
e          -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite QName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [NamedArg Pattern]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [NamedArg Pattern]
ps ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite Expr
e

instance Hilite A.Expr where
  hilite :: Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
      A.Var Name
x                       -> BindName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl (BindName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> BindName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ Name -> BindName
A.BindName Name
x        -- bound variable like binder
      A.Def' QName
q Suffix
_                    -> Maybe NameKind
-> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteQName Maybe NameKind
forall a. Maybe a
Nothing QName
q
      A.Proj ProjOrigin
_o AmbiguousQName
qs                  -> Maybe NameKind
-> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteAmbiguousQName Maybe NameKind
forall a. Maybe a
Nothing AmbiguousQName
qs  -- Issue #4604: not: hiliteProjection qs
                                         -- Names from @open R r@ should not be highlighted as projections
      A.Con AmbiguousQName
qs                      -> Maybe NameKind
-> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteAmbiguousQName Maybe NameKind
forall a. Maybe a
Nothing AmbiguousQName
qs  -- TODO? Con aspect
      A.PatternSyn AmbiguousQName
qs               -> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilitePatternSynonym AmbiguousQName
qs
      A.Macro QName
q                     -> Maybe NameKind
-> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteQName (NameKind -> Maybe NameKind
forall a. a -> Maybe a
Just NameKind
Macro) QName
q
      A.Lit ExprInfo
_r Literal
l                    -> Literal -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Literal
l
      A.QuestionMark MetaInfo
_mi InteractionId
_ii        -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
      A.Underscore MetaInfo
_mi              -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
      A.Dot ExprInfo
_r Expr
e                    -> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e                   -- TODO? Projection?
      A.App AppInfo
_r Expr
e Arg (Named_ Expr)
es                 -> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Arg (Named_ Expr)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Arg (Named_ Expr)
es
      A.WithApp ExprInfo
_r Expr
e NonEmpty Expr
es             -> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> NonEmpty Expr
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl NonEmpty Expr
es
      A.Lam ExprInfo
_r LamBinding
bs Expr
e                 -> LamBinding -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl LamBinding
bs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.AbsurdLam ExprInfo
_r Hiding
_h             -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
      A.ExtendedLam ExprInfo
_r DefInfo
_di Erased
er QName
_q NonEmpty Clause
cs -> Erased -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Erased
er ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> NonEmpty Clause
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl NonEmpty Clause
cs -- No hilighting of generated extended lambda name!
      A.Pi ExprInfo
_r NonEmpty TypedBinding
tel Expr
b                 -> NonEmpty TypedBinding
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl NonEmpty TypedBinding
tel ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
b
      A.Generalized Set1 QName
_qs Expr
e           -> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.Fun ExprInfo
_r Arg Expr
a Expr
b                  -> Arg Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Arg Expr
a ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
b
      A.Let ExprInfo
_r NonEmpty LetBinding
bs Expr
e                 -> NonEmpty LetBinding
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl NonEmpty LetBinding
bs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.Rec KwRange
_kwr ExprInfo
_r [RecordAssign]
ass             -> [RecordAssign]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [RecordAssign]
ass
      A.RecUpdate KwRange
_kwr ExprInfo
_r Expr
e [Assign]
ass     -> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [Assign] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [Assign]
ass
      A.RecWhere KwRange
_kwr ExprInfo
_r [LetBinding]
e [Assign]
ass      -> [LetBinding] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [LetBinding]
e
      A.RecUpdateWhere KwRange
_k ExprInfo
_r Expr
e [LetBinding]
bs [Assign]
_ -> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [LetBinding] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [LetBinding]
bs
      A.ScopedExpr ScopeInfo
_ Expr
e              -> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.Quote ExprInfo
_r                    -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
      A.QuoteTerm ExprInfo
_r                -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
      A.Unquote ExprInfo
_r                  -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
      A.DontCare Expr
e                  -> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.Qualified ModuleName
m Expr
e               -> ModuleName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleName
m ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.Highlighted Aspects
m Expr
e             -> DelayedMerge RangePair
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. a -> ReaderT HiliteEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ranges -> Aspects -> DelayedMerge RangePair
forall a m. IsBasicRangeMap a m => Ranges -> a -> m
H.singleton (Range -> Ranges
rToR (Range -> Ranges) -> Range -> Ranges
forall a b. (a -> b) -> a -> b
$ Expr -> Range
forall a. HasRange a => a -> Range
getRange Expr
e) Aspects
m) ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
    where
    hl :: a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl a
a = a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite a
a

instance (Hilite a, IsProjP a) => Hilite (A.Pattern' a) where
  hilite :: Pattern' a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
      A.VarP BindName
x               -> BindName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl BindName
x
      A.ConP ConPatInfo
_i AmbiguousQName
qs [NamedArg (Pattern' a)]
es        -> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteInductiveConstructor AmbiguousQName
qs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [NamedArg (Pattern' a)]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [NamedArg (Pattern' a)]
es
        -- No matching on coinductive constructors, thus, can determine NameKind here.
      A.ProjP PatInfo
_r ProjOrigin
_o AmbiguousQName
qs       -> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteProjection AmbiguousQName
qs
      A.DefP PatInfo
_r AmbiguousQName
qs [NamedArg (Pattern' a)]
es        -> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl AmbiguousQName
qs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [NamedArg (Pattern' a)]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [NamedArg (Pattern' a)]
es
      A.WildP PatInfo
_r             -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
      A.AsP PatInfo
_r BindName
x Pattern' a
p           -> BindName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl BindName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Pattern' a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Pattern' a
p
      A.DotP PatInfo
r a
e             -> case a -> Maybe (ProjOrigin, AmbiguousQName)
forall a. IsProjP a => a -> Maybe (ProjOrigin, AmbiguousQName)
isProjP a
e of
                                  Maybe (ProjOrigin, AmbiguousQName)
Nothing       -> OtherAspect
-> PatInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
HasRange a =>
OtherAspect
-> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
singleOtherAspect OtherAspect
DottedPattern PatInfo
r ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl a
e
                                  Just (ProjOrigin
_o, AmbiguousQName
qs) -> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteProjection AmbiguousQName
qs
      A.AbsurdP PatInfo
_r           -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
      A.LitP PatInfo
_r Literal
l            -> Literal -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Literal
l
      A.PatternSynP PatInfo
_r AmbiguousQName
qs [NamedArg (Pattern' a)]
es -> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilitePatternSynonym AmbiguousQName
qs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [NamedArg (Pattern' a)]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [NamedArg (Pattern' a)]
es
      A.RecP KwRange
_kwr ConPatInfo
_r [FieldAssignment' (Pattern' a)]
ps      -> [FieldAssignment' (Pattern' a)]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [FieldAssignment' (Pattern' a)]
ps
      A.EqualP PatInfo
_r NonEmpty (a, a)
ps         -> NonEmpty (a, a)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl NonEmpty (a, a)
ps
      A.WithP PatInfo
_ Pattern' a
p            -> Pattern' a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Pattern' a
p

    where
    hl :: a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl a
a = a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite a
a

instance Hilite Literal where
  hilite :: Literal -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
    LitNat{}                 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
    LitWord64{}              -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
    LitFloat{}               -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
    LitString{}              -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
    LitChar{}                -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
    LitQName QName
x               -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite QName
x
    LitMeta TopLevelModuleName' Range
_fileName MetaId
_id    -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty

-- * Minor syntactic categories
---------------------------------------------------------------------------

instance Hilite A.LHS where
  hilite :: LHS -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (A.LHS LHSInfo
_r LHSCore' Expr
lhs) = LHSCore' Expr
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite LHSCore' Expr
lhs

instance (Hilite a, IsProjP a) => Hilite (A.LHSCore' a) where
  hilite :: LHSCore' a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
    A.LHSHead QName
q [NamedArg (Pattern' a)]
ps       -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite QName
q   ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [NamedArg (Pattern' a)]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [NamedArg (Pattern' a)]
ps
    A.LHSProj AmbiguousQName
q Arg (Named_ (LHSCore' a))
lhs [NamedArg (Pattern' a)]
ps   -> Arg (Named_ (LHSCore' a))
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite Arg (Named_ (LHSCore' a))
lhs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite AmbiguousQName
q   ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [NamedArg (Pattern' a)]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [NamedArg (Pattern' a)]
ps -- TODO? Projection?
    A.LHSWith LHSCore' a
lhs NonEmpty (Arg (Pattern' a))
wps [NamedArg (Pattern' a)]
ps -> LHSCore' a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite LHSCore' a
lhs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (Arg (Pattern' a))
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite NonEmpty (Arg (Pattern' a))
wps ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [NamedArg (Pattern' a)]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [NamedArg (Pattern' a)]
ps

instance Hilite A.RHS where
  hilite :: RHS -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
      A.RHS Expr
e Maybe Expr
_ce                          -> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      RHS
A.AbsurdRHS                          -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
      A.WithRHS QName
_q NonEmpty WithExpr
es NonEmpty Clause
cs                   -> NonEmpty WithExpr
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl NonEmpty WithExpr
es  ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> NonEmpty Clause
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl NonEmpty Clause
cs  -- No highlighting for with-function-name!
      A.RewriteRHS [RewriteEqn]
eqs [ProblemEq]
strippedPats RHS
rhs WhereDeclarations
wh -> [RewriteEqn] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [RewriteEqn]
eqs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [ProblemEq] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl [ProblemEq]
strippedPats ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> RHS -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl RHS
rhs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> WhereDeclarations
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl WhereDeclarations
wh
    where
    hl :: a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl a
a = a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite a
a

instance (HasRange n, Hilite p, Hilite e) => Hilite (RewriteEqn' x n p e) where
  hilite :: RewriteEqn' x n p e
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
    Rewrite List1 (x, e)
es    -> NonEmpty e -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (NonEmpty e -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> NonEmpty e
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ ((x, e) -> e) -> List1 (x, e) -> NonEmpty e
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x, e) -> e
forall a b. (a, b) -> b
snd List1 (x, e)
es
    Invert x
_x NonEmpty (Named n (p, e))
pes -> NonEmpty (Named n (p, e))
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite NonEmpty (Named n (p, e))
pes
    LeftLet NonEmpty (p, e)
pes   -> NonEmpty (p, e)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite NonEmpty (p, e)
pes

instance Hilite a => Hilite (A.Clause' a) where
  hilite :: Clause' a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (A.Clause a
lhs [ProblemEq]
strippedPats RHS
rhs WhereDeclarations
wh Catchall
_catchall) =
    a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite a
lhs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [ProblemEq] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [ProblemEq]
strippedPats ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> RHS -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite RHS
rhs ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> WhereDeclarations
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite WhereDeclarations
wh

instance Hilite A.ProblemEq where
  hilite :: ProblemEq -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (A.ProblemEq Pattern
p Term
_t Dom Type
_dom) = Pattern -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite Pattern
p

instance Hilite A.WhereDeclarations where
  hilite :: WhereDeclarations
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (A.WhereDecls Maybe ModuleName
m Bool
_ Maybe Declaration
ds) = Maybe ModuleName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite Maybe ModuleName
m ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Maybe Declaration
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite Maybe Declaration
ds

instance Hilite A.GeneralizeTelescope where
  hilite :: GeneralizeTelescope
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (A.GeneralizeTel Map QName Name
_gen [TypedBinding]
tel) = [TypedBinding]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [TypedBinding]
tel

instance Hilite A.DataDefParams where
  hilite :: DataDefParams
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (A.DataDefParams Set Name
_gen [LamBinding]
pars) = [LamBinding] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [LamBinding]
pars

instance Hilite A.ModuleApplication where
  hilite :: ModuleApplication
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
    A.SectionApp [TypedBinding]
tel ModuleName
x [Arg (Named_ Expr)]
es    -> [TypedBinding]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [TypedBinding]
tel ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ModuleName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite ModuleName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [Arg (Named_ Expr)]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [Arg (Named_ Expr)]
es
    A.RecordModuleInstance ModuleName
x -> ModuleName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite ModuleName
x

instance Hilite A.LetBinding where
  hilite :: LetBinding -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
      A.LetBind    LetInfo
_r ArgInfo
ai BindName
x Expr
t Expr
e     -> ArgInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ArgInfo
ai ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> BindName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl BindName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
t ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.LetAxiom   LetInfo
_r ArgInfo
ai BindName
x Expr
t       -> ArgInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ArgInfo
ai ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> BindName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl BindName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
t
      A.LetPatBind LetInfo
_r ArgInfo
ai Pattern
p Expr
e       -> ArgInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ArgInfo
ai ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Pattern -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Pattern
p  ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Expr
e
      A.LetApply ModuleInfo
mi Erased
er ModuleName
x ModuleApplication
es ScopeCopyInfo
_c ImportDirective' QName ModuleName
dir -> ModuleInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleInfo
mi ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Erased -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl Erased
er ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ModuleName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<>
                                      ModuleApplication
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleApplication
es ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ImportDirective' QName ModuleName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ImportDirective' QName ModuleName
dir
      A.LetOpen ModuleInfo
mi ModuleName
x ImportDirective' QName ModuleName
dir           -> ModuleInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleInfo
mi ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ModuleName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ModuleName
x ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ImportDirective' QName ModuleName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl ImportDirective' QName ModuleName
dir
    where
    hl :: a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hl a
x = a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite a
x

instance Hilite A.TypedBindingInfo where
  hilite :: TypedBindingInfo
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (A.TypedBindingInfo TacticAttribute' Expr
x Bool
_) = TacticAttribute' Expr
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite TacticAttribute' Expr
x

instance Hilite A.TypedBinding where
  hilite :: TypedBinding -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
    A.TBind Range
_r TypedBindingInfo
tac NonEmpty (NamedArg Binder)
binds Expr
e -> TypedBindingInfo
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite TypedBindingInfo
tac ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (NamedArg Binder)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite NonEmpty (NamedArg Binder)
binds ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Expr -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite Expr
e
    A.TLet Range
_r NonEmpty LetBinding
binds        -> NonEmpty LetBinding
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite NonEmpty LetBinding
binds

instance Hilite A.LamBinding where
  hilite :: LamBinding -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
    A.DomainFree TacticAttribute' Expr
tac NamedArg Binder
binds -> TacticAttribute' Expr
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite TacticAttribute' Expr
tac ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> NamedArg Binder
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite NamedArg Binder
binds
    A.DomainFull TypedBinding
bind      -> TypedBinding -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite TypedBinding
bind

instance Hilite a => Hilite (A.Binder' a) where
  hilite :: Binder' a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (A.Binder Maybe Pattern
p BinderNameOrigin
_ a
x) = Maybe Pattern
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite Maybe Pattern
p ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite a
x

instance Hilite A.BindName where
  hilite :: BindName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (A.BindName Name
x) = Name -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteBound Name
x

instance Hilite a => Hilite (FieldAssignment' a) where
  hilite :: FieldAssignment' a
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (FieldAssignment Name
x a
e) = [Name]
-> Name
-> Maybe Range
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteField [] Name
x Maybe Range
forall a. Maybe a
Nothing ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite a
e

instance (Hilite a, HasRange n) => Hilite (Named n a) where
  hilite :: Named n a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (Named Maybe n
mn a
e)
    =  ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> (n -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> Maybe n
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty (Aspect -> n -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
HasRange a =>
Aspect -> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
singleAspect (Aspect
 -> n -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> Aspect
-> n
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ Maybe NameKind -> Bool -> Aspect
Name (NameKind -> Maybe NameKind
forall a. a -> Maybe a
Just NameKind
Argument) Bool
False) Maybe n
mn
    ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite a
e

instance Hilite a => Hilite (Arg a) where
  hilite :: Arg a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (Arg ArgInfo
ai a
e) = ArgInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite ArgInfo
ai ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite a
e

instance Hilite ArgInfo where
  hilite :: ArgInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (ArgInfo Hiding
_hiding Modality
modality Origin
_origin FreeVariables
_fv Annotation
_a) = Modality -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite Modality
modality

instance Hilite Modality where
  hilite :: Modality -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (Modality Relevance
_relevance Quantity
quantity Cohesion
_cohesion PolarityModality
_polarity) = Quantity -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite Quantity
quantity

-- | If the 'Quantity' attribute comes with a 'Range', highlight the
-- corresponding attribute as 'Symbol'.
instance Hilite Quantity where
  hilite :: Quantity -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = Aspect
-> Quantity -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
HasRange a =>
Aspect -> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
singleAspect Aspect
Symbol

-- | Erasure attributes are highlighted as symbols.
instance Hilite Erased where
  hilite :: Erased -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = Aspect
-> Erased -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
HasRange a =>
Aspect -> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
singleAspect Aspect
Symbol

instance Hilite ModuleInfo where
  hilite :: ModuleInfo -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (ModuleInfo Range
_r Range
rAsTo Maybe Name
asName OpenShortHand
_open Maybe ImportDirective
_impDir)
    =  Aspect
-> Range -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
HasRange a =>
Aspect -> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
singleAspect Aspect
Symbol Range
rAsTo            -- TODO: 'to' already covered by A.ImportDirective
    ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> (Name -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> Maybe Name
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty Name -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteAsName Maybe Name
asName
    -- <> hilite impDir                     -- Should be covered by A.ImportDirective
    where
    hiliteAsName :: C.Name -> Hiliter
    hiliteAsName :: Name -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteAsName Name
n = [Name]
-> Name
-> Range
-> Maybe Range
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteCName [] Name
n Range
forall a. Range' a
noRange Maybe Range
forall a. Maybe a
Nothing ((Bool -> Aspects)
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ NameKind -> Bool -> Aspects
nameAsp NameKind
Module

instance (Hilite m, Hilite n, Hilite (RenamingTo m), Hilite (RenamingTo n))
       => Hilite (ImportDirective' m n) where
  hilite :: ImportDirective' m n
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (ImportDirective Range
_r Using' m n
using [ImportedName' m n]
hiding [Renaming' m n]
renaming Maybe KwRange
_ropen) =
    Using' m n -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite Using' m n
using ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [ImportedName' m n]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [ImportedName' m n]
hiding ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> [Renaming' m n]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [Renaming' m n]
renaming

instance (Hilite m, Hilite n) => Hilite (Using' m n) where
  hilite :: Using' m n -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
    Using' m n
UseEverything -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
    Using [ImportedName' m n]
using   -> [ImportedName' m n]
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite [ImportedName' m n]
using

instance (Hilite m, Hilite n, Hilite (RenamingTo m), Hilite (RenamingTo n))
       => Hilite (Renaming' m n) where
  hilite :: Renaming' m n
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (Renaming ImportedName' m n
from ImportedName' m n
to Maybe Fixity
_fixity Range
rangeKwTo)
    =  ImportedName' m n
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite ImportedName' m n
from
    ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> Aspect
-> Range -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
HasRange a =>
Aspect -> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
singleAspect Aspect
Symbol Range
rangeKwTo
         -- Currently, the "to" is already highlited by rAsTo above.
         -- TODO: remove the "to" ranges from rAsTo.
    ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Semigroup a => a -> a -> a
<> RenamingTo (ImportedName' m n)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (ImportedName' m n -> RenamingTo (ImportedName' m n)
forall a. a -> RenamingTo a
RenamingTo ImportedName' m n
to)

instance (Hilite m, Hilite n) => Hilite (ImportedName' m n) where
  hilite :: ImportedName' m n
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
    ImportedModule n
m -> n -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite n
m
    ImportedName   m
n -> m -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite m
n

-- * Highlighting of names
---------------------------------------------------------------------------

instance Hilite DisambiguatedName where
  hilite :: DisambiguatedName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (DisambiguatedName NameKind
k QName
x) = Maybe NameKind
-> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteQName (NameKind -> Maybe NameKind
forall a. a -> Maybe a
Just NameKind
k) QName
x

instance Hilite ResolvedName where
  hilite :: ResolvedName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = \case
    VarName           Name
x BindingSource
_bindSrc -> Name -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteBound Name
x
    DefinedName  Access
_acc AbstractName
x Suffix
_suffix  -> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ AbstractName -> QName
anameName AbstractName
x
    FieldName         List1 AbstractName
xs         -> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteProjection (AmbiguousQName
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ List1 AbstractName -> AmbiguousQName
A.ambigName List1 AbstractName
xs
    ConstructorName Set1 Induction
i List1 AbstractName
xs         -> Maybe NameKind
-> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteAmbiguousQName Maybe NameKind
k (AmbiguousQName
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ List1 AbstractName -> AmbiguousQName
A.ambigName List1 AbstractName
xs
      where k :: Maybe NameKind
k = KindOfName -> NameKind
kindOfNameToNameKind (KindOfName -> NameKind) -> Maybe KindOfName -> Maybe NameKind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set1 Induction -> Maybe KindOfName
forall (t :: * -> *). Foldable t => t Induction -> Maybe KindOfName
exactConName Set1 Induction
i
    PatternSynResName List1 AbstractName
xs         -> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilitePatternSynonym (AmbiguousQName
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ List1 AbstractName -> AmbiguousQName
A.ambigName List1 AbstractName
xs
    ResolvedName
UnknownName                  -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty

instance Hilite A.QName where
  hilite :: QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = Maybe NameKind
-> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteQName Maybe NameKind
forall a. Maybe a
Nothing

instance Hilite A.AmbiguousQName where
  hilite :: AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite = Maybe NameKind
-> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteAmbiguousQName Maybe NameKind
forall a. Maybe a
Nothing

instance Hilite A.ModuleName where
  hilite :: ModuleName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite m :: ModuleName
m@(A.MName [Name]
xs) = (Bool, ModuleName)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteModule (Bool
isTopLevelModule, ModuleName
m)
    where
    isTopLevelModule :: Bool
isTopLevelModule =
      case (Name -> Maybe (TopLevelModuleName' Range))
-> [Name] -> [TopLevelModuleName' Range]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Range -> Maybe (TopLevelModuleName' Range)
P.rangeModule (Range -> Maybe (TopLevelModuleName' Range))
-> (Name -> Range) -> Name -> Maybe (TopLevelModuleName' Range)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Range
forall a. HasNameBindingSite a => a -> Range
A.nameBindingSite) [Name]
xs of
        []      -> Bool
False
        TopLevelModuleName' Range
top : [TopLevelModuleName' Range]
_ ->
          TopLevelModuleName' Range -> RawTopLevelModuleName
rawTopLevelModuleName TopLevelModuleName' Range
top RawTopLevelModuleName -> RawTopLevelModuleName -> Bool
forall a. Eq a => a -> a -> Bool
==
          ModuleName -> RawTopLevelModuleName
rawTopLevelModuleNameForModuleName ModuleName
m

  -- Andreas, 2020-09-29, issue #4952.
-- The target of a @renaming@ clause needs to be highlighted in a special way.
newtype RenamingTo a = RenamingTo a

instance Hilite (RenamingTo A.QName) where
  -- Andreas, 2020-09-29, issue #4952.
  -- Do not include the bindingSite, because the HTML backed turns it into garbage.
  hilite :: RenamingTo QName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (RenamingTo QName
q) = do
    kind <- (HiliteEnv -> NameKinds) -> ReaderT HiliteEnv Identity NameKinds
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HiliteEnv -> NameKinds
hleNameKinds ReaderT HiliteEnv Identity NameKinds
-> (NameKinds -> Maybe NameKind)
-> ReaderT HiliteEnv Identity (Maybe NameKind)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NameKinds -> NameKinds
forall a b. (a -> b) -> a -> b
$ QName
q)
    hiliteAName q False $ nameAsp' kind

instance Hilite (RenamingTo A.ModuleName) where
  -- Andreas, 2020-09-29, issue #4952.
  -- Do not include the bindingSite, because the HTML backed turns it into garbage.
  hilite :: RenamingTo ModuleName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (RenamingTo (A.MName [Name]
ns)) = ((Name -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
 -> [Name] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> [Name]
-> (Name -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> [Name] -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Name]
ns ((Name -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> (Name -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ \ Name
n ->
    [Name]
-> Name
-> Range
-> Maybe Range
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteCName [] (Name -> Name
A.nameConcrete Name
n) Range
forall a. Range' a
noRange Maybe Range
forall a. Maybe a
Nothing ((Bool -> Aspects)
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ NameKind -> Bool -> Aspects
nameAsp NameKind
Module

instance (Hilite (RenamingTo m), Hilite (RenamingTo n))
       => Hilite (RenamingTo (ImportedName' m n)) where
  hilite :: RenamingTo (ImportedName' m n)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (RenamingTo ImportedName' m n
x) = case ImportedName' m n
x of
    ImportedModule n
m -> RenamingTo n -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (n -> RenamingTo n
forall a. a -> RenamingTo a
RenamingTo n
m)
    ImportedName   m
n -> RenamingTo m -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a.
Hilite a =>
a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilite (m -> RenamingTo m
forall a. a -> RenamingTo a
RenamingTo m
n)

hiliteQName
  :: Maybe NameKind   -- ^ Is 'NameKind' already known from the context?
  -> A.QName
  -> Hiliter
hiliteQName :: Maybe NameKind
-> QName -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteQName Maybe NameKind
mkind QName
q
  | QName -> Bool
isExtendedLambdaName QName
q = ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
  | QName -> Bool
isAbsurdLambdaName   QName
q = ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
  | Bool
otherwise = do
      kind <- Maybe NameKind
-> (NameKind -> ReaderT HiliteEnv Identity (Maybe NameKind))
-> ReaderT HiliteEnv Identity (Maybe NameKind)
-> ReaderT HiliteEnv Identity (Maybe NameKind)
forall a b. Maybe a -> (a -> b) -> b -> b
ifJust Maybe NameKind
mkind (Maybe NameKind -> ReaderT HiliteEnv Identity (Maybe NameKind)
forall a. a -> ReaderT HiliteEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NameKind -> ReaderT HiliteEnv Identity (Maybe NameKind))
-> (NameKind -> Maybe NameKind)
-> NameKind
-> ReaderT HiliteEnv Identity (Maybe NameKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameKind -> Maybe NameKind
forall a. a -> Maybe a
Just) {-else-} (ReaderT HiliteEnv Identity (Maybe NameKind)
 -> ReaderT HiliteEnv Identity (Maybe NameKind))
-> ReaderT HiliteEnv Identity (Maybe NameKind)
-> ReaderT HiliteEnv Identity (Maybe NameKind)
forall a b. (a -> b) -> a -> b
$ (HiliteEnv -> NameKinds) -> ReaderT HiliteEnv Identity NameKinds
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HiliteEnv -> NameKinds
hleNameKinds ReaderT HiliteEnv Identity NameKinds
-> (NameKinds -> Maybe NameKind)
-> ReaderT HiliteEnv Identity (Maybe NameKind)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NameKinds -> NameKinds
forall a b. (a -> b) -> a -> b
$ QName
q)
      hiliteAName q True $ nameAsp' kind

-- | Takes the first 'NameKind'.  Binding site only included if unique.
hiliteAmbiguousQName
  :: Maybe NameKind   -- ^ Is 'NameKind' already known from the context?
  -> A.AmbiguousQName
  -> Hiliter
hiliteAmbiguousQName :: Maybe NameKind
-> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteAmbiguousQName Maybe NameKind
mkind AmbiguousQName
x = do
  kind <- Maybe NameKind
-> (NameKind -> ReaderT HiliteEnv Identity (Maybe NameKind))
-> ReaderT HiliteEnv Identity (Maybe NameKind)
-> ReaderT HiliteEnv Identity (Maybe NameKind)
forall a b. Maybe a -> (a -> b) -> b -> b
ifJust Maybe NameKind
mkind (Maybe NameKind -> ReaderT HiliteEnv Identity (Maybe NameKind)
forall a. a -> ReaderT HiliteEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NameKind -> ReaderT HiliteEnv Identity (Maybe NameKind))
-> (NameKind -> Maybe NameKind)
-> NameKind
-> ReaderT HiliteEnv Identity (Maybe NameKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameKind -> Maybe NameKind
forall a. a -> Maybe a
Just) {-else-} (ReaderT HiliteEnv Identity (Maybe NameKind)
 -> ReaderT HiliteEnv Identity (Maybe NameKind))
-> ReaderT HiliteEnv Identity (Maybe NameKind)
-> ReaderT HiliteEnv Identity (Maybe NameKind)
forall a b. (a -> b) -> a -> b
$ do
    kinds <- (HiliteEnv -> NameKinds) -> ReaderT HiliteEnv Identity NameKinds
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HiliteEnv -> NameKinds
hleNameKinds
    pure $ listToMaybe $ List1.catMaybes $ fmap kinds qs
      -- Ulf, 2014-06-03: [issue1064] It's better to pick the first rather
      -- than doing no highlighting if there's an ambiguity between an
      -- inductive and coinductive constructor.
  flip foldMap qs $ \ QName
q ->
    QName
-> Bool
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteAName QName
q Bool
include ((Bool -> Aspects)
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ Maybe NameKind -> Bool -> Aspects
nameAsp' Maybe NameKind
kind
  where
    qs :: NonEmpty QName
qs = AmbiguousQName -> NonEmpty QName
getAmbiguous AmbiguousQName
x
    include :: Bool
include = List1 Range -> Bool
forall a. Eq a => List1 a -> Bool
List1.allEqual (List1 Range -> Bool) -> List1 Range -> Bool
forall a b. (a -> b) -> a -> b
$ (QName -> Range) -> NonEmpty QName -> List1 Range
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QName -> Range
forall a. HasNameBindingSite a => a -> Range
nameBindingSite NonEmpty QName
qs

hiliteBound :: A.Name -> Hiliter
hiliteBound :: Name -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteBound Name
x =
  [Name]
-> Name
-> Range
-> Maybe Range
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteCName [] (Name -> Name
A.nameConcrete Name
x) Range
forall a. Range' a
noRange (Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$ Name -> Range
forall a. HasNameBindingSite a => a -> Range
A.nameBindingSite Name
x) ((Bool -> Aspects)
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ NameKind -> Bool -> Aspects
nameAsp NameKind
Bound

hiliteInductiveConstructor :: A.AmbiguousQName -> Hiliter
hiliteInductiveConstructor :: AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteInductiveConstructor = Maybe NameKind
-> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteAmbiguousQName (Maybe NameKind
 -> AmbiguousQName
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> Maybe NameKind
-> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ NameKind -> Maybe NameKind
forall a. a -> Maybe a
Just (NameKind -> Maybe NameKind) -> NameKind -> Maybe NameKind
forall a b. (a -> b) -> a -> b
$ Induction -> NameKind
Constructor Induction
Inductive

hilitePatternSynonym :: A.AmbiguousQName -> Hiliter
hilitePatternSynonym :: AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hilitePatternSynonym = AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteInductiveConstructor  -- There are no coinductive pattern synonyms!?

hiliteProjection :: A.AmbiguousQName -> Hiliter
hiliteProjection :: AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteProjection = Maybe NameKind
-> AmbiguousQName
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteAmbiguousQName (NameKind -> Maybe NameKind
forall a. a -> Maybe a
Just NameKind
Field)

hiliteField :: [C.Name] -> C.Name -> Maybe Range -> Hiliter
hiliteField :: [Name]
-> Name
-> Maybe Range
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteField [Name]
xs Name
x Maybe Range
bindingR = [Name]
-> Name
-> Range
-> Maybe Range
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteCName [Name]
xs Name
x Range
forall a. Range' a
noRange Maybe Range
bindingR ((Bool -> Aspects)
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ NameKind -> Bool -> Aspects
nameAsp NameKind
Field

-- For top level modules, we set the binding site to the beginning of the file
-- so that clicking on an imported module will jump to the beginning of the file
-- which defines this module.
hiliteModule :: (Bool, A.ModuleName) -> Hiliter
hiliteModule :: (Bool, ModuleName)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteModule (Bool
isTopLevelModule, A.MName []) = ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. Monoid a => a
mempty
hiliteModule (Bool
isTopLevelModule, A.MName (Name
n:[Name]
ns)) =
  [Name]
-> Name
-> Range
-> Maybe Range
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteCName
    ((Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Name
A.nameConcrete [Name]
ms)
    (Name -> Name
A.nameConcrete Name
m)
    Range
forall a. Range' a
noRange
    Maybe Range
mR
    (NameKind -> Bool -> Aspects
nameAsp NameKind
Module)
  where
  ([Name]
ms, Name
m) = Name -> [Name] -> ([Name], Name)
forall a. a -> [a] -> ([a], a)
initLast1 Name
n [Name]
ns
  mR :: Maybe Range
mR = Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$
       Bool -> (Range -> Range) -> Range -> Range
forall b a. IsBool b => b -> (a -> a) -> a -> a
applyWhen Bool
isTopLevelModule Range -> Range
forall a. BeginningOfFile a => a -> Range
P.beginningOfFile (Range -> Range) -> Range -> Range
forall a b. (a -> b) -> a -> b
$
       Name -> Range
forall a. HasNameBindingSite a => a -> Range
A.nameBindingSite Name
m

-- This was Highlighting.Generate.nameToFile:
-- | Converts names to suitable 'File's.
hiliteCName
  :: [C.Name]
     -- ^ The name qualifier (may be empty).
  -> C.Name     -- ^ The base name.
  -> Range
     -- ^ The 'Range' of the name in its fixity declaration (if any).
  -> Maybe Range
     -- ^ The definition site of the name. The calculated
     --   meta information is extended with this information, if possible.
  -> (Bool -> Aspects)
     -- ^ Meta information to be associated with the name.
     --   The argument is 'True' iff the name is an operator.
  -> Hiliter
hiliteCName :: [Name]
-> Name
-> Range
-> Maybe Range
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteCName [Name]
xs Name
x Range
fr Maybe Range
mR Bool -> Aspects
asp = do
  env <- ReaderT HiliteEnv Identity HiliteEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
  -- We don't care if we get any funny ranges.
  if all (== Just (hleCurrentModuleName env)) moduleNames
  then pure $
    frFile <>
    H.singleton (rToR rs) (aspects { definitionSite = mFilePos })
  else mempty
  where
  aspects :: Aspects
aspects     = Bool -> Aspects
asp (Bool -> Aspects) -> Bool -> Aspects
forall a b. (a -> b) -> a -> b
$ Name -> Bool
C.isOperator Name
x
  moduleNames :: [Maybe (TopLevelModuleName' Range)]
moduleNames = (Name -> Maybe (Maybe (TopLevelModuleName' Range)))
-> [Name] -> [Maybe (TopLevelModuleName' Range)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Range -> Maybe (Maybe (TopLevelModuleName' Range))
P.rangeModule' (Range -> Maybe (Maybe (TopLevelModuleName' Range)))
-> (Name -> Range)
-> Name
-> Maybe (Maybe (TopLevelModuleName' Range))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Range
forall a. HasRange a => a -> Range
getRange) (Name
x Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
xs)
  frFile :: DelayedMerge RangePair
frFile      = Ranges -> Aspects -> DelayedMerge RangePair
forall a m. IsBasicRangeMap a m => Ranges -> a -> m
H.singleton (Range -> Ranges
rToR Range
fr) (Aspects -> DelayedMerge RangePair)
-> Aspects -> DelayedMerge RangePair
forall a b. (a -> b) -> a -> b
$
                Aspects
aspects { definitionSite = notHere <$> mFilePos }
  rs :: Range
rs          = [Name] -> Range
forall a. HasRange a => a -> Range
getRange (Name
x Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
xs)

  -- The fixity declaration should not get a symbolic anchor.
  notHere :: DefinitionSite -> DefinitionSite
notHere DefinitionSite
d = DefinitionSite
d { defSiteHere = False }

  mFilePos :: Maybe DefinitionSite
  mFilePos :: Maybe DefinitionSite
mFilePos = do
    r <- Maybe Range
mR
    P.Pn (Strict.Just f) p _ _ <- P.rStart r
    mod <- P.rangeFileName f
    -- Andreas, 2017-06-16, Issue #2604: Symbolic anchors.
    -- We drop the file name part from the qualifiers, since
    -- this is contained in the html file name already.
    -- We want to get anchors of the form:
    -- @<a name="TopLevelModule.html#LocalModule.NestedModule.identifier">@
    let qualifiers = Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
drop (TopLevelModuleName' Range -> Int
forall a. Sized a => a -> Int
size TopLevelModuleName' Range
mod) [Name]
xs
    -- For bound variables, we do not create symbolic anchors.
        local = Bool -> (Aspect -> Bool) -> Maybe Aspect -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Aspect -> Bool
isLocalAspect (Maybe Aspect -> Bool) -> Maybe Aspect -> Bool
forall a b. (a -> b) -> a -> b
$ Aspects -> Maybe Aspect
aspect Aspects
aspects
    return $ DefinitionSite
      { defSiteModule = mod
      , defSitePos    = fromIntegral p
        -- Is our current position the definition site?
      , defSiteHere   = r == getRange x
        -- For bound variables etc. we do not create a symbolic anchor name.
        -- Also not for names that include anonymous modules,
        -- otherwise, we do not get unique anchors.
      , defSiteAnchor = if local || C.isNoName x || any Common.isUnderscore qualifiers
          then Nothing
          else Just $ prettyShow $ foldr C.Qual (C.QName x) qualifiers
      }

  -- Is the name a bound variable or similar? If in doubt, yes.
  isLocalAspect :: Aspect -> Bool
  isLocalAspect :: Aspect -> Bool
isLocalAspect = \case
    Name (Just NameKind
kind) Bool
_ -> NameKind -> Bool
isLocal NameKind
kind
    Aspect
_ -> Bool
True
  isLocal :: NameKind -> Bool
  isLocal :: NameKind -> Bool
isLocal = \case
    NameKind
Bound         -> Bool
True
    NameKind
Generalizable -> Bool
True
    NameKind
Argument      -> Bool
True
    Constructor{} -> Bool
False
    NameKind
Datatype      -> Bool
False
    NameKind
Field         -> Bool
False
    NameKind
Function      -> Bool
False
    NameKind
Module        -> Bool
False
    NameKind
Postulate     -> Bool
False
    NameKind
Primitive     -> Bool
False
    NameKind
Record        -> Bool
False
    NameKind
Macro         -> Bool
False

-- This was Highlighting.Generate.nameToFileA:
-- | A variant of 'hiliteCName' for qualified abstract names.
hiliteAName
  :: A.QName
     -- ^ The name.
  -> Bool
     -- ^ Should the binding site be included in the file?
  -> (Bool -> Aspects)
     -- ^ Meta information to be associated with the name.
     -- ^ The argument is 'True' iff the name is an operator.
  -> Hiliter
hiliteAName :: QName
-> Bool
-> (Bool -> Aspects)
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
hiliteAName QName
x Bool
include Bool -> Aspects
asp = do
  currentModule <- (HiliteEnv -> TopLevelModuleName' Range)
-> ReaderT HiliteEnv Identity (TopLevelModuleName' Range)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HiliteEnv -> TopLevelModuleName' Range
hleCurrentModuleName
  hiliteCName (concreteQualifier x)
              (concreteBase x)
              (rangeOfFixityDeclaration currentModule)
              (if include then Just $ nameBindingSite x else Nothing)
              asp
    <> notationFile currentModule
  where
  -- TODO: Currently we highlight fixity and syntax declarations by
  -- producing highlighting something like once per occurrence of the
  -- related name(s) in the file of the declaration (and we explicitly
  -- avoid doing this for other files). Perhaps it would be better to
  -- only produce this highlighting once.

  rangeOfFixityDeclaration :: TopLevelModuleName' Range -> Range
rangeOfFixityDeclaration TopLevelModuleName' Range
currentModule =
    if Range -> Maybe (TopLevelModuleName' Range)
P.rangeModule Range
r Maybe (TopLevelModuleName' Range)
-> Maybe (TopLevelModuleName' Range) -> Bool
forall a. Eq a => a -> a -> Bool
== TopLevelModuleName' Range -> Maybe (TopLevelModuleName' Range)
forall a. a -> Maybe a
Just TopLevelModuleName' Range
currentModule
    then Range
r else Range
forall a. Range' a
noRange
    where
    r :: Range
r = Fixity' -> Range
theNameRange (Fixity' -> Range) -> Fixity' -> Range
forall a b. (a -> b) -> a -> b
$ Name -> Fixity'
A.nameFixity (Name -> Fixity') -> Name -> Fixity'
forall a b. (a -> b) -> a -> b
$ QName -> Name
A.qnameName QName
x

  notationFile :: TopLevelModuleName' Range
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
notationFile TopLevelModuleName' Range
currentModule = DelayedMerge RangePair
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. a -> ReaderT HiliteEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DelayedMerge RangePair
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> DelayedMerge RangePair
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$
    if Range -> Maybe (TopLevelModuleName' Range)
P.rangeModule ([NotationPart] -> Range
forall a. HasRange a => a -> Range
getRange [NotationPart]
notation) Maybe (TopLevelModuleName' Range)
-> Maybe (TopLevelModuleName' Range) -> Bool
forall a. Eq a => a -> a -> Bool
== TopLevelModuleName' Range -> Maybe (TopLevelModuleName' Range)
forall a. a -> Maybe a
Just TopLevelModuleName' Range
currentModule
    then [DelayedMerge RangePair] -> DelayedMerge RangePair
forall a. Monoid a => [a] -> a
mconcat ([DelayedMerge RangePair] -> DelayedMerge RangePair)
-> [DelayedMerge RangePair] -> DelayedMerge RangePair
forall a b. (a -> b) -> a -> b
$ (NotationPart -> DelayedMerge RangePair)
-> [NotationPart] -> [DelayedMerge RangePair]
forall a b. (a -> b) -> [a] -> [b]
map NotationPart -> DelayedMerge RangePair
genPartFile [NotationPart]
notation
    else DelayedMerge RangePair
forall a. Monoid a => a
mempty
    where
    notation :: [NotationPart]
notation = Fixity' -> [NotationPart]
theNotation (Fixity' -> [NotationPart]) -> Fixity' -> [NotationPart]
forall a b. (a -> b) -> a -> b
$ Name -> Fixity'
A.nameFixity (Name -> Fixity') -> Name -> Fixity'
forall a b. (a -> b) -> a -> b
$ QName -> Name
A.qnameName QName
x

    boundAspect :: Aspects
boundAspect = NameKind -> Bool -> Aspects
nameAsp NameKind
Bound Bool
False

    genPartFile :: NotationPart -> DelayedMerge RangePair
genPartFile (VarPart Range
r Ranged BoundVariablePosition
i)  = [Ranges] -> Aspects -> DelayedMerge RangePair
forall a hl.
(IsBasicRangeMap a hl, Monoid hl) =>
[Ranges] -> a -> hl
several [Range -> Ranges
rToR Range
r, Range -> Ranges
rToR (Range -> Ranges) -> Range -> Ranges
forall a b. (a -> b) -> a -> b
$ Ranged BoundVariablePosition -> Range
forall a. HasRange a => a -> Range
getRange Ranged BoundVariablePosition
i] Aspects
boundAspect
    genPartFile (HolePart Range
r Arg (Named_ (Ranged Int))
i) = [Ranges] -> Aspects -> DelayedMerge RangePair
forall a hl.
(IsBasicRangeMap a hl, Monoid hl) =>
[Ranges] -> a -> hl
several [Range -> Ranges
rToR Range
r, Range -> Ranges
rToR (Range -> Ranges) -> Range -> Ranges
forall a b. (a -> b) -> a -> b
$ Arg (Named_ (Ranged Int)) -> Range
forall a. HasRange a => a -> Range
getRange Arg (Named_ (Ranged Int))
i] Aspects
boundAspect
    genPartFile WildPart{}     = DelayedMerge RangePair
forall a. Monoid a => a
mempty
    genPartFile (IdPart Ranged RawName
x)     = Ranges -> Aspects -> DelayedMerge RangePair
forall a m. IsBasicRangeMap a m => Ranges -> a -> m
H.singleton (Range -> Ranges
rToR (Range -> Ranges) -> Range -> Ranges
forall a b. (a -> b) -> a -> b
$ Ranged RawName -> Range
forall a. HasRange a => a -> Range
getRange Ranged RawName
x) (Bool -> Aspects
asp Bool
False)

-- * Short auxiliary functions.
---------------------------------------------------------------------------

singleAspect :: HasRange a => Aspect -> a -> Hiliter
singleAspect :: forall a.
HasRange a =>
Aspect -> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
singleAspect Aspect
a a
x = DelayedMerge RangePair
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. a -> ReaderT HiliteEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DelayedMerge RangePair
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> DelayedMerge RangePair
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ Ranges -> Aspects -> DelayedMerge RangePair
forall a m. IsBasicRangeMap a m => Ranges -> a -> m
H.singleton (Range -> Ranges
rToR (Range -> Ranges) -> Range -> Ranges
forall a b. (a -> b) -> a -> b
$ a -> Range
forall a. HasRange a => a -> Range
getRange a
x) (Aspects -> DelayedMerge RangePair)
-> Aspects -> DelayedMerge RangePair
forall a b. (a -> b) -> a -> b
$ Aspects
parserBased { aspect = Just a }

singleOtherAspect :: HasRange a => OtherAspect -> a -> Hiliter
singleOtherAspect :: forall a.
HasRange a =>
OtherAspect
-> a -> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
singleOtherAspect OtherAspect
a a
x = DelayedMerge RangePair
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a. a -> ReaderT HiliteEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DelayedMerge RangePair
 -> ReaderT HiliteEnv Identity (DelayedMerge RangePair))
-> DelayedMerge RangePair
-> ReaderT HiliteEnv Identity (DelayedMerge RangePair)
forall a b. (a -> b) -> a -> b
$ Ranges -> Aspects -> DelayedMerge RangePair
forall a m. IsBasicRangeMap a m => Ranges -> a -> m
H.singleton (Range -> Ranges
rToR (Range -> Ranges) -> Range -> Ranges
forall a b. (a -> b) -> a -> b
$ a -> Range
forall a. HasRange a => a -> Range
getRange a
x) (Aspects -> DelayedMerge RangePair)
-> Aspects -> DelayedMerge RangePair
forall a b. (a -> b) -> a -> b
$ Aspects
parserBased { otherAspects = singleton a }

nameAsp' :: Maybe NameKind -> Bool -> Aspects
nameAsp' :: Maybe NameKind -> Bool -> Aspects
nameAsp' Maybe NameKind
k Bool
isOp = Aspects
parserBased { aspect = Just $ Name k isOp }

nameAsp :: NameKind -> Bool -> Aspects
nameAsp :: NameKind -> Bool -> Aspects
nameAsp = Maybe NameKind -> Bool -> Aspects
nameAsp' (Maybe NameKind -> Bool -> Aspects)
-> (NameKind -> Maybe NameKind) -> NameKind -> Bool -> Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameKind -> Maybe NameKind
forall a. a -> Maybe a
Just

concreteBase :: A.QName -> C.Name
concreteBase :: QName -> Name
concreteBase = Name -> Name
A.nameConcrete (Name -> Name) -> (QName -> Name) -> QName -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Name
A.qnameName

concreteQualifier :: A.QName -> [C.Name]
concreteQualifier :: QName -> [Name]
concreteQualifier = (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Name
A.nameConcrete ([Name] -> [Name]) -> (QName -> [Name]) -> QName -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [Name]
A.mnameToList (ModuleName -> [Name]) -> (QName -> ModuleName) -> QName -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> ModuleName
A.qnameModule