module Text.Docvim.Visitor.Symbol (getSymbols) where
import Data.List
import Text.Docvim.AST
import Text.Docvim.Visitor.Plugin
import qualified Data.Set as Set
getSymbols :: Node -> [String]
getSymbols node = if length symbols == Set.size set
then symbols
else error $ "Duplicate symbol table entries: " ++ show duplicates
where
set = Set.fromList symbols
symbols = walk gatherSymbols [] node
gatherSymbols (CommandAnnotation n _) = [":" ++ n]
gatherSymbols CommandsAnnotation = genHeading "commands"
gatherSymbols FunctionsAnnotation = genHeading "functions"
gatherSymbols (HeadingAnnotation h) = genHeading h
gatherSymbols (LinkTargets ts) = ts
gatherSymbols (PluginAnnotation name _) = [name, name ++ ".txt"]
gatherSymbols (MappingAnnotation m) = [m]
gatherSymbols MappingsAnnotation = genHeading "mappings"
gatherSymbols OptionsAnnotation = genHeading "options"
gatherSymbols _ = []
genHeading h = maybe [] (\x -> [sanitizeAnchor $ x ++ "-" ++ h]) (getPluginName node)
duplicates = nub $ f (sort symbols)
where
f [] = []
f [_] = []
f (x:xs) = if x == head xs
then x : f xs
else f xs