{-# LANGUAGE LambdaCase #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE DerivingStrategies #-} -- | Functions to parse and display Haddock HTML module Docs.CLI.Haddock ( Html , HtmlPage , Declaration(..) , Module(..) , Package(..) , parseHtmlDocument , parseModuleDocs , parsePackageDocs , sourceLinks , fileInfo , HasCompletion(..) -- general html utils , innerString , prettyHtml , numbered , parseHoogleHtml , link ) where import Docs.CLI.Types import Data.Bifunctor (first) import Data.List.Extra (unescapeHTML) import Data.Foldable (fold) import Control.Monad (foldM) import Data.Maybe (fromMaybe, mapMaybe, listToMaybe, fromJust) import Data.List hiding (groupBy) import Data.List.Extra (breakOn) import Data.Maybe (isJust) import Data.Char (isSpace) import Data.Text (Text) import Data.Set (Set) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as LB import qualified Data.Text.Encoding as Text import qualified Text.HTML.DOM as Html import qualified Text.XML as Xml import qualified Data.Text as Text import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Text.PrettyPrint.ANSI.Leijen as P -- | An html element newtype Html = Html Xml.Element deriving newtype (Show, Eq) -- | The root of an html page newtype HtmlPage = HtmlPage Xml.Element -- | An exported declaration data Declaration = Declaration { dAnchors :: Set Anchor , dAnchor :: Anchor -- ^ Main declaration anchor , dSignature :: Html , dSignatureExpanded :: Html -- ^ Signature with argument documentation, if available. , dContent :: [Html] , dModuleUrl :: ModuleUrl , dDeclUrl :: DeclUrl , dCompletion :: String -- ^ string to be used when selecting this declaration with tab completion } data Module = Module { mTitle :: String , mDescription :: Maybe Html , mDeclarations :: [Declaration] , mUrl :: ModuleUrl } data Package = Package { pTitle :: String , pSubTitle :: Maybe String , pDescription :: Html , pReadme :: Maybe Html , pProperties :: [(String, Html)] , pModules :: [String] , pUrl :: PackageUrl } -- | Types that can be selected with tab completion class HasCompletion a where completion :: a -> String instance HasCompletion a => HasCompletion (NonEmpty.NonEmpty a) where completion = completion . NonEmpty.head instance HasCompletion String where completion = id instance HasCompletion Declaration where completion = dCompletion instance HasCompletion Module where completion = mTitle instance HasCompletion Package where completion = pTitle parseHtmlDocument :: ByteString -> HtmlPage parseHtmlDocument = HtmlPage . Xml.documentRoot . Html.parseLBS parseHoogleHtml :: String -> Html parseHoogleHtml = Html . Xml.documentRoot . Html.parseLBS . LB.fromStrict . Text.encodeUtf8 . Text.pack . (\v -> "