{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE NamedFieldPuns             #-}

module Plugin.GhcTags.Parser
  ( -- * Tag
    TagName (..)
  , TagFile (..)
  , Tag (..)
  , ghcTagToTag
    -- * Parsing
  , parseVimTagFile
    -- * TagsMap'
  , TagsMap
  , mkTagsMap
  ) where

import           Control.Applicative (many)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BSC
import           Data.Attoparsec.ByteString               (Parser)
import qualified Data.Attoparsec.ByteString       as A
import           Data.Attoparsec.ByteString.Char8      ( (<?>) )
import qualified Data.Attoparsec.ByteString.Char8 as AC
import           Data.Either (rights)
import           Data.List (sort)
import           Data.Functor (void)
import           Data.Map  (Map)
import qualified Data.Map as Map

-- GHC imports
import           Plugin.GhcTags.Generate
                              ( GhcTag (..)
                              , TagKind
                              , charToTagKind
                              )
import           FastString   ( FastString (..)
                              )
import           SrcLoc       ( SrcSpan (..)
                              , srcSpanFile
                              , srcSpanStartLine
                              )


--
-- Tag
--


-- | 'ByteString' which encodes a tag name.
--
newtype TagName = TagName { getTagName :: ByteString }
  deriving newtype (Eq, Ord, Show)


-- | 'ByteString' which encodes a tag file.
--
newtype TagFile = TagFile { getTagFile :: ByteString }
  deriving newtype (Eq, Ord, Show)


-- | Simple Tag record.  For the moment on tag name, tag file and line numbers
-- are supported.
--
-- TODO: expand to support column numbers and extra information.
--
data Tag = Tag
  { tagName :: !TagName
  , tagFile :: !TagFile
  , tagLine :: !Int
  , tagKind :: !(Maybe TagKind)
  }
  deriving (Ord, Eq, Show)


ghcTagToTag :: GhcTag -> Maybe Tag
ghcTagToTag GhcTag { gtSrcSpan, gtTag, gtKind } =
    case gtSrcSpan of
      UnhelpfulSpan {} -> Nothing
      RealSrcSpan realSrcSpan ->
        Just $ Tag { tagName = TagName (fs_bs gtTag)
                   , tagFile = TagFile (fs_bs (srcSpanFile realSrcSpan))
                   , tagLine = srcSpanStartLine realSrcSpan
                   , tagKind = Just gtKind
                   }


--
-- Parsing
--


-- | Parser for a single line of a vim-style tag file.
--
vimTagParser:: Parser Tag
vimTagParser = do
    -- use monadic form to provide compatibility with previous version where
    -- `;"` and tag kinds where not present.
    tagName <-
      TagName <$> AC.takeWhile (/= '\t') <* AC.skipWhile (== '\t')
              <?> "parsing tag name failed"
    tagFile <-
      TagFile <$> AC.takeWhile (/= '\t') <* AC.skipWhile (== '\t')
              <?> "parsing tag file name failed"
    tagLine <-    AC.decimal
              <?> "parsing line number failed"

    mc <- AC.peekChar
    tagKind <-
      case mc of
        Just ';' ->
                charToTagKind
            <$> (AC.anyChar *> AC.char '"' *> AC.char '\t' *> AC.anyChar)
            <?> "parsing tag kind failed"
        _  -> pure Nothing
    AC.endOfLine
    pure $ Tag {tagName, tagFile, tagLine, tagKind}


-- | A vim-style tag file parser.
--
vimTagFileParser :: Parser [Tag]
vimTagFileParser = rights <$> many tagLineParser


tagLineParser :: Parser (Either () Tag)
tagLineParser =
    AC.eitherP
      (vimTagHeaderLine <?> "failed parsing tag")
      (vimTagParser     <?> "failed parsing header")


vimTagHeaderLine :: Parser ()
vimTagHeaderLine = AC.choice
    [ AC.string (BSC.pack "!_TAG_FILE_FORMAT")     *> params
    , AC.string (BSC.pack "!_TAG_FILE_SORTED")     *> params
    , AC.string (BSC.pack "!_TAG_FILE_ENCODING")   *> params
    , AC.string (BSC.pack "!_TAG_PROGRAM_AUTHOR")  *> params
    , AC.string (BSC.pack "!_TAG_PROGRAM_NAME")    *> params
    , AC.string (BSC.pack "!_TAG_PROGRAM_URL")     *> params
    , AC.string (BSC.pack "!_TAG_PROGRAM_VERSION") *> params
    ]
  where

    params = void $ AC.char '\t' *> AC.skipWhile (/= '\n') *> AC.char '\n'

-- | Parse a vim-style tag file.
--
parseVimTagFile :: ByteString
                -> IO (Either String [Tag])
parseVimTagFile =
      fmap A.eitherResult
    . A.parseWith (pure mempty) vimTagFileParser


--
-- TagsMap
--


type TagsMap = Map TagFile [Tag]

-- | Map from TagName to list of tags.  This will be useful when updating tags.
-- We will just need to merge dictionaries.
--
mkTagsMap :: [Tag] -> TagsMap
mkTagsMap =
      fmap sort
    . Map.fromListWith (<>)
    . map (\t -> (tagFile t, [t]))