module GenTags
  ( modToTags
  ) where

import Language.Haskell.Syntax
import Tag
import ExCommand
import Data.Monoid
import Control.Applicative

--
-- HsModule Helpers
--

decls :: HsModule -> [HsDecl]
decls (HsModule _ _ _ _ a) = a

--
-- (HsModule -> Tag) Helpers
--

l :: SrcLoc -> HsName -> Tag
l loc = \n -> tag (nToStr n) (srcFilename loc) (ziffy loc)
  where
    ziffy :: SrcLoc -> ExCommand
    ziffy = exGotoLine . srcLine
    nToStr :: HsName -> String
    nToStr (HsIdent s) = s
    nToStr (HsSymbol s) = s

z :: SrcLoc -> [HsName] -> [Tag]
z = fmap . l

f :: SrcLoc -> HsName -> [Tag]
f = (fmap.fmap) pure l

--
-- (HsModule -> Tag)
--

modToTags :: HsModule -> [Tag]
modToTags = declsToTags . decls

declsToTags ::  [HsDecl] -> [Tag]
declsToTags = concatMap declToTags

declToTags :: HsDecl -> [Tag]
declToTags (HsTypeDecl    loc name _ _)            = f loc name
declToTags (HsDataDecl    loc _ name _ condecls _) = f loc name `mappend` concatMap cdToTags condecls
declToTags (HsNewTypeDecl loc _ name _ condecl _)  = f loc name `mappend` cdToTags condecl
declToTags (HsClassDecl   loc _ name _ decls)      = f loc name `mappend` declsToTags decls
declToTags (HsTypeSig     loc names _)             = z loc names
declToTags _                                       = mempty

cdToTags :: HsConDecl -> [Tag]
cdToTags (HsConDecl loc name _)    = f loc name
cdToTags (HsRecDecl loc name recs) = f loc name `mappend` z loc (concatMap fst recs)