-- |
-- 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 qualified Documentation.Haddock.Parser as P
import Documentation.Haddock.Types
import Haddock.Types

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


parseParas :: DynFlags -> Maybe Package -> String -> MetaDoc mod (Wrap NsRdrName)
parseParas :: forall mod.
DynFlags
-> Maybe Package -> Package -> MetaDoc mod (Wrap NsRdrName)
parseParas DynFlags
d 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 (DynFlags -> Namespace -> Package -> Maybe (Wrap NsRdrName)
parseIdent DynFlags
d)) (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 :: DynFlags -> String -> DocH mod (Wrap NsRdrName)
parseString :: forall mod. DynFlags -> Package -> DocH mod (Wrap NsRdrName)
parseString DynFlags
d = (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 (DynFlags -> Namespace -> Package -> Maybe (Wrap NsRdrName)
parseIdent DynFlags
d) (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 :: DynFlags -> Namespace -> String -> Maybe (Wrap NsRdrName)
parseIdent :: DynFlags -> Namespace -> Package -> Maybe (Wrap NsRdrName)
parseIdent DynFlags
dflags 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 (DynFlags -> ParserOpts
initParserOpts DynFlags
dflags) (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)