    {-# LANGUAGE ViewPatterns #-}
    module Data.GI.CodeGen.SymbolNaming
        ( lowerName
        , lowerSymbol
        , upperName
        , escapedArgName

        , classConstraint
        , typeConstraint
        , safeCast

        , hyphensToCamelCase
        , underscoresToCamelCase

        , callbackCType
        , callbackHTypeWithClosures
        , callbackDropClosures
        , callbackDynamicWrapper
        , callbackWrapperAllocator
        , callbackHaskellToForeign
        , callbackHaskellToForeignWithClosures
        , callbackClosureGenerator

        , signalHaskellName
        , signalInfoName

        , submoduleLocation
        , moduleLocation
        , qualifiedAPI
        , qualifiedSymbol
        , normalizedAPIName

        , hackageModuleLink
        , haddockSignalAnchor
        , haddockAttrAnchor
        ) where

    import qualified Data.Char as C
    #if !MIN_VERSION_base(4,11,0)
    import Data.Monoid ((<>))
    #endif
    import Data.Text (Text)
    import qualified Data.Text as T

    import Data.GI.CodeGen.API
    import Data.GI.CodeGen.Code (CodeGen, qualified, getAPI, findAPIByName, config)
    import Data.GI.CodeGen.Config (Config(..))
    import Data.GI.CodeGen.ModulePath (ModulePath, (/.), toModulePath, dotModulePath)
    import Data.GI.CodeGen.Type (Type(TInterface))
    import Data.GI.CodeGen.Util (lcFirst, ucFirst, modifyQualified)

    -- | Return a qualified form of the constraint for the given name
    -- (which should correspond to a valid `TInterface`).
    classConstraint :: Name -> CodeGen e Text
    classConstraint :: forall e. Name -> CodeGen e Text
    classConstraint n :: Name
    n@(Name Text
    _ Text
    s) = Text -> Name -> CodeGen e Text
    forall e. Text -> Name -> CodeGen e Text
    qualifiedSymbol (Text
    "Is" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s) Name
    n

    -- | Return a qualified form of the function mapping instances of
    -- @IsX@ to haskell values of type @X@.
    safeCast :: Name -> CodeGen e Text
    safeCast :: forall e. Name -> CodeGen e Text
    safeCast n :: Name
    n@(Name Text
    _ Text
    s) = Text -> Name -> CodeGen e Text
    forall e. Text -> Name -> CodeGen e Text
    qualifiedSymbol (Text
    "to" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    ucFirst Text
    s) Name
    n

    -- | Same as `classConstraint`, but applicable directly to a type. The
    -- type should be a `TInterface`, otherwise an error will be raised.
    typeConstraint :: Type -> CodeGen e Text
    typeConstraint :: forall e. Type -> CodeGen e Text
    typeConstraint (TInterface Name
    n) = Name -> CodeGen e Text
    forall e. Name -> CodeGen e Text
    classConstraint Name
    n
    typeConstraint Type
    t = String -> CodeGen e Text
    forall a. HasCallStack => String -> a
    error (String -> CodeGen e Text) -> String -> CodeGen e Text
    forall a b. (a -> b) -> a -> b
    $ String
    "Class constraint for non-interface type: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Type -> String
    forall a. Show a => a -> String
    show Type
    t

    -- | Foreign type associated with a callback type. It can be passed in
    -- qualified.
    callbackCType :: Text -> Text
    callbackCType :: Text -> Text
    callbackCType = (Text -> Text) -> Text -> Text
    modifyQualified (Text
    "C_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>)

    -- | Haskell type exposing the closure arguments, which are generally
    -- elided.
    callbackHTypeWithClosures :: Text -> Text
    callbackHTypeWithClosures :: Text -> Text
    callbackHTypeWithClosures = (Text -> Text) -> Text -> Text
    modifyQualified (Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_WithClosures")

    -- | The name of the dynamic wrapper for the given callback type. It
    -- can be passed in qualified.
    callbackDynamicWrapper :: Text -> Text
    callbackDynamicWrapper :: Text -> Text
    callbackDynamicWrapper = (Text -> Text) -> Text -> Text
    modifyQualified (Text
    "dynamic_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>)

    -- | The name of the Haskell to foreign wrapper for the given callback
    -- type. It can be passed in qualified.
    callbackHaskellToForeign :: Text -> Text
    callbackHaskellToForeign :: Text -> Text
    callbackHaskellToForeign = (Text -> Text) -> Text -> Text
    modifyQualified (Text
    "wrap_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>)

    -- | The name of the Haskell to foreign wrapper for the given callback
    -- type, keeping the closure arguments (we usually elide them). The
    -- callback type can be passed in qualified.
    callbackHaskellToForeignWithClosures :: Text -> Text
    callbackHaskellToForeignWithClosures :: Text -> Text
    callbackHaskellToForeignWithClosures = (Text -> Text) -> Text -> Text
    modifyQualified (Text
    "with_closures_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>)

    -- | The name of a function which takes a callback without closure
    -- arguments, and generates a function which does accep the closures,
    -- but simply ignores them.
    callbackDropClosures :: Text -> Text
    callbackDropClosures :: Text -> Text
    callbackDropClosures = (Text -> Text) -> Text -> Text
    modifyQualified (Text
    "drop_closures_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>)

    -- | The name for the foreign wrapper allocator (@foreign import
    -- "wrapper" ...@) for the given callback type. It can be passed in
    -- qualified.
    callbackWrapperAllocator :: Text -> Text
    callbackWrapperAllocator :: Text -> Text
    callbackWrapperAllocator = (Text -> Text) -> Text -> Text
    modifyQualified (Text
    "mk_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>)

    -- | The name for the closure generator for the given callback
    -- type. It can be passed in qualified.
    callbackClosureGenerator :: Text -> Text
    callbackClosureGenerator :: Text -> Text
    callbackClosureGenerator = (Text -> Text) -> Text -> Text
    modifyQualified (Text
    "genClosure_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>)

    -- | Move leading underscores to the end.
    --
    -- === Examples
    -- >>> sanitize "_Value_Data_Union"
    -- "Value_Data_Union_"
    sanitize :: Text -> Text
    sanitize :: Text -> Text
    sanitize (Text -> Maybe (Char, Text)
    T.uncons -> Just (Char
    '_', Text
    xs)) = Text -> Text
    sanitize Text
    xs Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_"
    sanitize Text
    xs = Text
    xs

    -- | Turn the given `Name` into CamelCase, starting with a lowercase
    -- letter. The resulting identifier will be qualified by the namespace
    -- if necessary.
    --
    -- === __Examples__
    -- >>> lowerName (Name "Gtk" "main_quit")
    -- "mainQuit"
    --
    -- >>> lowerName (Name "NM" "80211Test")
    -- "nM80211Test"
    lowerName :: Name -> Text
    lowerName :: Name -> Text
    lowerName (Name Text
    ns Text
    s) =
      if Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    C.isAlpha (Char -> Bool) -> Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Char
    Text -> Char
    T.head (Text -> Text
    sanitize Text
    s) then
        Text -> Text
    lowerSymbol (Text
    ns Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s)
      else
        Text -> Text
    lowerSymbol Text
    s

    -- | Turn the given identifier into camelCase, starting with a
    -- lowercase letter.
    --
    -- === __Examples__
    -- >>> lowerSymbol "main_quit"
    -- "mainQuit"
    lowerSymbol :: Text -> Text
    lowerSymbol :: Text -> Text
    lowerSymbol Text
    s = case Text -> Text
    underscoresToCamelCase (Text -> Text
    sanitize Text
    s) of
                      Text
    "" -> String -> Text
    forall a. HasCallStack => String -> a
    error String
    "empty name!!"
                      Text
    n -> Text -> Text
    lcFirst Text
    n

    -- | Turn the given `Name` into CamelCase, starting with a capital
    -- letter. The resulting identifier will be qualified by the namespace
    -- if necessary.
    --
    -- === __Examples__
    -- >>> upperName (Name "Foo" "bar_baz")
    -- "BarBaz"
    --
    -- >>> upperName (Name "NM" "80211ApFlags")
    -- "NM80211ApFlags"
    upperName :: Name -> Text
    upperName :: Name -> Text
    upperName (Name Text
    ns Text
    s) =
      if Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    C.isAlpha (Char -> Bool) -> Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Char
    Text -> Char
    T.head (Text -> Text
    sanitize Text
    s) then
        Text -> Text
    underscoresToCamelCase (Text -> Text
    sanitize (Text
    ns Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s))
      else
        Text -> Text
    underscoresToCamelCase (Text -> Text
    sanitize Text
    s)

    -- | Construct the submodule path where the given API element will
    -- live. This is the path relative to the root for the corresponding
    -- namespace. I.e. the "GI.Gtk" part is not prepended.
    submoduleLocation :: Name -> API -> ModulePath
    submoduleLocation :: Name -> API -> ModulePath
    submoduleLocation Name
    _ (APIConst Constant
    _) = ModulePath
    "Constants"
    submoduleLocation Name
    _ (APIFunction Function
    _) = ModulePath
    "Functions"
    submoduleLocation Name
    _ (APICallback Callback
    _) = ModulePath
    "Callbacks"
    submoduleLocation Name
    _ (APIEnum Enumeration
    _) = ModulePath
    "Enums"
    submoduleLocation Name
    _ (APIFlags Flags
    _) = ModulePath
    "Flags"
    submoduleLocation Name
    n (APIInterface Interface
    _) = ModulePath
    "Interfaces" ModulePath -> Text -> ModulePath
    /. Name -> Text
    upperName Name
    n
    submoduleLocation Name
    n (APIObject Object
    _) = ModulePath
    "Objects" ModulePath -> Text -> ModulePath
    /. Name -> Text
    upperName Name
    n
    submoduleLocation Name
    n (APIStruct Struct
    _) = ModulePath
    "Structs" ModulePath -> Text -> ModulePath
    /. Name -> Text
    upperName Name
    n
    submoduleLocation Name
    n (APIUnion Union
    _) = ModulePath
    "Unions" ModulePath -> Text -> ModulePath
    /. Name -> Text
    upperName Name
    n

    -- | Obtain the absolute location of the module where the given `API`
    -- lives.
    moduleLocation :: Name -> API -> ModulePath
    moduleLocation :: Name -> API -> ModulePath
    moduleLocation Name
    n API
    api =
      (ModulePath
    "GI" ModulePath -> Text -> ModulePath
    /. Text -> Text
    ucFirst (Name -> Text
    namespace Name
    n)) ModulePath -> ModulePath -> ModulePath
    forall a. Semigroup a => a -> a -> a
    <> Name -> API -> ModulePath
    submoduleLocation Name
    n API
    api

    -- | Construct the Haskell version of the name associated to the given
    -- API.
    normalizedAPIName :: API -> Name -> Name
    normalizedAPIName :: API -> Name -> Name
    normalizedAPIName (APIConst Constant
    _) (Name Text
    ns Text
    name) = Text -> Text -> Name
    Name Text
    ns (Text -> Text
    ucFirst Text
    name)
    normalizedAPIName (APIFunction Function
    _) Name
    n = Name
    n
    normalizedAPIName (APICallback Callback
    _) n :: Name
    n@(Name Text
    ns Text
    _) = Text -> Text -> Name
    Name Text
    ns (Name -> Text
    upperName Name
    n)
    normalizedAPIName (APIEnum Enumeration
    _) n :: Name
    n@(Name Text
    ns Text
    _) = Text -> Text -> Name
    Name Text
    ns (Name -> Text
    upperName Name
    n)
    normalizedAPIName (APIFlags Flags
    _) n :: Name
    n@(Name Text
    ns Text
    _) = Text -> Text -> Name
    Name Text
    ns (Name -> Text
    upperName Name
    n)
    normalizedAPIName (APIInterface Interface
    _) n :: Name
    n@(Name Text
    ns Text
    _) = Text -> Text -> Name
    Name Text
    ns (Name -> Text
    upperName Name
    n)
    normalizedAPIName (APIObject Object
    _) n :: Name
    n@(Name Text
    ns Text
    _) = Text -> Text -> Name
    Name Text
    ns (Name -> Text
    upperName Name
    n)
    normalizedAPIName (APIStruct Struct
    _) n :: Name
    n@(Name Text
    ns Text
    _) = Text -> Text -> Name
    Name Text
    ns (Name -> Text
    upperName Name
    n)
    normalizedAPIName (APIUnion Union
    _) n :: Name
    n@(Name Text
    ns Text
    _) = Text -> Text -> Name
    Name Text
    ns (Name -> Text
    upperName Name
    n)

    -- | Return an identifier for the given interface type valid in the current
    -- module.
    qualifiedAPI :: API -> Name -> CodeGen e Text
    qualifiedAPI :: forall e. API -> Name -> CodeGen e Text
    qualifiedAPI API
    api n :: Name
    n@(Name Text
    ns Text
    _) =
      let normalized :: Name
    normalized = API -> Name -> Name
    normalizedAPIName API
    api Name
    n
      in ModulePath -> Name -> CodeGen e Text
    forall e. ModulePath -> Name -> CodeGen e Text
    qualified (Text -> ModulePath
    toModulePath (Text -> Text
    ucFirst Text
    ns) ModulePath -> ModulePath -> ModulePath
    forall a. Semigroup a => a -> a -> a
    <> Name -> API -> ModulePath
    submoduleLocation Name
    n API
    api) Name
    normalized

    -- | Construct an identifier for the given symbol in the given API.
    qualifiedSymbol :: Text -> Name -> CodeGen e Text
    qualifiedSymbol :: forall e. Text -> Name -> CodeGen e Text
    qualifiedSymbol Text
    s n :: Name
    n@(Name Text
    ns Text
    _) = do
      api <- Type -> CodeGen e API
    forall e. HasCallStack => Type -> CodeGen e API
    getAPI (Name -> Type
    TInterface Name
    n)
      qualified (toModulePath (ucFirst ns) <> submoduleLocation n api) (Name ns s)

    -- | Turn a hyphen-separated identifier into camel case.
    --
    -- === __Examples__
    -- >>> hyphensToCamelCase "one-sample-string"
    -- "OneSampleString"
    hyphensToCamelCase :: Text -> Text
    hyphensToCamelCase :: Text -> Text
    hyphensToCamelCase = [Text] -> Text
    T.concat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Text
    ucFirst ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> Text -> [Text]
    T.split (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-')

    -- | Similarly to `hyphensToCamelCase`, turn a name
    -- separated_by_underscores into CamelCase. We preserve final and
    -- initial underscores, and n>1 consecutive underscores are
    -- transformed into n-1 underscores.
    --
    -- === __Examples__
    -- >>> underscoresToCamelCase "sample_id"
    -- "SampleId"
    --
    -- >>> underscoresToCamelCase "_internal_id_"
    -- "_InternalId_"
    --
    -- >>> underscoresToCamelCase "multiple___underscores"
    -- "Multiple__Underscores"
    underscoresToCamelCase :: Text -> Text
    underscoresToCamelCase :: Text -> Text
    underscoresToCamelCase =
        [Text] -> Text
    T.concat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Text
    normalize ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Text
    ucFirst ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> Text -> [Text]
    T.split (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_')
            where normalize :: Text -> Text
                  normalize :: Text -> Text
    normalize Text
    "" = Text
    "_"
                  normalize Text
    s = Text
    s

    -- | Name for the given argument, making sure it is a valid Haskell
    -- argument name (and escaping it if not).
    escapedArgName :: Arg -> Text
    escapedArgName :: Arg -> Text
    escapedArgName Arg
    arg
        | Arg -> Text
    argCName Arg
    arg Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "_" = Text
    "_'"  -- "_" denotes a hole, so we need to escape it
        | Text
    "_" Text -> Text -> Bool
    `T.isPrefixOf` Arg -> Text
    argCName Arg
    arg = Arg -> Text
    argCName Arg
    arg
        | Bool
    otherwise =
            Text -> Text
    escapeReserved (Text -> Text) -> (Arg -> Text) -> Arg -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    lcFirst (Text -> Text) -> (Arg -> Text) -> Arg -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    underscoresToCamelCase (Text -> Text) -> (Arg -> Text) -> Arg -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg -> Text
    argCName (Arg -> Text) -> Arg -> Text
    forall a b. (a -> b) -> a -> b
    $ Arg
    arg

    -- | Reserved symbols, either because they are Haskell syntax or
    -- because the clash with symbols in scope for the generated bindings.
    escapeReserved :: Text -> Text
    escapeReserved :: Text -> Text
    escapeReserved Text
    "type" = Text
    "type_"
    escapeReserved Text
    "in" = Text
    "in_"
    escapeReserved Text
    "data" = Text
    "data_"
    escapeReserved Text
    "instance" = Text
    "instance_"
    escapeReserved Text
    "where" = Text
    "where_"
    escapeReserved Text
    "module" = Text
    "module_"
    -- Reserved because we generate code that uses these names.
    escapeReserved Text
    "result" = Text
    "result_"
    escapeReserved Text
    "return" = Text
    "return_"
    escapeReserved Text
    "show" = Text
    "show_"
    escapeReserved Text
    "fromEnum" = Text
    "fromEnum_"
    escapeReserved Text
    "toEnum" = Text
    "toEnum_"
    escapeReserved Text
    "undefined" = Text
    "undefined_"
    escapeReserved Text
    "error" = Text
    "error_"
    escapeReserved Text
    "map" = Text
    "map_"
    escapeReserved Text
    "length" = Text
    "length_"
    escapeReserved Text
    "mapM" = Text
    "mapM__"
    escapeReserved Text
    "mapM_" = Text
    "mapM___"
    escapeReserved Text
    "fromIntegral" = Text
    "fromIntegral_"
    escapeReserved Text
    "realToFrac" = Text
    "realToFrac_"
    escapeReserved Text
    "peek" = Text
    "peek_"
    escapeReserved Text
    "poke" = Text
    "poke_"
    escapeReserved Text
    "sizeOf" = Text
    "sizeOf_"
    escapeReserved Text
    "when" = Text
    "when_"
    escapeReserved Text
    "default" = Text
    "default_"
    escapeReserved Text
    s
        | Text
    "set_" Text -> Text -> Bool
    `T.isPrefixOf` Text
    s = Text
    s Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_"
        | Text
    "get_" Text -> Text -> Bool
    `T.isPrefixOf` Text
    s = Text
    s Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_"
        | Bool
    otherwise = Text
    s

    -- | Qualified name for the "(sigName, info)" tag for a given signal.
    signalInfoName :: Name -> Signal -> CodeGen e Text
    signalInfoName :: forall e. Name -> Signal -> CodeGen e Text
    signalInfoName Name
    n Signal
    signal = do
      let infoName :: Text
    infoName = Name -> Text
    upperName Name
    n Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (Text -> Text
    ucFirst (Text -> Text) -> (Signal -> Text) -> Signal -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    signalHaskellName (Text -> Text) -> (Signal -> Text) -> Signal -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Signal -> Text
    sigName) Signal
    signal
                     Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "SignalInfo"
      Text -> Name -> CodeGen e Text
    forall e. Text -> Name -> CodeGen e Text
    qualifiedSymbol Text
    infoName Name
    n

    -- | Return the name for the signal in Haskell CamelCase conventions.
    signalHaskellName :: Text -> Text
    signalHaskellName :: Text -> Text
    signalHaskellName Text
    sn = case (Char -> Bool) -> Text -> [Text]
    T.split (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-') Text
    sn of
                             [] -> Text
    ""  -- Won't happen due to the
                                       -- definition of T.split, but GHC
                                       -- does not know this.
                             Text
    w:[Text]
    ws -> Text
    w Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    T.concat ((Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Text
    ucFirst [Text]
    ws)

    -- | Return a link to the hackage package for the given name. Note
    -- that the generated link will only be valid if the name belongs to
    -- the binding which is currently being generated.
    hackageModuleLink :: Name -> CodeGen e Text
    hackageModuleLink :: forall e. Name -> CodeGen e Text
    hackageModuleLink Name
    n = do
      api <- Name -> CodeGen e API
    forall e. HasCallStack => Name -> CodeGen e API
    findAPIByName Name
    n
      cfg <- config
      let location = HasCallStack => Text -> Text -> Text -> Text
    Text -> Text -> Text -> Text
    T.replace Text
    "." Text
    "-" (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ ModulePath -> Text
    dotModulePath (Name -> API -> ModulePath
    moduleLocation Name
    n API
    api)
          pkg = Config -> Text
    ghcPkgName Config
    cfg Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "-" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Config -> Text
    ghcPkgVersion Config
    cfg
      return $ "https://hackage.haskell.org/package/" <> pkg <> "/docs/"
               <> location <> ".html"

    -- | Prefix in Haddock for the signal anchor.
    haddockSignalAnchor :: Text
    haddockSignalAnchor :: Text
    haddockSignalAnchor = Text
    "g:signal:"

    -- | Prefix in Haddock for the attribute anchor.
    haddockAttrAnchor :: Text
    haddockAttrAnchor :: Text
    haddockAttrAnchor = Text
    "g:attr:"