content: module Command.Docs.Html
    ( asHtml
    , layout
    , writeHtmlModule
    , writeHtmlModules
    ) where
  
  import Prelude
  
  import Control.Applicative (Alternative(..))
  import Control.Arrow ((&&&))
  import Control.Monad (guard)
  import Data.List (sort)
  import Data.Text (Text)
  import Data.Text.Lazy (toStrict)
  import Data.Text qualified as T
  import Language.PureScript qualified as P
  import Language.PureScript.Docs qualified as D
  import Language.PureScript.Docs.AsHtml qualified as D
  import Text.Blaze.Html5 (Html, (!), toMarkup)
  import Text.Blaze.Html5 qualified as H
  import Text.Blaze.Html5.Attributes qualified as A
  import Text.Blaze.Html.Renderer.Text qualified as Blaze
  import System.IO.UTF8 (writeUTF8FileT)
  import Version (versionString)
  
  writeHtmlModules :: FilePath -> [(P.ModuleName, D.HtmlOutputModule Html)] -> IO ()
  writeHtmlModules outputDir modules = do
    let moduleList = sort $ map fst modules
    writeHtmlFile (outputDir ++ "/index.html") (renderIndexModule moduleList)
    mapM_ (writeHtmlModule outputDir . (fst &&& layout moduleList)) modules
  
  asHtml :: D.Module -> (P.ModuleName, D.HtmlOutputModule Html)
  asHtml m = D.moduleAsHtml (const $ Just $ getHtmlRenderContext (D.modName m)) m
  
  writeHtmlModule :: FilePath -> (P.ModuleName, Html) -> IO ()
  writeHtmlModule outputDir (mn, html) = do
    let filepath = outputDir ++ "/" ++ T.unpack (P.runModuleName mn) ++ ".html"
    writeHtmlFile filepath html
  
  writeHtmlFile :: FilePath -> Html -> IO ()
  writeHtmlFile filepath =
    writeUTF8FileT filepath . toStrict . Blaze.renderHtml
  
  getHtmlRenderContext :: P.ModuleName -> D.HtmlRenderContext
  getHtmlRenderContext mn = D.HtmlRenderContext
    { D.buildDocLink = getLink mn
    , D.renderDocLink = renderLink
    , D.renderSourceLink = const Nothing
    }
  
  -- TODO: try to combine this with the one in Docs.Types?
  getLink :: P.ModuleName -> D.Namespace -> Text -> D.ContainingModule -> Maybe D.DocLink
  getLink curMn namespace target containingMod = do
    location <- getLinkLocation
    return D.DocLink
      { D.linkLocation = location
      , D.linkTitle = target
      , D.linkNamespace = namespace
      }
  
    where
    getLinkLocation = builtinLinkLocation <|> normalLinkLocation
  
    normalLinkLocation = do
      case containingMod of
        D.ThisModule ->
          return $ D.LocalModule curMn
        D.OtherModule destMn ->
          -- This is OK because all modules count as 'local' for purs docs in
          -- html mode
          return $ D.LocalModule destMn
  
    builtinLinkLocation = do
      let primMn = P.moduleNameFromString "Prim"
      guard $ containingMod == D.OtherModule primMn
      return $ D.BuiltinModule primMn
  
  renderLink :: D.DocLink -> Text
  renderLink l =
    case D.linkLocation l of
      D.LocalModule dest ->
        P.runModuleName dest <> ".html"
      D.DepsModule{} ->
        P.internalError "DepsModule: not implemented"
      D.BuiltinModule dest  ->
        P.runModuleName dest <> ".html"
  
  layout :: [P.ModuleName] -> (P.ModuleName, D.HtmlOutputModule Html) -> Html
  layout moduleList (mn, htmlDocs) =
    basicLayout ("PureScript: " <> modName) $ do
      H.div ! A.class_ "page-title clearfix" $ do
        H.div ! A.class_ "page-title__label" $ "Module"
        H.h1 ! A.class_ "page-title__title" $ toMarkup modName
  
      H.div ! A.class_ "col col--main" $ do
        D.htmlOutputModuleLocals htmlDocs
        mapM_ renderReExports (D.htmlOutputModuleReExports htmlDocs)
  
      H.div ! A.class_ "col col--aside" $ do
        H.h3 "Modules"
        renderModuleList moduleList
    where
    modName = P.runModuleName mn
  
    renderReExports :: (D.InPackage P.ModuleName, Html) -> Html
    renderReExports (reExpFrom, html) = do
      H.h2 ! A.class_ "re-exports" $ do
        toMarkup ("Re-exports from " :: Text)
        H.a ! A.href (H.toValue (toText reExpFrom <> ".html")) $
          toMarkup (toText reExpFrom)
      html
  
    toText = P.runModuleName . D.ignorePackage
  
  basicLayout :: Text -> Html -> Html
  basicLayout title inner =
    H.docTypeHtml $ do
      H.head $ do
        H.meta ! A.charset "utf-8"
        H.meta ! A.httpEquiv "X-UA-Compatible" ! A.content "IE=edge"
        H.meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1"
        H.title (toMarkup title)
  
        H.link ! A.href "https://fonts.googleapis.com/css?family=Roboto+Mono|Roboto:300,400,400i,700,700i"
               ! A.type_ "text/css" ! A.rel "stylesheet"
        H.style ! A.type_ "text/css" $
          toMarkup D.normalizeCssT
        H.style ! A.type_ "text/css" $
          toMarkup D.pursuitCssT
      H.body $ do
        H.div ! A.class_ "everything-except-footer" $ do
          H.div ! A.class_ "top-banner clearfix" $ do
            H.div ! A.class_ "container clearfix" $ do
              H.div ! A.style inlineHeaderStyles $ do
                "PureScript API documentation"
  
              H.div ! A.class_ "top-banner__actions" $ do
                H.div ! A.class_ "top-banner__actions__item" $ do
                  H.a ! A.href "index.html" $ "Index"
  
          H.main ! A.class_ "container clearfix" ! H.customAttribute "role" "main" $ do
            inner
  
        H.div ! A.class_ "footer clearfix" $
          H.p $ toMarkup $ "Generated by purs " <> versionString
  
    where
    -- Like Pursuit's .top-banner__logo except without the 'hover' styles
    inlineHeaderStyles = "float: left; font-size: 2.44em; font-weight: 300; line-height: 90px; margin: 0"
  
  renderIndexModule :: [P.ModuleName] -> Html
  renderIndexModule moduleList =
    basicLayout "PureScript API documentation" $ do
      H.div ! A.class_ "page-title clearfix" $ do
        H.h1 ! A.class_ "page-title__title" $ "Index"
      H.div ! A.class_ "col col--main" $ do
        renderModuleList moduleList
  
  renderModuleList :: [P.ModuleName] -> Html
  renderModuleList moduleList =
    H.ul $ mapM_ listItem moduleList
  
    where
    listItem mn = H.li $
      H.a ! A.href (H.toValue (P.runModuleName mn <> ".html")) $
        toMarkup (P.runModuleName mn)
  