diff options
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Themes.hs | 7 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Types.hs | 11 | 
2 files changed, 15 insertions, 3 deletions
| diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs b/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs index b1d64acd..08ef747a 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs @@ -17,6 +17,7 @@ module Haddock.Backends.Xhtml.Themes (      where  import Haddock.Options +import Haddock.Backends.Xhtml.Types ( BaseURL, withBaseURL )  import Control.Monad (liftM)  import Data.Char (toLower) @@ -176,13 +177,13 @@ cssFiles :: Themes -> [String]  cssFiles ts = nub $ concatMap themeFiles ts -styleSheet :: Themes -> Html -styleSheet ts = toHtml $ zipWith mkLink rels ts +styleSheet :: BaseURL -> Themes -> Html +styleSheet base_url ts = toHtml $ zipWith mkLink rels ts    where      rels = "stylesheet" : repeat "alternate stylesheet"      mkLink aRel t =        thelink -        ! [ href (themeHref t),  rel aRel, thetype "text/css", +        ! [ href (withBaseURL base_url (themeHref t)),  rel aRel, thetype "text/css",              XHtml.title (themeName t)            ]          << noHtml diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Types.hs b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs index e3fd2d5a..a68cb559 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Types.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs @@ -12,6 +12,8 @@  -----------------------------------------------------------------------------  module Haddock.Backends.Xhtml.Types (    SourceURLs, WikiURLs, +  BaseURL, +  withBaseURL,    LinksInfo,    Splice,    Unicode, @@ -20,12 +22,21 @@ module Haddock.Backends.Xhtml.Types (  import Data.Map  import GHC +import qualified System.FilePath as FilePath  -- the base, module and entity URLs for the source code and wiki links.  type SourceURLs = (Maybe FilePath, Maybe FilePath, Map Unit FilePath, Map Unit FilePath)  type WikiURLs = (Maybe FilePath, Maybe FilePath, Maybe FilePath) +-- | base url for loading js, json, css resources.  The default is "." +-- +type BaseURL = Maybe String + +-- TODO: we shouldn't use 'FilePath.</>' +withBaseURL :: BaseURL -> String -> String +withBaseURL Nothing        uri = uri +withBaseURL (Just baseUrl) uri = baseUrl FilePath.</> uri  -- The URL for source and wiki links  type LinksInfo = (SourceURLs, WikiURLs) | 
