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

    -- {-# OPTIONS_GHC -fwarn-unused-imports #-}  -- Data.Semigroup is redundant in later GHC versions
    {-# OPTIONS_GHC -fwarn-unused-binds   #-}

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

    import Prelude hiding (null)

    import Control.Applicative
    import Control.Monad         ( (<=<) )
    import Control.Monad.Reader  ( MonadReader(..), asks, Reader, runReader )

    import qualified Data.Map      as Map
    import           Data.Maybe
    import           Data.Semigroup       ( Semigroup(..) )          -- for ghc 8.0
    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(..) )
    import qualified Agda.Syntax.Abstract      as A
    import           Agda.Syntax.Common        as Common
    import           Agda.Syntax.Concrete                ( FieldAssignment'(..) )
    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              ( AbstractName(..), ResolvedName(..), exactConName )

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

    import           Agda.Utils.FileName
    import           Agda.Utils.Function
    import           Agda.Utils.Functor
    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.Utils.Pretty
    import           Agda.Utils.Singleton

    -- Entry point:
    -- | Create highlighting info for some piece of syntax.
    runHighlighter ::
      Hilite a =>
      SourceToModule -> AbsolutePath -> NameKinds -> a ->
      HighlightingInfoBuilder
    runHighlighter :: forall a.
    Hilite a =>
    SourceToModule
    -> AbsolutePath -> NameKinds -> a -> HighlightingInfoBuilder
    runHighlighter SourceToModule
    modMap AbsolutePath
    fileName NameKinds
    kinds a
    x =
      Hiliter -> HiliteEnv -> HighlightingInfoBuilder
    forall r a. Reader r a -> r -> a
    runReader (a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite a
    x) (HiliteEnv -> HighlightingInfoBuilder)
    -> HiliteEnv -> HighlightingInfoBuilder
    forall a b. (a -> b) -> a -> b
    $
      HiliteEnv :: NameKinds -> SourceToModule -> AbsolutePath -> HiliteEnv
    HiliteEnv
        { hleNameKinds :: NameKinds
    hleNameKinds = NameKinds
    kinds
        , hleModMap :: SourceToModule
    hleModMap    = SourceToModule
    modMap
        , hleFileName :: AbsolutePath
    hleFileName  = AbsolutePath
    fileName
        }

    -- | Environment of the highlighter.
    data HiliteEnv = HiliteEnv
      { HiliteEnv -> NameKinds
    hleNameKinds :: NameKinds
          -- ^ Function mapping qualified names to their kind.
      , HiliteEnv -> SourceToModule
    hleModMap    :: SourceToModule
          -- ^ Maps source file paths to module names.
      , HiliteEnv -> AbsolutePath
    hleFileName  :: AbsolutePath
          -- ^ The file name of the current module. 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 :: Hiliter
    mempty  = HighlightingInfoBuilder -> Hiliter
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure HighlightingInfoBuilder
    forall a. Monoid a => a
    mempty
      mappend :: Hiliter -> Hiliter -> Hiliter
    mappend = Hiliter -> Hiliter -> Hiliter
    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 -> Hiliter) -> t b -> Hiliter
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap b -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite

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

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

    instance Hilite Void where
      hilite :: Void -> Hiliter
    hilite Void
    _ = Hiliter
    forall a. Monoid a => a
    mempty

    instance (Hilite a, Hilite b) => Hilite (Either a b) where
      hilite :: Either a b -> Hiliter
    hilite = (a -> Hiliter) -> (b -> Hiliter) -> Either a b -> Hiliter
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite b -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite

    instance (Hilite a, Hilite b) => Hilite (a, b) where
      hilite :: (a, b) -> Hiliter
    hilite (a
    a, b
    b) = a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite a
    a Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> b -> Hiliter
    forall a. Hilite a => a -> Hiliter
    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
    -- | getLet                | A.LetDeclaredVariable       | 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 -> Hiliter
    hilite (RecordDirectives Maybe (Ranged Induction)
    _ Maybe HasEta0
    _ Maybe Range
    _ Maybe QName
    c) = Maybe QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite Maybe QName
    c

    instance Hilite A.Declaration where
      hilite :: Declaration -> Hiliter
    hilite = \case
          A.Axiom KindOfName
    _ax DefInfo
    _di ArgInfo
    ai Maybe [Occurrence]
    _occ QName
    x Expr
    e            -> ArgInfo -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ArgInfo
    ai Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl QName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
          A.Generalize Set QName
    _names DefInfo
    _di ArgInfo
    ai QName
    x Expr
    e         -> ArgInfo -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ArgInfo
    ai Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl QName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
          A.Field DefInfo
    _di QName
    x Arg Expr
    e                        -> QName -> Hiliter
    hlField QName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Arg Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Arg Expr
    e
          A.Primitive DefInfo
    _di QName
    x Arg Expr
    e                    -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl QName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Arg Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Arg Expr
    e
          A.Mutual MutualInfo
    _mi [Declaration]
    ds                        -> [Declaration] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl [Declaration]
    ds
          A.Section Range
    _r ModuleName
    x GeneralizeTelescope
    tel [Declaration]
    ds                  -> ModuleName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> GeneralizeTelescope -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl GeneralizeTelescope
    tel Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> [Declaration] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl [Declaration]
    ds
          A.Apply ModuleInfo
    mi ModuleName
    x ModuleApplication
    a ScopeCopyInfo
    _ci ImportDirective
    dir                 -> ModuleInfo -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleInfo
    mi Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ModuleName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ModuleApplication -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleApplication
    a Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ImportDirective -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ImportDirective
    dir
          A.Import ModuleInfo
    mi ModuleName
    x ImportDirective
    dir                      -> ModuleInfo -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleInfo
    mi Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ModuleName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ImportDirective -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ImportDirective
    dir
          A.Open ModuleInfo
    mi ModuleName
    x ImportDirective
    dir                        -> ModuleInfo -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleInfo
    mi Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ModuleName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ImportDirective -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ImportDirective
    dir
          A.FunDef DefInfo
    _di QName
    x Delayed
    _delayed [Clause]
    cs             -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl QName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> [Clause] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl [Clause]
    cs
          A.DataSig DefInfo
    _di QName
    x GeneralizeTelescope
    tel Expr
    e                  -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl QName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> GeneralizeTelescope -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl GeneralizeTelescope
    tel Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
          A.DataDef DefInfo
    _di QName
    x UniverseCheck
    _uc DataDefParams
    pars [Declaration]
    cs            -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl QName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> DataDefParams -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl DataDefParams
    pars Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> [Declaration] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl [Declaration]
    cs
          A.RecSig DefInfo
    _di QName
    x GeneralizeTelescope
    tel Expr
    e                   -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl QName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> GeneralizeTelescope -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl GeneralizeTelescope
    tel Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
          A.RecDef DefInfo
    _di QName
    x UniverseCheck
    _uc RecordDirectives
    dir DataDefParams
    bs Expr
    e [Declaration]
    ds         -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl QName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> RecordDirectives -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl RecordDirectives
    dir Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> DataDefParams -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl DataDefParams
    bs Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> [Declaration] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl [Declaration]
    ds
          A.PatternSynDef QName
    x [Arg BindName]
    xs Pattern' Void
    p                 -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl QName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> [Arg BindName] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl [Arg BindName]
    xs Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Pattern' Void -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Pattern' Void
    p
          A.UnquoteDecl MutualInfo
    _mi [DefInfo]
    _di [QName]
    xs Expr
    e             -> [QName] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl [QName]
    xs Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
          A.UnquoteDef [DefInfo]
    _di [QName]
    xs Expr
    e                  -> [QName] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl [QName]
    xs Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
          A.ScopedDecl ScopeInfo
    s [Declaration]
    ds                      -> [Declaration] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl [Declaration]
    ds
          A.Pragma Range
    _r Pragma
    pragma                     -> Pragma -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Pragma
    pragma
        where
        hl :: a -> Hiliter
    hl      a
    a = a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite a
    a
        hlField :: QName -> Hiliter
    hlField QName
    x = [Name] -> Name -> Maybe Range -> Hiliter
    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
    bindingSite QName
    x)

    instance Hilite A.Pragma where
      hilite :: Pragma -> Hiliter
    hilite = \case
        A.OptionsPragma [String]
    _strings     -> Hiliter
    forall a. Monoid a => a
    mempty
        A.BuiltinPragma RString
    b ResolvedName
    x          -> Aspect -> RString -> Hiliter
    forall a. HasRange a => Aspect -> a -> Hiliter
    singleAspect Aspect
    Keyword RString
    b Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ResolvedName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite ResolvedName
    x
        A.BuiltinNoDefPragma RString
    b KindOfName
    k QName
    x   -> Aspect -> RString -> Hiliter
    forall a. HasRange a => Aspect -> a -> Hiliter
    singleAspect Aspect
    Keyword RString
    b Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Maybe NameKind -> QName -> Hiliter
    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 RString
    b QName
    x String
    _foreign -> Aspect -> RString -> Hiliter
    forall a. HasRange a => Aspect -> a -> Hiliter
    singleAspect Aspect
    Keyword RString
    b Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite QName
    x
        A.RewritePragma Range
    r [QName]
    xs         -> Aspect -> Range -> Hiliter
    forall a. HasRange a => Aspect -> a -> Hiliter
    singleAspect Aspect
    Keyword Range
    r Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> [QName] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite [QName]
    xs
        A.StaticPragma QName
    x             -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite QName
    x
        A.EtaPragma QName
    x                -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite QName
    x
        A.InjectivePragma QName
    x          -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite QName
    x
        A.InlinePragma Bool
    _inline QName
    x     -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite QName
    x
        A.DisplayPragma QName
    x [NamedArg Pattern]
    ps Expr
    e       -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite QName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> [NamedArg Pattern] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite [NamedArg Pattern]
    ps Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite Expr
    e

    instance Hilite A.Expr where
      hilite :: Expr -> Hiliter
    hilite = \case
          A.Var Name
    x                       -> BindName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl (BindName -> Hiliter) -> BindName -> Hiliter
    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 -> Hiliter
    hiliteQName Maybe NameKind
    forall a. Maybe a
    Nothing QName
    q
          A.Proj ProjOrigin
    _o AmbiguousQName
    qs                  -> Maybe NameKind -> AmbiguousQName -> Hiliter
    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 -> Hiliter
    hiliteAmbiguousQName Maybe NameKind
    forall a. Maybe a
    Nothing AmbiguousQName
    qs  -- TODO? Con aspect
          A.PatternSyn AmbiguousQName
    qs               -> AmbiguousQName -> Hiliter
    hilitePatternSynonym AmbiguousQName
    qs
          A.Macro QName
    q                     -> Maybe NameKind -> QName -> Hiliter
    hiliteQName (NameKind -> Maybe NameKind
    forall a. a -> Maybe a
    Just NameKind
    Macro) QName
    q
          A.Lit ExprInfo
    _r Literal
    l                    -> Literal -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Literal
    l
          A.QuestionMark MetaInfo
    _mi InteractionId
    _ii        -> Hiliter
    forall a. Monoid a => a
    mempty
          A.Underscore MetaInfo
    _mi              -> Hiliter
    forall a. Monoid a => a
    mempty
          A.Dot ExprInfo
    _r Expr
    e                    -> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e                   -- TODO? Projection?
          A.App AppInfo
    _r Expr
    e NamedArg Expr
    es                 -> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> NamedArg Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl NamedArg Expr
    es
          A.WithApp ExprInfo
    _r Expr
    e [Expr]
    es             -> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> [Expr] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl [Expr]
    es
          A.Lam ExprInfo
    _r LamBinding
    bs Expr
    e                 -> LamBinding -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl LamBinding
    bs Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
          A.AbsurdLam ExprInfo
    _r Hiding
    _h             -> Hiliter
    forall a. Monoid a => a
    mempty
          A.ExtendedLam ExprInfo
    _r DefInfo
    _di Erased
    _e QName
    _q List1 Clause
    cs -> List1 Clause -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl List1 Clause
    cs -- No hilighting of generated extended lambda name!
          A.Pi ExprInfo
    _r Telescope1
    tel Expr
    b                 -> Telescope1 -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Telescope1
    tel Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    b
          A.Generalized Set QName
    _qs Expr
    e           -> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
          A.Fun ExprInfo
    _r Arg Expr
    a Expr
    b                  -> Arg Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Arg Expr
    a Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    b
          A.Let ExprInfo
    _r List1 LetBinding
    bs Expr
    e                 -> List1 LetBinding -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl List1 LetBinding
    bs Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
          A.ETel Telescope
    _tel                   -> Hiliter
    forall a. Monoid a => a
    mempty  -- Printing only construct
          A.Rec ExprInfo
    _r RecordAssigns
    ass                  -> RecordAssigns -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl RecordAssigns
    ass
          A.RecUpdate ExprInfo
    _r Expr
    e Assigns
    ass          -> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Assigns -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Assigns
    ass
          A.ScopedExpr ScopeInfo
    _ Expr
    e              -> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
          A.Quote ExprInfo
    _r                    -> Hiliter
    forall a. Monoid a => a
    mempty
          A.QuoteTerm ExprInfo
    _r                -> Hiliter
    forall a. Monoid a => a
    mempty
          A.Unquote ExprInfo
    _r                  -> Hiliter
    forall a. Monoid a => a
    mempty
          A.DontCare Expr
    e                  -> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
        where
        hl :: a -> Hiliter
    hl a
    a = a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite a
    a

    instance (Hilite a, IsProjP a) => Hilite (A.Pattern' a) where
      hilite :: Pattern' a -> Hiliter
    hilite = \case
          A.VarP BindName
    x               -> BindName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl BindName
    x
          A.ConP ConPatInfo
    _i AmbiguousQName
    qs NAPs a
    es        -> AmbiguousQName -> Hiliter
    hiliteInductiveConstructor AmbiguousQName
    qs Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> NAPs a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl NAPs a
    es
            -- No matching on coinductive constructors, thus, can determine NameKind here.
          A.ProjP PatInfo
    _r ProjOrigin
    _o AmbiguousQName
    qs       -> AmbiguousQName -> Hiliter
    hiliteProjection AmbiguousQName
    qs
          A.DefP PatInfo
    _r AmbiguousQName
    qs NAPs a
    es        -> AmbiguousQName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl AmbiguousQName
    qs Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> NAPs a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl NAPs a
    es
          A.WildP PatInfo
    _r             -> Hiliter
    forall a. Monoid a => a
    mempty
          A.AsP PatInfo
    _r BindName
    x Pattern' a
    p           -> BindName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl BindName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Pattern' a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    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 -> Hiliter
    forall a. HasRange a => OtherAspect -> a -> Hiliter
    singleOtherAspect OtherAspect
    DottedPattern PatInfo
    r Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl a
    e
                                      Just (ProjOrigin
    _o, AmbiguousQName
    qs) -> AmbiguousQName -> Hiliter
    hiliteProjection AmbiguousQName
    qs
          A.AbsurdP PatInfo
    _r           -> Hiliter
    forall a. Monoid a => a
    mempty
          A.LitP PatInfo
    _r Literal
    l            -> Literal -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Literal
    l
          A.PatternSynP PatInfo
    _r AmbiguousQName
    qs NAPs a
    es -> AmbiguousQName -> Hiliter
    hilitePatternSynonym AmbiguousQName
    qs Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> NAPs a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl NAPs a
    es
          A.RecP PatInfo
    _r [FieldAssignment' (Pattern' a)]
    ps           -> [FieldAssignment' (Pattern' a)] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl [FieldAssignment' (Pattern' a)]
    ps
          A.EqualP PatInfo
    _r [(a, a)]
    ps         -> [(a, a)] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl [(a, a)]
    ps
          A.WithP PatInfo
    _ Pattern' a
    p            -> Pattern' a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Pattern' a
    p
          A.AnnP PatInfo
    _r a
    a Pattern' a
    p          -> Pattern' a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Pattern' a
    p

        where
        hl :: a -> Hiliter
    hl a
    a = a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite a
    a

    instance Hilite Literal where
      hilite :: Literal -> Hiliter
    hilite = \case
        LitNat{}                 -> Hiliter
    forall a. Monoid a => a
    mempty
        LitWord64{}              -> Hiliter
    forall a. Monoid a => a
    mempty
        LitFloat{}               -> Hiliter
    forall a. Monoid a => a
    mempty
        LitString{}              -> Hiliter
    forall a. Monoid a => a
    mempty
        LitChar{}                -> Hiliter
    forall a. Monoid a => a
    mempty
        LitQName QName
    x               -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite QName
    x
        LitMeta AbsolutePath
    _fileName MetaId
    _id    -> Hiliter
    forall a. Monoid a => a
    mempty

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

    instance Hilite A.LHS where
      hilite :: LHS -> Hiliter
    hilite (A.LHS LHSInfo
    _r LHSCore
    lhs) = LHSCore -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite LHSCore
    lhs

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

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

    instance (HasRange n, Hilite p, Hilite e) => Hilite (RewriteEqn' x n p e) where
      hilite :: RewriteEqn' x n p e -> Hiliter
    hilite = \case
        Rewrite List1 (x, e)
    es    -> NonEmpty e -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite (NonEmpty e -> Hiliter) -> NonEmpty e -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ ((x, e) -> e) -> List1 (x, e) -> NonEmpty e
    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 List1 (Named n (p, e))
    pes -> List1 (Named n (p, e)) -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite List1 (Named n (p, e))
    pes

    instance Hilite a => Hilite (A.Clause' a) where
      hilite :: Clause' a -> Hiliter
    hilite (A.Clause a
    lhs [ProblemEq]
    strippedPats RHS
    rhs WhereDeclarations
    wh Bool
    _catchall) =
        a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite a
    lhs Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> [ProblemEq] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite [ProblemEq]
    strippedPats Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> RHS -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite RHS
    rhs Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> WhereDeclarations -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite WhereDeclarations
    wh

    instance Hilite A.ProblemEq where
      hilite :: ProblemEq -> Hiliter
    hilite (A.ProblemEq Pattern
    p Term
    _t Dom Type
    _dom) = Pattern -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite Pattern
    p

    instance Hilite A.WhereDeclarations where
      hilite :: WhereDeclarations -> Hiliter
    hilite (A.WhereDecls Maybe ModuleName
    m Maybe Declaration
    ds) = Maybe ModuleName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite Maybe ModuleName
    m Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Maybe Declaration -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite Maybe Declaration
    ds

    instance Hilite A.GeneralizeTelescope where
      hilite :: GeneralizeTelescope -> Hiliter
    hilite (A.GeneralizeTel Map QName Name
    _gen Telescope
    tel) = Telescope -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite Telescope
    tel

    instance Hilite A.DataDefParams where
      hilite :: DataDefParams -> Hiliter
    hilite (A.DataDefParams Set Name
    _gen [LamBinding]
    pars) = [LamBinding] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite [LamBinding]
    pars

    instance Hilite A.ModuleApplication where
      hilite :: ModuleApplication -> Hiliter
    hilite = \case
        A.SectionApp Telescope
    tel ModuleName
    x [NamedArg Expr]
    es    -> Telescope -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite Telescope
    tel Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ModuleName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite ModuleName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> [NamedArg Expr] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite [NamedArg Expr]
    es
        A.RecordModuleInstance ModuleName
    x -> ModuleName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite ModuleName
    x

    instance Hilite A.LetBinding where
      hilite :: LetBinding -> Hiliter
    hilite = \case
          A.LetBind    LetInfo
    _r ArgInfo
    ai BindName
    x Expr
    t Expr
    e     -> ArgInfo -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ArgInfo
    ai Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> BindName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl BindName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    t Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
          A.LetPatBind LetInfo
    _r Pattern
    p Expr
    e          -> Pattern -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Pattern
    p  Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl Expr
    e
          A.LetApply   ModuleInfo
    mi ModuleName
    x ModuleApplication
    es ScopeCopyInfo
    _ci ImportDirective
    dir -> ModuleInfo -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleInfo
    mi Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ModuleName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ModuleApplication -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleApplication
    es Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ImportDirective -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ImportDirective
    dir
          A.LetOpen    ModuleInfo
    mi ModuleName
    x ImportDirective
    dir        -> ModuleInfo -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleInfo
    mi Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ModuleName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ModuleName
    x Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> ImportDirective -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl ImportDirective
    dir
          A.LetDeclaredVariable BindName
    x      -> BindName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hl BindName
    x
        where
        hl :: a -> Hiliter
    hl a
    x = a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite a
    x

    instance Hilite A.TypedBinding where
      hilite :: TypedBinding -> Hiliter
    hilite = \case
        A.TBind Range
    _r TacticAttr
    tac List1 (NamedArg Binder)
    binds Expr
    e -> TacticAttr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite TacticAttr
    tac Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> List1 (NamedArg Binder) -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite List1 (NamedArg Binder)
    binds Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Expr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite Expr
    e
        A.TLet Range
    _r List1 LetBinding
    binds        -> List1 LetBinding -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite List1 LetBinding
    binds

    instance Hilite A.LamBinding where
      hilite :: LamBinding -> Hiliter
    hilite = \case
        A.DomainFree TacticAttr
    tac NamedArg Binder
    binds -> TacticAttr -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite TacticAttr
    tac Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> NamedArg Binder -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite NamedArg Binder
    binds
        A.DomainFull TypedBinding
    bind      -> TypedBinding -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite TypedBinding
    bind

    instance Hilite a => Hilite (A.Binder' a) where
      hilite :: Binder' a -> Hiliter
    hilite (A.Binder Maybe Pattern
    p a
    x) = Maybe Pattern -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite Maybe Pattern
    p Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite a
    x

    instance Hilite A.BindName where
      hilite :: BindName -> Hiliter
    hilite (A.BindName Name
    x) = Name -> Hiliter
    hiliteBound Name
    x

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

    instance (Hilite a, HasRange n) => Hilite (Named n a) where
      hilite :: Named n a -> Hiliter
    hilite (Named Maybe n
    mn a
    e)
        =  Hiliter -> (n -> Hiliter) -> Maybe n -> Hiliter
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Hiliter
    forall a. Monoid a => a
    mempty (Aspect -> n -> Hiliter
    forall a. HasRange a => Aspect -> a -> Hiliter
    singleAspect (Aspect -> n -> Hiliter) -> Aspect -> n -> Hiliter
    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
        Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite a
    e

    instance Hilite a => Hilite (Arg a) where
      hilite :: Arg a -> Hiliter
    hilite (Arg ArgInfo
    ai a
    e) = ArgInfo -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite ArgInfo
    ai Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> a -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite a
    e

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

    instance Hilite Modality where
      hilite :: Modality -> Hiliter
    hilite (Modality Relevance
    _relevance Quantity
    quantity Cohesion
    _cohesion) = Quantity -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite Quantity
    quantity

    -- | If the 'Quantity' attribute comes with a 'Range', highlight the
    -- corresponding attribute as 'Symbol'.
    instance Hilite Quantity where
      hilite :: Quantity -> Hiliter
    hilite = Aspect -> Quantity -> Hiliter
    forall a. HasRange a => Aspect -> a -> Hiliter
    singleAspect Aspect
    Symbol

    instance Hilite ModuleInfo where
      hilite :: ModuleInfo -> Hiliter
    hilite (ModuleInfo Range
    _r Range
    rAsTo Maybe Name
    asName Maybe OpenShortHand
    _open Maybe ImportDirective
    _impDir)
        =  Aspect -> Range -> Hiliter
    forall a. HasRange a => Aspect -> a -> Hiliter
    singleAspect Aspect
    Symbol Range
    rAsTo            -- TODO: 'to' already covered by A.ImportDirective
        Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Hiliter -> (Name -> Hiliter) -> Maybe Name -> Hiliter
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Hiliter
    forall a. Monoid a => a
    mempty Name -> Hiliter
    hiliteAsName Maybe Name
    asName
        -- <> hilite impDir                     -- Should be covered by A.ImportDirective
        where
        hiliteAsName :: C.Name -> Hiliter
        hiliteAsName :: Name -> Hiliter
    hiliteAsName Name
    n = [Name]
    -> Name -> Range -> Maybe Range -> (Bool -> Aspects) -> Hiliter
    hiliteCName [] Name
    n Range
    forall a. Range' a
    noRange Maybe Range
    forall a. Maybe a
    Nothing ((Bool -> Aspects) -> Hiliter) -> (Bool -> Aspects) -> Hiliter
    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 -> Hiliter
    hilite (ImportDirective Range
    _r Using' m n
    using HidingDirective' m n
    hiding RenamingDirective' m n
    renaming Maybe Range
    _ropen) =
        Using' m n -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite Using' m n
    using Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> HidingDirective' m n -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite HidingDirective' m n
    hiding Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> RenamingDirective' m n -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite RenamingDirective' m n
    renaming

    instance (Hilite m, Hilite n) => Hilite (Using' m n) where
      hilite :: Using' m n -> Hiliter
    hilite = \case
        Using' m n
    UseEverything -> Hiliter
    forall a. Monoid a => a
    mempty
        Using [ImportedName' m n]
    using   -> [ImportedName' m n] -> Hiliter
    forall a. Hilite a => a -> Hiliter
    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 -> Hiliter
    hilite (Renaming ImportedName' m n
    from ImportedName' m n
    to Maybe Fixity
    _fixity Range
    rangeKwTo)
        =  ImportedName' m n -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite ImportedName' m n
    from
        Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> Aspect -> Range -> Hiliter
    forall a. HasRange a => Aspect -> a -> Hiliter
    singleAspect Aspect
    Symbol Range
    rangeKwTo
             -- Currently, the "to" is already highlited by rAsTo above.
             -- TODO: remove the "to" ranges from rAsTo.
        Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> RenamingTo (ImportedName' m n) -> Hiliter
    forall a. Hilite a => a -> Hiliter
    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 -> Hiliter
    hilite = \case
        ImportedModule n
    m -> n -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite n
    m
        ImportedName   m
    n -> m -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite m
    n

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

    instance Hilite DisambiguatedName where
      hilite :: DisambiguatedName -> Hiliter
    hilite (DisambiguatedName NameKind
    k QName
    x) = Maybe NameKind -> QName -> Hiliter
    hiliteQName (NameKind -> Maybe NameKind
    forall a. a -> Maybe a
    Just NameKind
    k) QName
    x

    instance Hilite ResolvedName where
      hilite :: ResolvedName -> Hiliter
    hilite = \case
        VarName           Name
    x BindingSource
    _bindSrc -> Name -> Hiliter
    hiliteBound Name
    x
        DefinedName  Access
    _acc AbstractName
    x Suffix
    _suffix  -> QName -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite (QName -> Hiliter) -> QName -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> QName
    anameName AbstractName
    x
        FieldName         List1 AbstractName
    xs         -> AmbiguousQName -> Hiliter
    hiliteProjection (AmbiguousQName -> Hiliter) -> AmbiguousQName -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ List1 QName -> AmbiguousQName
    A.AmbQ (List1 QName -> AmbiguousQName) -> List1 QName -> AmbiguousQName
    forall a b. (a -> b) -> a -> b
    $ (AbstractName -> QName) -> List1 AbstractName -> List1 QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    xs
        ConstructorName Set Induction
    i List1 AbstractName
    xs         -> Maybe NameKind -> AmbiguousQName -> Hiliter
    hiliteAmbiguousQName Maybe NameKind
    k (AmbiguousQName -> Hiliter) -> AmbiguousQName -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ List1 QName -> AmbiguousQName
    A.AmbQ (List1 QName -> AmbiguousQName) -> List1 QName -> AmbiguousQName
    forall a b. (a -> b) -> a -> b
    $ (AbstractName -> QName) -> List1 AbstractName -> List1 QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName 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
    <$> Set Induction -> Maybe KindOfName
    forall (t :: * -> *). Foldable t => t Induction -> Maybe KindOfName
    exactConName Set Induction
    i
        PatternSynResName List1 AbstractName
    xs         -> AmbiguousQName -> Hiliter
    hilitePatternSynonym (AmbiguousQName -> Hiliter) -> AmbiguousQName -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ List1 QName -> AmbiguousQName
    A.AmbQ (List1 QName -> AmbiguousQName) -> List1 QName -> AmbiguousQName
    forall a b. (a -> b) -> a -> b
    $ (AbstractName -> QName) -> List1 AbstractName -> List1 QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    xs
        ResolvedName
    UnknownName                  -> Hiliter
    forall a. Monoid a => a
    mempty

    instance Hilite A.QName where
      hilite :: QName -> Hiliter
    hilite = Maybe NameKind -> QName -> Hiliter
    hiliteQName Maybe NameKind
    forall a. Maybe a
    Nothing

    instance Hilite A.AmbiguousQName where
      hilite :: AmbiguousQName -> Hiliter
    hilite = Maybe NameKind -> AmbiguousQName -> Hiliter
    hiliteAmbiguousQName Maybe NameKind
    forall a. Maybe a
    Nothing

    instance Hilite A.ModuleName where
      hilite :: ModuleName -> Hiliter
    hilite m :: ModuleName
    m@(A.MName [Name]
    xs) = do
        SourceToModule
    modMap <- (HiliteEnv -> SourceToModule)
    -> ReaderT HiliteEnv Identity SourceToModule
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks HiliteEnv -> SourceToModule
    hleModMap
        (Bool, ModuleName) -> Hiliter
    hiliteModule (SourceToModule -> Bool
    isTopLevelModule SourceToModule
    modMap, ModuleName
    m)
        where
        isTopLevelModule :: SourceToModule -> Bool
    isTopLevelModule SourceToModule
    modMap =
          case (Name -> Maybe AbsolutePath) -> [Name] -> [AbsolutePath]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe
              ((Maybe AbsolutePath -> Maybe AbsolutePath
    forall a. Maybe a -> Maybe a
    Strict.toLazy (Maybe AbsolutePath -> Maybe AbsolutePath)
    -> (Position' (Maybe AbsolutePath) -> Maybe AbsolutePath)
    -> Position' (Maybe AbsolutePath)
    -> Maybe AbsolutePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Position' (Maybe AbsolutePath) -> Maybe AbsolutePath
    forall a. Position' a -> a
    P.srcFile) (Position' (Maybe AbsolutePath) -> Maybe AbsolutePath)
    -> (Name -> Maybe (Position' (Maybe AbsolutePath)))
    -> Name
    -> Maybe AbsolutePath
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< (Range -> Maybe (Position' (Maybe AbsolutePath))
    forall a. Range' a -> Maybe (Position' a)
    P.rStart (Range -> Maybe (Position' (Maybe AbsolutePath)))
    -> (Name -> Range)
    -> Name
    -> Maybe (Position' (Maybe AbsolutePath))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Range
    A.nameBindingSite)) [Name]
    xs of
            AbsolutePath
    f : [AbsolutePath]
    _ ->
              AbsolutePath -> SourceToModule -> Maybe TopLevelModuleName
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup AbsolutePath
    f SourceToModule
    modMap
                Maybe TopLevelModuleName -> Maybe TopLevelModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == TopLevelModuleName -> Maybe TopLevelModuleName
    forall a. a -> Maybe a
    Just (QName -> TopLevelModuleName
    C.toTopLevelModuleName (QName -> TopLevelModuleName) -> QName -> TopLevelModuleName
    forall a b. (a -> b) -> a -> b
    $ ModuleName -> QName
    A.mnameToConcrete ModuleName
    m)
            [] -> Bool
    False

      -- 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 -> Hiliter
    hilite (RenamingTo QName
    q) = do
        Maybe NameKind
    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 (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
    <&> (NameKinds -> NameKinds
    forall a b. (a -> b) -> a -> b
    $ QName
    q)
        QName -> Bool -> (Bool -> Aspects) -> Hiliter
    hiliteAName QName
    q Bool
    False ((Bool -> Aspects) -> Hiliter) -> (Bool -> Aspects) -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ Maybe NameKind -> Bool -> Aspects
    nameAsp' Maybe NameKind
    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 -> Hiliter
    hilite (RenamingTo (A.MName [Name]
    ns)) = ((Name -> Hiliter) -> [Name] -> Hiliter)
    -> [Name] -> (Name -> Hiliter) -> Hiliter
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Name -> Hiliter) -> [Name] -> Hiliter
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap [Name]
    ns ((Name -> Hiliter) -> Hiliter) -> (Name -> Hiliter) -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ \ Name
    n ->
        [Name]
    -> Name -> Range -> Maybe Range -> (Bool -> Aspects) -> Hiliter
    hiliteCName [] (Name -> Name
    A.nameConcrete Name
    n) Range
    forall a. Range' a
    noRange Maybe Range
    forall a. Maybe a
    Nothing ((Bool -> Aspects) -> Hiliter) -> (Bool -> Aspects) -> Hiliter
    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) -> Hiliter
    hilite (RenamingTo ImportedName' m n
    x) = case ImportedName' m n
    x of
        ImportedModule n
    m -> RenamingTo n -> Hiliter
    forall a. Hilite a => a -> Hiliter
    hilite (n -> RenamingTo n
    forall a. a -> RenamingTo a
    RenamingTo n
    m)
        ImportedName   m
    n -> RenamingTo m -> Hiliter
    forall a. Hilite a => a -> Hiliter
    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 -> Hiliter
    hiliteQName Maybe NameKind
    mkind QName
    q
      | QName -> Bool
    isExtendedLambdaName QName
    q = Hiliter
    forall a. Monoid a => a
    mempty
      | QName -> Bool
    isAbsurdLambdaName   QName
    q = Hiliter
    forall a. Monoid a => a
    mempty
      | Bool
    otherwise = do
          Maybe NameKind
    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 (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 (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
    <&> (NameKinds -> NameKinds
    forall a b. (a -> b) -> a -> b
    $ QName
    q)
          QName -> Bool -> (Bool -> Aspects) -> Hiliter
    hiliteAName QName
    q Bool
    True ((Bool -> Aspects) -> Hiliter) -> (Bool -> Aspects) -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ Maybe NameKind -> Bool -> Aspects
    nameAsp' Maybe NameKind
    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 -> Hiliter
    hiliteAmbiguousQName Maybe NameKind
    mkind (A.AmbQ List1 QName
    qs) = do
      Maybe NameKind
    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 (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
        NameKinds
    kinds <- (HiliteEnv -> NameKinds) -> ReaderT HiliteEnv Identity NameKinds
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks HiliteEnv -> NameKinds
    hleNameKinds
        Maybe NameKind -> ReaderT HiliteEnv Identity (Maybe NameKind)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe NameKind -> ReaderT HiliteEnv Identity (Maybe NameKind))
    -> Maybe NameKind -> ReaderT HiliteEnv Identity (Maybe NameKind)
    forall a b. (a -> b) -> a -> b
    $ [NameKind] -> Maybe NameKind
    forall a. [a] -> Maybe a
    listToMaybe ([NameKind] -> Maybe NameKind) -> [NameKind] -> Maybe NameKind
    forall a b. (a -> b) -> a -> b
    $ List1 (Maybe NameKind) -> [NameKind]
    forall a. List1 (Maybe a) -> [a]
    List1.catMaybes (List1 (Maybe NameKind) -> [NameKind])
    -> List1 (Maybe NameKind) -> [NameKind]
    forall a b. (a -> b) -> a -> b
    $ NameKinds -> List1 QName -> List1 (Maybe NameKind)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap NameKinds
    kinds List1 QName
    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.
      ((QName -> Hiliter) -> List1 QName -> Hiliter)
    -> List1 QName -> (QName -> Hiliter) -> Hiliter
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (QName -> Hiliter) -> List1 QName -> Hiliter
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap List1 QName
    qs ((QName -> Hiliter) -> Hiliter) -> (QName -> Hiliter) -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ \ QName
    q ->
        QName -> Bool -> (Bool -> Aspects) -> Hiliter
    hiliteAName QName
    q Bool
    include ((Bool -> Aspects) -> Hiliter) -> (Bool -> Aspects) -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ Maybe NameKind -> Bool -> Aspects
    nameAsp' Maybe NameKind
    kind
      where
      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) -> List1 QName -> List1 Range
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap QName -> Range
    bindingSite List1 QName
    qs

    hiliteBound :: A.Name -> Hiliter
    hiliteBound :: Name -> Hiliter
    hiliteBound Name
    x =
      [Name]
    -> Name -> Range -> Maybe Range -> (Bool -> Aspects) -> Hiliter
    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
    A.nameBindingSite Name
    x) ((Bool -> Aspects) -> Hiliter) -> (Bool -> Aspects) -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ NameKind -> Bool -> Aspects
    nameAsp NameKind
    Bound

    hiliteInductiveConstructor :: A.AmbiguousQName -> Hiliter
    hiliteInductiveConstructor :: AmbiguousQName -> Hiliter
    hiliteInductiveConstructor = Maybe NameKind -> AmbiguousQName -> Hiliter
    hiliteAmbiguousQName (Maybe NameKind -> AmbiguousQName -> Hiliter)
    -> Maybe NameKind -> AmbiguousQName -> Hiliter
    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 -> Hiliter
    hilitePatternSynonym = AmbiguousQName -> Hiliter
    hiliteInductiveConstructor  -- There are no coinductive pattern synonyms!?

    hiliteProjection :: A.AmbiguousQName -> Hiliter
    hiliteProjection :: AmbiguousQName -> Hiliter
    hiliteProjection = Maybe NameKind -> AmbiguousQName -> Hiliter
    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 -> Hiliter
    hiliteField [Name]
    xs Name
    x Maybe Range
    bindingR = [Name]
    -> Name -> Range -> Maybe Range -> (Bool -> Aspects) -> Hiliter
    hiliteCName [Name]
    xs Name
    x Range
    forall a. Range' a
    noRange Maybe Range
    bindingR ((Bool -> Aspects) -> Hiliter) -> (Bool -> Aspects) -> Hiliter
    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) -> Hiliter
    hiliteModule (Bool
    isTopLevelModule, A.MName []) = Hiliter
    forall a. Monoid a => a
    mempty
    hiliteModule (Bool
    isTopLevelModule, A.MName (Name
    n:[Name]
    ns)) =
      [Name]
    -> Name -> Range -> Maybe Range -> (Bool -> Aspects) -> Hiliter
    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 a. Bool -> (a -> a) -> a -> a
    applyWhen Bool
    isTopLevelModule Range -> Range
    P.beginningOfFile (Range -> Range) -> Range -> Range
    forall a b. (a -> b) -> a -> b
    $
           Name -> 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) -> Hiliter
    hiliteCName [Name]
    xs Name
    x Range
    fr Maybe Range
    mR Bool -> Aspects
    asp = do
      HiliteEnv NameKinds
    _ SourceToModule
    modMap AbsolutePath
    fileName <- ReaderT HiliteEnv Identity HiliteEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      -- We don't care if we get any funny ranges.
      if (Maybe AbsolutePath -> Bool) -> [Maybe AbsolutePath] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Maybe AbsolutePath -> Maybe AbsolutePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == AbsolutePath -> Maybe AbsolutePath
    forall a. a -> Maybe a
    Strict.Just AbsolutePath
    fileName) [Maybe AbsolutePath]
    fileNames then HighlightingInfoBuilder -> Hiliter
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (HighlightingInfoBuilder -> Hiliter)
    -> HighlightingInfoBuilder -> Hiliter
    forall a b. (a -> b) -> a -> b
    $
        SourceToModule -> HighlightingInfoBuilder
    frFile SourceToModule
    modMap HighlightingInfoBuilder
    -> HighlightingInfoBuilder -> HighlightingInfoBuilder
    forall a. Semigroup a => a -> a -> a
    <>
        Ranges -> Aspects -> HighlightingInfoBuilder
    forall a m. IsBasicRangeMap a m => Ranges -> a -> m
    H.singleton (Range -> Ranges
    rToR Range
    rs)
                    (Aspects
    aspects { definitionSite :: Maybe DefinitionSite
    definitionSite = SourceToModule -> Maybe DefinitionSite
    mFilePos SourceToModule
    modMap })
       else
        Hiliter
    forall a. Monoid a => a
    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
      fileNames :: [Maybe AbsolutePath]
    fileNames     = (Name -> Maybe (Maybe AbsolutePath))
    -> [Name] -> [Maybe AbsolutePath]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ((Position' (Maybe AbsolutePath) -> Maybe AbsolutePath)
    -> Maybe (Position' (Maybe AbsolutePath))
    -> Maybe (Maybe AbsolutePath)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Position' (Maybe AbsolutePath) -> Maybe AbsolutePath
    forall a. Position' a -> a
    P.srcFile (Maybe (Position' (Maybe AbsolutePath))
     -> Maybe (Maybe AbsolutePath))
    -> (Name -> Maybe (Position' (Maybe AbsolutePath)))
    -> Name
    -> Maybe (Maybe AbsolutePath)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> Maybe (Position' (Maybe AbsolutePath))
    forall a. Range' a -> Maybe (Position' a)
    P.rStart (Range -> Maybe (Position' (Maybe AbsolutePath)))
    -> (Name -> Range)
    -> Name
    -> Maybe (Position' (Maybe AbsolutePath))
    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 :: SourceToModule -> HighlightingInfoBuilder
    frFile SourceToModule
    modMap = Ranges -> Aspects -> HighlightingInfoBuilder
    forall a m. IsBasicRangeMap a m => Ranges -> a -> m
    H.singleton (Range -> Ranges
    rToR Range
    fr) (Aspects
    aspects { definitionSite :: Maybe DefinitionSite
    definitionSite = DefinitionSite -> DefinitionSite
    notHere (DefinitionSite -> DefinitionSite)
    -> Maybe DefinitionSite -> Maybe DefinitionSite
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SourceToModule -> Maybe DefinitionSite
    mFilePos SourceToModule
    modMap })
      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 :: Bool
    defSiteHere = Bool
    False }

      mFilePos
        :: SourceToModule  -- Maps source file paths to module names.
        -> Maybe DefinitionSite
      mFilePos :: SourceToModule -> Maybe DefinitionSite
    mFilePos SourceToModule
    modMap = do
        Range
    r <- Maybe Range
    mR
        P.Pn { srcFile :: forall a. Position' a -> a
    P.srcFile = Strict.Just AbsolutePath
    f, posPos :: forall a. Position' a -> Int32
    P.posPos = Int32
    p } <- Range -> Maybe (Position' (Maybe AbsolutePath))
    forall a. Range' a -> Maybe (Position' a)
    P.rStart Range
    r
        TopLevelModuleName
    mod <- AbsolutePath -> SourceToModule -> Maybe TopLevelModuleName
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup AbsolutePath
    f SourceToModule
    modMap
        -- 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 :: [Name]
    qualifiers = Int -> [Name] -> [Name]
    forall a. Int -> [a] -> [a]
    drop (NonEmpty String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (NonEmpty String -> Int) -> NonEmpty String -> Int
    forall a b. (a -> b) -> a -> b
    $ TopLevelModuleName -> NonEmpty String
    C.moduleNameParts TopLevelModuleName
    mod) [Name]
    xs
        -- For bound variables, we do not create symbolic anchors.
            local :: Bool
    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
        DefinitionSite -> Maybe DefinitionSite
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DefinitionSite -> Maybe DefinitionSite)
    -> DefinitionSite -> Maybe DefinitionSite
    forall a b. (a -> b) -> a -> b
    $ DefinitionSite :: TopLevelModuleName -> Int -> Bool -> Maybe String -> DefinitionSite
    DefinitionSite
          { defSiteModule :: TopLevelModuleName
    defSiteModule = TopLevelModuleName
    mod
          , defSitePos :: Int
    defSitePos    = Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    p
            -- Is our current position the definition site?
          , defSiteHere :: Bool
    defSiteHere   = Range
    r Range -> Range -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Range
    forall a. HasRange a => a -> Range
    getRange Name
    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 :: Maybe String
    defSiteAnchor = if Bool
    local Bool -> Bool -> Bool
    || Name -> Bool
    forall a. IsNoName a => a -> Bool
    C.isNoName Name
    x Bool -> Bool -> Bool
    || (Name -> Bool) -> [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Name -> Bool
    forall a. Underscore a => a -> Bool
    Common.isUnderscore [Name]
    qualifiers
              then Maybe String
    forall a. Maybe a
    Nothing
              else String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ QName -> String
    forall a. Pretty a => a -> String
    prettyShow (QName -> String) -> QName -> String
    forall a b. (a -> b) -> a -> b
    $ (Name -> QName -> QName) -> QName -> [Name] -> QName
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Name -> QName -> QName
    C.Qual (Name -> QName
    C.QName Name
    x) [Name]
    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) -> Hiliter
    hiliteAName QName
    x Bool
    include Bool -> Aspects
    asp = do
      AbsolutePath
    fileName <- (HiliteEnv -> AbsolutePath)
    -> ReaderT HiliteEnv Identity AbsolutePath
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks HiliteEnv -> AbsolutePath
    hleFileName
      [Name]
    -> Name -> Range -> Maybe Range -> (Bool -> Aspects) -> Hiliter
    hiliteCName (QName -> [Name]
    concreteQualifier QName
    x)
                  (QName -> Name
    concreteBase QName
    x)
                  (AbsolutePath -> Range
    rangeOfFixityDeclaration AbsolutePath
    fileName)
                  (if Bool
    include then Range -> Maybe Range
    forall a. a -> Maybe a
    Just (Range -> Maybe Range) -> Range -> Maybe Range
    forall a b. (a -> b) -> a -> b
    $ QName -> Range
    bindingSite QName
    x else Maybe Range
    forall a. Maybe a
    Nothing)
                  Bool -> Aspects
    asp
        Hiliter -> Hiliter -> Hiliter
    forall a. Semigroup a => a -> a -> a
    <> (AbsolutePath -> Hiliter
    notationFile AbsolutePath
    fileName)
      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 :: AbsolutePath -> Range
    rangeOfFixityDeclaration AbsolutePath
    fileName =
        if Range -> Maybe AbsolutePath
    P.rangeFile Range
    r Maybe AbsolutePath -> Maybe AbsolutePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == AbsolutePath -> Maybe AbsolutePath
    forall a. a -> Maybe a
    Strict.Just AbsolutePath
    fileName
        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 :: AbsolutePath -> Hiliter
    notationFile AbsolutePath
    fileName = HighlightingInfoBuilder -> Hiliter
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (HighlightingInfoBuilder -> Hiliter)
    -> HighlightingInfoBuilder -> Hiliter
    forall a b. (a -> b) -> a -> b
    $
        if Range -> Maybe AbsolutePath
    P.rangeFile (Notation -> Range
    forall a. HasRange a => a -> Range
    getRange Notation
    notation) Maybe AbsolutePath -> Maybe AbsolutePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == AbsolutePath -> Maybe AbsolutePath
    forall a. a -> Maybe a
    Strict.Just AbsolutePath
    fileName
        then [HighlightingInfoBuilder] -> HighlightingInfoBuilder
    forall a. Monoid a => [a] -> a
    mconcat ([HighlightingInfoBuilder] -> HighlightingInfoBuilder)
    -> [HighlightingInfoBuilder] -> HighlightingInfoBuilder
    forall a b. (a -> b) -> a -> b
    $ (GenPart -> HighlightingInfoBuilder)
    -> Notation -> [HighlightingInfoBuilder]
    forall a b. (a -> b) -> [a] -> [b]
    map GenPart -> HighlightingInfoBuilder
    genPartFile Notation
    notation
        else HighlightingInfoBuilder
    forall a. Monoid a => a
    mempty
        where
        notation :: Notation
    notation = Fixity' -> Notation
    theNotation (Fixity' -> Notation) -> Fixity' -> Notation
    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 :: GenPart -> HighlightingInfoBuilder
    genPartFile (BindHole Range
    r Ranged Int
    i)   = [Ranges] -> Aspects -> HighlightingInfoBuilder
    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 Int -> Range
    forall a. HasRange a => a -> Range
    getRange Ranged Int
    i] Aspects
    boundAspect
        genPartFile (NormalHole Range
    r NamedArg (Ranged Int)
    i) = [Ranges] -> Aspects -> HighlightingInfoBuilder
    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
    $ NamedArg (Ranged Int) -> Range
    forall a. HasRange a => a -> Range
    getRange NamedArg (Ranged Int)
    i] Aspects
    boundAspect
        genPartFile WildHole{}       = HighlightingInfoBuilder
    forall a. Monoid a => a
    mempty
        genPartFile (IdPart RString
    x)       = Ranges -> Aspects -> HighlightingInfoBuilder
    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
    $ RString -> Range
    forall a. HasRange a => a -> Range
    getRange RString
    x) (Bool -> Aspects
    asp Bool
    False)

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

    singleAspect :: HasRange a => Aspect -> a -> Hiliter
    singleAspect :: forall a. HasRange a => Aspect -> a -> Hiliter
    singleAspect Aspect
    a a
    x = HighlightingInfoBuilder -> Hiliter
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (HighlightingInfoBuilder -> Hiliter)
    -> HighlightingInfoBuilder -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ Ranges -> Aspects -> HighlightingInfoBuilder
    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 -> HighlightingInfoBuilder)
    -> Aspects -> HighlightingInfoBuilder
    forall a b. (a -> b) -> a -> b
    $ Aspects
    parserBased { aspect :: Maybe Aspect
    aspect = Aspect -> Maybe Aspect
    forall a. a -> Maybe a
    Just Aspect
    a }

    singleOtherAspect :: HasRange a => OtherAspect -> a -> Hiliter
    singleOtherAspect :: forall a. HasRange a => OtherAspect -> a -> Hiliter
    singleOtherAspect OtherAspect
    a a
    x = HighlightingInfoBuilder -> Hiliter
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (HighlightingInfoBuilder -> Hiliter)
    -> HighlightingInfoBuilder -> Hiliter
    forall a b. (a -> b) -> a -> b
    $ Ranges -> Aspects -> HighlightingInfoBuilder
    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 -> HighlightingInfoBuilder)
    -> Aspects -> HighlightingInfoBuilder
    forall a b. (a -> b) -> a -> b
    $ Aspects
    parserBased { otherAspects :: Set OtherAspect
    otherAspects = OtherAspect -> Set OtherAspect
    forall el coll. Singleton el coll => el -> coll
    singleton OtherAspect
    a }

    nameAsp' :: Maybe NameKind -> Bool -> Aspects
    nameAsp' :: Maybe NameKind -> Bool -> Aspects
    nameAsp' Maybe NameKind
    k Bool
    isOp = Aspects
    parserBased { aspect :: Maybe Aspect
    aspect = Aspect -> Maybe Aspect
    forall a. a -> Maybe a
    Just (Aspect -> Maybe Aspect) -> Aspect -> Maybe Aspect
    forall a b. (a -> b) -> a -> b
    $ Maybe NameKind -> Bool -> Aspect
    Name Maybe NameKind
    k Bool
    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

    bindingSite :: A.QName -> Range
    bindingSite :: QName -> Range
    bindingSite = Name -> Range
    A.nameBindingSite (Name -> Range) -> (QName -> Name) -> QName -> Range
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Name
    A.qnameName