    {-# LANGUAGE DeriveFunctor #-}
    {-# OPTIONS_GHC -Wwarn #-}

    -----------------------------------------------------------------------------

    -----------------------------------------------------------------------------

    -- |
    -- Module      :  Haddock.Interface.ParseModuleHeader
    -- Copyright   :  (c) Simon Marlow 2006, Isaac Dupree 2009
    -- License     :  BSD-like
    --
    -- Maintainer  :  haddock@projects.haskell.org
    -- Stability   :  experimental
    -- Portability :  portable
    module Haddock.Interface.ParseModuleHeader (parseModuleHeader) where

    import Control.Applicative (Alternative (..))
    import Control.Monad (ap)
    import Data.Char
    import GHC.Parser.Lexer (ParserOpts)

    import Haddock.Parser
    import Haddock.Types

    -- -----------------------------------------------------------------------------
    -- Parsing module headers

    -- NB.  The headers must be given in the order Module, Description,
    -- Copyright, License, Maintainer, Stability, Portability, except that
    -- any or all may be omitted.
    parseModuleHeader :: ParserOpts -> Maybe Package -> String -> (HaddockModInfo NsRdrName, MDoc NsRdrName)
    parseModuleHeader :: ParserOpts
    -> Maybe [Char]
    -> [Char]
    -> (HaddockModInfo NsRdrName, MDoc NsRdrName)
    parseModuleHeader ParserOpts
    parserOpts Maybe [Char]
    pkgName [Char]
    str0 =
      let
        kvs :: [(String, String)]
        str1 :: String

        ([([Char], [Char])]
    kvs, [Char]
    str1) = ([([Char], [Char])], [Char])
    -> (([([Char], [Char])], [Char]) -> ([([Char], [Char])], [Char]))
    -> Maybe ([([Char], [Char])], [Char])
    -> ([([Char], [Char])], [Char])
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([], [Char]
    str0) ([([Char], [Char])], [Char]) -> ([([Char], [Char])], [Char])
    forall a. a -> a
    id (Maybe ([([Char], [Char])], [Char])
     -> ([([Char], [Char])], [Char]))
    -> Maybe ([([Char], [Char])], [Char])
    -> ([([Char], [Char])], [Char])
    forall a b. (a -> b) -> a -> b
    $ P ([([Char], [Char])], [Char])
    -> [Char] -> Maybe ([([Char], [Char])], [Char])
    forall a. P a -> [Char] -> Maybe a
    runP P ([([Char], [Char])], [Char])
    fields [Char]
    str0

        -- trim whitespaces
        trim :: String -> String
        trim :: [Char] -> [Char]
    trim = (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    forall a. [a] -> [a]
    reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    forall a. [a] -> [a]
    reverse

        getKey :: String -> Maybe String
        getKey :: [Char] -> Maybe [Char]
    getKey [Char]
    key = ([Char] -> [Char]) -> Maybe [Char] -> Maybe [Char]
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Char] -> [Char]
    trim ([Char] -> [([Char], [Char])] -> Maybe [Char]
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup [Char]
    key [([Char], [Char])]
    kvs)

        descriptionOpt :: Maybe [Char]
    descriptionOpt = [Char] -> Maybe [Char]
    getKey [Char]
    "Description"
        copyrightOpt :: Maybe [Char]
    copyrightOpt = [Char] -> Maybe [Char]
    getKey [Char]
    "Copyright"
        licenseOpt :: Maybe [Char]
    licenseOpt = [Char] -> Maybe [Char]
    getKey [Char]
    "License"
        licenceOpt :: Maybe [Char]
    licenceOpt = [Char] -> Maybe [Char]
    getKey [Char]
    "Licence"
        spdxLicenceOpt :: Maybe [Char]
    spdxLicenceOpt = [Char] -> Maybe [Char]
    getKey [Char]
    "SPDX-License-Identifier"
        maintainerOpt :: Maybe [Char]
    maintainerOpt = [Char] -> Maybe [Char]
    getKey [Char]
    "Maintainer"
        stabilityOpt :: Maybe [Char]
    stabilityOpt = [Char] -> Maybe [Char]
    getKey [Char]
    "Stability"
        portabilityOpt :: Maybe [Char]
    portabilityOpt = [Char] -> Maybe [Char]
    getKey [Char]
    "Portability"
       in
        ( HaddockModInfo
            { hmi_description :: Maybe (Doc NsRdrName)
    hmi_description = ParserOpts -> [Char] -> Doc NsRdrName
    forall mod. ParserOpts -> [Char] -> DocH mod (Wrap NsRdrName)
    parseString ParserOpts
    parserOpts ([Char] -> Doc NsRdrName) -> Maybe [Char] -> Maybe (Doc NsRdrName)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe [Char]
    descriptionOpt
            , hmi_copyright :: Maybe [Char]
    hmi_copyright = Maybe [Char]
    copyrightOpt
            , hmi_license :: Maybe [Char]
    hmi_license = Maybe [Char]
    spdxLicenceOpt Maybe [Char] -> Maybe [Char] -> Maybe [Char]
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
    <|> Maybe [Char]
    licenseOpt Maybe [Char] -> Maybe [Char] -> Maybe [Char]
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
    <|> Maybe [Char]
    licenceOpt
            , hmi_maintainer :: Maybe [Char]
    hmi_maintainer = Maybe [Char]
    maintainerOpt
            , hmi_stability :: Maybe [Char]
    hmi_stability = Maybe [Char]
    stabilityOpt
            , hmi_portability :: Maybe [Char]
    hmi_portability = Maybe [Char]
    portabilityOpt
            , hmi_safety :: Maybe [Char]
    hmi_safety = Maybe [Char]
    forall a. Maybe a
    Nothing
            , hmi_language :: Maybe Language
    hmi_language = Maybe Language
    forall a. Maybe a
    Nothing -- set in LexParseRn
            , hmi_extensions :: [Extension]
    hmi_extensions = [] -- also set in LexParseRn
            }
        , ParserOpts -> Maybe [Char] -> [Char] -> MDoc NsRdrName
    forall mod.
    ParserOpts
    -> Maybe [Char] -> [Char] -> MetaDoc mod (Wrap NsRdrName)
    parseParas ParserOpts
    parserOpts Maybe [Char]
    pkgName [Char]
    str1
        )

    -------------------------------------------------------------------------------
    -- Small parser to parse module header.
    -------------------------------------------------------------------------------

    -- | The below is a small parser framework how we read keys.
    --
    -- all fields in the header are optional and have the form
    --
    -- [spaces1][field name][spaces] ":"
    --    [text]"\n" ([spaces2][space][text]"\n" | [spaces]"\n")*
    -- where each [spaces2] should have [spaces1] as a prefix.
    --
    -- Thus for the key "Description",
    --
    -- > Description : this is a
    -- >    rather long
    -- >
    -- >    description
    -- >
    -- > The module comment starts here
    --
    -- the value will be "this is a .. description" and the rest will begin
    -- at "The module comment".

    -- | 'C' is a 'Char' carrying its column.
    --
    -- This let us make an indentation-aware parser, as we know current indentation.
    -- by looking at the next character in the stream ('curInd').
    --
    -- Thus we can munch all spaces but only not-spaces which are indented.
    data C = C {-# UNPACK #-} !Int Char

    newtype P a = P {forall a. P a -> [C] -> Maybe ([C], a)
    unP :: [C] -> Maybe ([C], a)}
      deriving ((forall a b. (a -> b) -> P a -> P b)
    -> (forall a b. a -> P b -> P a) -> Functor P
    forall a b. a -> P b -> P a
    forall a b. (a -> b) -> P a -> P b
    forall (f :: Type -> Type).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> P a -> P b
    fmap :: forall a b. (a -> b) -> P a -> P b
    $c<$ :: forall a b. a -> P b -> P a
    <$ :: forall a b. a -> P b -> P a
    Functor)

    instance Applicative P where
      pure :: forall a. a -> P a
    pure a
    x = ([C] -> Maybe ([C], a)) -> P a
    forall a. ([C] -> Maybe ([C], a)) -> P a
    P (([C] -> Maybe ([C], a)) -> P a) -> ([C] -> Maybe ([C], a)) -> P a
    forall a b. (a -> b) -> a -> b
    $ \[C]
    s -> ([C], a) -> Maybe ([C], a)
    forall a. a -> Maybe a
    Just ([C]
    s, a
    x)
      <*> :: forall a b. P (a -> b) -> P a -> P b
    (<*>) = P (a -> b) -> P a -> P b
    forall (m :: Type -> Type) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad P where
      return :: forall a. a -> P a
    return = a -> P a
    forall a. a -> P a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure
      P a
    m >>= :: forall a b. P a -> (a -> P b) -> P b
    >>= a -> P b
    k = ([C] -> Maybe ([C], b)) -> P b
    forall a. ([C] -> Maybe ([C], a)) -> P a
    P (([C] -> Maybe ([C], b)) -> P b) -> ([C] -> Maybe ([C], b)) -> P b
    forall a b. (a -> b) -> a -> b
    $ \[C]
    s0 -> do
        (s1, x) <- P a -> [C] -> Maybe ([C], a)
    forall a. P a -> [C] -> Maybe ([C], a)
    unP P a
    m [C]
    s0
        unP (k x) s1

    instance Alternative P where
      empty :: forall a. P a
    empty = ([C] -> Maybe ([C], a)) -> P a
    forall a. ([C] -> Maybe ([C], a)) -> P a
    P (([C] -> Maybe ([C], a)) -> P a) -> ([C] -> Maybe ([C], a)) -> P a
    forall a b. (a -> b) -> a -> b
    $ \[C]
    _ -> Maybe ([C], a)
    forall a. Maybe a
    Nothing
      P a
    a <|> :: forall a. P a -> P a -> P a
    <|> P a
    b = ([C] -> Maybe ([C], a)) -> P a
    forall a. ([C] -> Maybe ([C], a)) -> P a
    P (([C] -> Maybe ([C], a)) -> P a) -> ([C] -> Maybe ([C], a)) -> P a
    forall a b. (a -> b) -> a -> b
    $ \[C]
    s -> P a -> [C] -> Maybe ([C], a)
    forall a. P a -> [C] -> Maybe ([C], a)
    unP P a
    a [C]
    s Maybe ([C], a) -> Maybe ([C], a) -> Maybe ([C], a)
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
    <|> P a -> [C] -> Maybe ([C], a)
    forall a. P a -> [C] -> Maybe ([C], a)
    unP P a
    b [C]
    s

    runP :: P a -> String -> Maybe a
    runP :: forall a. P a -> [Char] -> Maybe a
    runP P a
    p [Char]
    input = (([C], a) -> a) -> Maybe ([C], a) -> Maybe a
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([C], a) -> a
    forall a b. (a, b) -> b
    snd (P a -> [C] -> Maybe ([C], a)
    forall a. P a -> [C] -> Maybe ([C], a)
    unP P a
    p [C]
    input')
      where
        input' :: [C]
    input' =
          [[C]] -> [C]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat
            [ (Int -> Char -> C) -> [Int] -> [Char] -> [C]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Char -> C
    C [Int
    0 ..] [Char]
    l [C] -> [C] -> [C]
    forall a. [a] -> [a] -> [a]
    ++ [Int -> Char -> C
    C ([Char] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Char]
    l) Char
    '\n']
            | [Char]
    l <- [Char] -> [[Char]]
    lines [Char]
    input
            ]

    -------------------------------------------------------------------------------
    --
    -------------------------------------------------------------------------------

    curInd :: P Int
    curInd :: P Int
    curInd = ([C] -> Maybe ([C], Int)) -> P Int
    forall a. ([C] -> Maybe ([C], a)) -> P a
    P (([C] -> Maybe ([C], Int)) -> P Int)
    -> ([C] -> Maybe ([C], Int)) -> P Int
    forall a b. (a -> b) -> a -> b
    $ \[C]
    s -> ([C], Int) -> Maybe ([C], Int)
    forall a. a -> Maybe a
    Just (([C], Int) -> Maybe ([C], Int))
    -> (Int -> ([C], Int)) -> Int -> Maybe ([C], Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (,) [C]
    s (Int -> Maybe ([C], Int)) -> Int -> Maybe ([C], Int)
    forall a b. (a -> b) -> a -> b
    $ case [C]
    s of
      [] -> Int
    0
      C Int
    i Char
    _ : [C]
    _ -> Int
    i

    rest :: P String
    rest :: P [Char]
    rest = ([C] -> Maybe ([C], [Char])) -> P [Char]
    forall a. ([C] -> Maybe ([C], a)) -> P a
    P (([C] -> Maybe ([C], [Char])) -> P [Char])
    -> ([C] -> Maybe ([C], [Char])) -> P [Char]
    forall a b. (a -> b) -> a -> b
    $ \[C]
    cs -> ([C], [Char]) -> Maybe ([C], [Char])
    forall a. a -> Maybe a
    Just ([], [Char
    c | C Int
    _ Char
    c <- [C]
    cs])

    munch :: (Int -> Char -> Bool) -> P String
    munch :: (Int -> Char -> Bool) -> P [Char]
    munch Int -> Char -> Bool
    p = ([C] -> Maybe ([C], [Char])) -> P [Char]
    forall a. ([C] -> Maybe ([C], a)) -> P a
    P (([C] -> Maybe ([C], [Char])) -> P [Char])
    -> ([C] -> Maybe ([C], [Char])) -> P [Char]
    forall a b. (a -> b) -> a -> b
    $ \[C]
    cs ->
      let ([Char]
    xs, [C]
    ys) = (C -> Maybe Char) -> [C] -> ([Char], [C])
    forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
    takeWhileMaybe C -> Maybe Char
    p' [C]
    cs in ([C], [Char]) -> Maybe ([C], [Char])
    forall a. a -> Maybe a
    Just ([C]
    ys, [Char]
    xs)
      where
        p' :: C -> Maybe Char
    p' (C Int
    i Char
    c)
          | Int -> Char -> Bool
    p Int
    i Char
    c = Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    c
          | Bool
    otherwise = Maybe Char
    forall a. Maybe a
    Nothing

    munch1 :: (Int -> Char -> Bool) -> P String
    munch1 :: (Int -> Char -> Bool) -> P [Char]
    munch1 Int -> Char -> Bool
    p = ([C] -> Maybe ([C], [Char])) -> P [Char]
    forall a. ([C] -> Maybe ([C], a)) -> P a
    P (([C] -> Maybe ([C], [Char])) -> P [Char])
    -> ([C] -> Maybe ([C], [Char])) -> P [Char]
    forall a b. (a -> b) -> a -> b
    $ \[C]
    s -> case [C]
    s of
      [] -> Maybe ([C], [Char])
    forall a. Maybe a
    Nothing
      (C
    c : [C]
    cs)
        | Just Char
    c' <- C -> Maybe Char
    p' C
    c -> let ([Char]
    xs, [C]
    ys) = (C -> Maybe Char) -> [C] -> ([Char], [C])
    forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
    takeWhileMaybe C -> Maybe Char
    p' [C]
    cs in ([C], [Char]) -> Maybe ([C], [Char])
    forall a. a -> Maybe a
    Just ([C]
    ys, Char
    c' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Char]
    xs)
        | Bool
    otherwise -> Maybe ([C], [Char])
    forall a. Maybe a
    Nothing
      where
        p' :: C -> Maybe Char
    p' (C Int
    i Char
    c)
          | Int -> Char -> Bool
    p Int
    i Char
    c = Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    c
          | Bool
    otherwise = Maybe Char
    forall a. Maybe a
    Nothing

    char :: Char -> P Char
    char :: Char -> P Char
    char Char
    c = ([C] -> Maybe ([C], Char)) -> P Char
    forall a. ([C] -> Maybe ([C], a)) -> P a
    P (([C] -> Maybe ([C], Char)) -> P Char)
    -> ([C] -> Maybe ([C], Char)) -> P Char
    forall a b. (a -> b) -> a -> b
    $ \[C]
    s -> case [C]
    s of
      [] -> Maybe ([C], Char)
    forall a. Maybe a
    Nothing
      (C Int
    _ Char
    c' : [C]
    cs)
        | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c' -> ([C], Char) -> Maybe ([C], Char)
    forall a. a -> Maybe a
    Just ([C]
    cs, Char
    c)
        | Bool
    otherwise -> Maybe ([C], Char)
    forall a. Maybe a
    Nothing

    skipSpaces :: P ()
    skipSpaces :: P ()
    skipSpaces = ([C] -> Maybe ([C], ())) -> P ()
    forall a. ([C] -> Maybe ([C], a)) -> P a
    P (([C] -> Maybe ([C], ())) -> P ())
    -> ([C] -> Maybe ([C], ())) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \[C]
    cs -> ([C], ()) -> Maybe ([C], ())
    forall a. a -> Maybe a
    Just ((C -> Bool) -> [C] -> [C]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (\(C Int
    _ Char
    c) -> Char -> Bool
    isSpace Char
    c) [C]
    cs, ())

    takeWhileMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
    takeWhileMaybe :: forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
    takeWhileMaybe a -> Maybe b
    f = [a] -> ([b], [a])
    go
      where
        go :: [a] -> ([b], [a])
    go xs0 :: [a]
    xs0@[] = ([], [a]
    xs0)
        go xs0 :: [a]
    xs0@(a
    x : [a]
    xs) = case a -> Maybe b
    f a
    x of
          Just b
    y -> let ([b]
    ys, [a]
    zs) = [a] -> ([b], [a])
    go [a]
    xs in (b
    y b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    : [b]
    ys, [a]
    zs)
          Maybe b
    Nothing -> ([], [a]
    xs0)

    -------------------------------------------------------------------------------
    -- Fields
    -------------------------------------------------------------------------------

    field :: Int -> P (String, String)
    field :: Int -> P ([Char], [Char])
    field Int
    i = do
      fn <- (Int -> Char -> Bool) -> P [Char]
    munch1 ((Int -> Char -> Bool) -> P [Char])
    -> (Int -> Char -> Bool) -> P [Char]
    forall a b. (a -> b) -> a -> b
    $ \Int
    _ Char
    c -> Char -> Bool
    isAlpha Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-'
      skipSpaces
      _ <- char ':'
      skipSpaces
      val <- munch $ \Int
    j Char
    c -> Char -> Bool
    isSpace Char
    c Bool -> Bool -> Bool
    || Int
    j Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    i
      return (fn, val)

    fields :: P ([(String, String)], String)
    fields :: P ([([Char], [Char])], [Char])
    fields = do
      P ()
    skipSpaces
      i <- P Int
    curInd
      fs <- many (field i)
      r <- rest
      return (fs, r)