-- |
-- Module      :  Haddock.Parser
-- Copyright   :  (c) Mateusz Kowalczyk 2013,
--                    Simon Hengel      2013
-- License     :  BSD-like
--
-- Maintainer  :  haddock@projects.haskell.org
-- Stability   :  experimental
-- Portability :  portable
module Haddock.Parser
  ( parseParas
  , parseString
  , parseIdent
  ) where

import GHC.Data.FastString (fsLit)
import GHC.Data.StringBuffer (stringToStringBuffer)
import GHC.Parser (parseIdentifier)
import GHC.Parser.Lexer (ParseResult (PFailed, POk), ParserOpts, initParserState, unP)
import GHC.Types.Name.Occurrence (occNameString)
import GHC.Types.Name.Reader (RdrName (..))
import GHC.Types.SrcLoc (GenLocated (..), mkRealSrcLoc)

import qualified Documentation.Haddock.Parser as P
import Documentation.Haddock.Types
import Haddock.Types

parseParas :: ParserOpts -> Maybe Package -> String -> MetaDoc mod (Wrap NsRdrName)
parseParas :: forall mod.
ParserOpts
-> Maybe Package -> Package -> MetaDoc mod (Wrap NsRdrName)
parseParas ParserOpts
parserOpts Maybe Package
p = (DocH mod Identifier -> DocH mod (Wrap NsRdrName))
-> MetaDoc mod Identifier -> MetaDoc mod (Wrap NsRdrName)
forall a b c d.
(DocH a b -> DocH c d) -> MetaDoc a b -> MetaDoc c d
overDoc ((Namespace -> Package -> Maybe (Wrap NsRdrName))
-> DocH mod Identifier -> DocH mod (Wrap NsRdrName)
forall a mod.
(Namespace -> Package -> Maybe a)
-> DocH mod Identifier -> DocH mod a
P.overIdentifier (ParserOpts -> Namespace -> Package -> Maybe (Wrap NsRdrName)
parseIdent ParserOpts
parserOpts)) (MetaDoc mod Identifier -> MetaDoc mod (Wrap NsRdrName))
-> (Package -> MetaDoc mod Identifier)
-> Package
-> MetaDoc mod (Wrap NsRdrName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Package -> Package -> MetaDoc mod Identifier
forall mod. Maybe Package -> Package -> MetaDoc mod Identifier
P.parseParas Maybe Package
p

parseString :: ParserOpts -> String -> DocH mod (Wrap NsRdrName)
parseString :: forall mod. ParserOpts -> Package -> DocH mod (Wrap NsRdrName)
parseString ParserOpts
parserOpts = (Namespace -> Package -> Maybe (Wrap NsRdrName))
-> DocH mod Identifier -> DocH mod (Wrap NsRdrName)
forall a mod.
(Namespace -> Package -> Maybe a)
-> DocH mod Identifier -> DocH mod a
P.overIdentifier (ParserOpts -> Namespace -> Package -> Maybe (Wrap NsRdrName)
parseIdent ParserOpts
parserOpts) (DocH mod Identifier -> DocH mod (Wrap NsRdrName))
-> (Package -> DocH mod Identifier)
-> Package
-> DocH mod (Wrap NsRdrName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> DocH mod Identifier
forall mod. Package -> DocH mod Identifier
P.parseString

parseIdent :: ParserOpts -> Namespace -> String -> Maybe (Wrap NsRdrName)
parseIdent :: ParserOpts -> Namespace -> Package -> Maybe (Wrap NsRdrName)
parseIdent ParserOpts
parserOpts Namespace
ns Package
str0 =
  case P (LocatedN RdrName) -> PState -> ParseResult (LocatedN RdrName)
forall a. P a -> PState -> ParseResult a
unP P (LocatedN RdrName)
parseIdentifier (Package -> PState
pstate Package
str1) of
    POk PState
_ (L SrcSpanAnnN
_ RdrName
name)
      -- Guards against things like 'Q.--', 'Q.case', etc.
      -- See https://github.com/haskell/haddock/issues/952 and Trac #14109
      | Qual ModuleName
_ OccName
occ <- RdrName
name
      , PFailed{} <- P (LocatedN RdrName) -> PState -> ParseResult (LocatedN RdrName)
forall a. P a -> PState -> ParseResult a
unP P (LocatedN RdrName)
parseIdentifier (Package -> PState
pstate (OccName -> Package
occNameString OccName
occ)) ->
          Maybe (Wrap NsRdrName)
forall a. Maybe a
Nothing
      | Bool
otherwise ->
          Wrap NsRdrName -> Maybe (Wrap NsRdrName)
forall a. a -> Maybe a
Just (NsRdrName -> Wrap NsRdrName
forall {n}. n -> Wrap n
wrap (Namespace -> RdrName -> NsRdrName
NsRdrName Namespace
ns RdrName
name))
    PFailed{} -> Maybe (Wrap NsRdrName)
forall a. Maybe a
Nothing
  where
    realSrcLc :: RealSrcLoc
realSrcLc = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (Package -> FastString
fsLit Package
"<unknown file>") Int
0 Int
0
    pstate :: Package -> PState
pstate Package
str = ParserOpts -> StringBuffer -> RealSrcLoc -> PState
initParserState ParserOpts
parserOpts (Package -> StringBuffer
stringToStringBuffer Package
str) RealSrcLoc
realSrcLc
    (n -> Wrap n
wrap, Package
str1) = case Package
str0 of
      Char
'(' : s :: Package
s@(Char
c : Package
_)
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
','
        , Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')' -> -- rule out tuple names
            (n -> Wrap n
forall {n}. n -> Wrap n
Parenthesized, Package -> Package
forall a. HasCallStack => [a] -> [a]
init Package
s)
      Char
'`' : s :: Package
s@(Char
_ : Package
_) -> (n -> Wrap n
forall {n}. n -> Wrap n
Backticked, Package -> Package
forall a. HasCallStack => [a] -> [a]
init Package
s)
      Package
_ -> (n -> Wrap n
forall {n}. n -> Wrap n
Unadorned, Package
str0)