    {-# OPTIONS_GHC -Wunused-imports #-}

    -- | Common syntax highlighting functions for Emacs and JSON

    module Agda.Interaction.Highlighting.Common
      ( toAtoms
      , chooseHighlightingMethod
      ) where

    import Agda.Interaction.Highlighting.Precise
    import Agda.Syntax.Common
    import Agda.TypeChecking.Monad (HighlightingMethod(..))
    import Data.Maybe (maybeToList)
    import Data.Char (toLower)
    import qualified Data.Set as Set

    -- | Converts the 'aspect' and 'otherAspects' fields to strings that are
    -- friendly to editors.
    toAtoms :: Aspects -> [String]
    toAtoms :: Aspects -> [String]
    toAtoms Aspects
    m = (OtherAspect -> String) -> [OtherAspect] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map OtherAspect -> String
    forall a. Show a => a -> String
    toAtom (Set OtherAspect -> [OtherAspect]
    forall a. Set a -> [a]
    Set.toList (Set OtherAspect -> [OtherAspect])
    -> Set OtherAspect -> [OtherAspect]
    forall a b. (a -> b) -> a -> b
    $ Aspects -> Set OtherAspect
    otherAspects Aspects
    m)
             [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ Maybe Aspect -> [String]
    toAtoms' (Aspects -> Maybe Aspect
    aspect Aspects
    m)
      where

      toAtom :: Show a => a -> String
      toAtom :: forall a. Show a => a -> String
    toAtom = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (String -> String) -> (a -> String) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show

      kindToAtom :: NameKind -> String
    kindToAtom (Constructor Induction
    Inductive)   = String
    "inductiveconstructor"
      kindToAtom (Constructor Induction
    CoInductive) = String
    "coinductiveconstructor"
      kindToAtom NameKind
    k                         = NameKind -> String
    forall a. Show a => a -> String
    toAtom NameKind
    k

      toAtoms' :: Maybe Aspect -> [String]
    toAtoms' Maybe Aspect
    Nothing               = []
      toAtoms' (Just (Name Maybe NameKind
    mKind Bool
    op)) =
        (NameKind -> String) -> [NameKind] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map NameKind -> String
    kindToAtom (Maybe NameKind -> [NameKind]
    forall a. Maybe a -> [a]
    maybeToList Maybe NameKind
    mKind) [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    opAtom
        where opAtom :: [String]
    opAtom | Bool
    op        = [String
    "operator"]
                     | Bool
    otherwise = []
      toAtoms' (Just Aspect
    a) = [Aspect -> String
    forall a. Show a => a -> String
    toAtom Aspect
    a]

    -- | Choose which method to use based on HighlightingInfo and HighlightingMethod
    chooseHighlightingMethod
      :: HighlightingInfo
      -> HighlightingMethod
      -> HighlightingMethod
    chooseHighlightingMethod :: HighlightingInfo -> HighlightingMethod -> HighlightingMethod
    chooseHighlightingMethod HighlightingInfo
    info HighlightingMethod
    method = case HighlightingInfo -> [(Range, Aspects)]
    forall a m. IsBasicRangeMap a m => m -> [(Range, a)]
    toList HighlightingInfo
    info of
      [(Range, Aspects)]
    _             | HighlightingMethod
    method HighlightingMethod -> HighlightingMethod -> Bool
    forall a. Eq a => a -> a -> Bool
    == HighlightingMethod
    Direct -> HighlightingMethod
    Direct
      ((Range
    _, Aspects
    mi) : [(Range, Aspects)]
    _) | Aspects -> Bool
    check Aspects
    mi         -> HighlightingMethod
    Direct
      [(Range, Aspects)]
    _                                -> HighlightingMethod
    Indirect

      where check :: Aspects -> Bool
    check Aspects
    mi = Aspects -> Set OtherAspect
    otherAspects Aspects
    mi Set OtherAspect -> Set OtherAspect -> Bool
    forall a. Eq a => a -> a -> Bool
    == OtherAspect -> Set OtherAspect
    forall a. a -> Set a
    Set.singleton OtherAspect
    TypeChecks
                    Bool -> Bool -> Bool
    || Aspects
    mi Aspects -> Aspects -> Bool
    forall a. Eq a => a -> a -> Bool
    == Aspects
    forall a. Monoid a => a
    mempty