{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
module Development.IDE.Spans.Common (
unqualIEWrapName
, safeTyThingId
, safeTyThingType
, SpanDoc(..)
, SpanDocUris(..)
, emptySpanDoc
, spanDocToMarkdown
, spanDocToMarkdownForTest
, DocMap
, TyThingMap
) where
import Control.DeepSeq
import Data.List.Extra
import Data.Maybe
import qualified Data.Text as T
import GHC.Generics
import GHC
import Data.Bifunctor (second)
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Orphans ()
import Development.IDE.GHC.Util
import qualified Documentation.Haddock.Parser as H
import qualified Documentation.Haddock.Types as H
type DocMap = NameEnv SpanDoc
type TyThingMap = NameEnv TyThing
#if MIN_VERSION_ghc(9,5,0)
unqualIEWrapName :: IEWrappedName GhcPs -> T.Text
#else
unqualIEWrapName :: IEWrappedName RdrName -> T.Text
#endif
unqualIEWrapName :: IEWrappedName GhcPs -> Text
unqualIEWrapName = OccName -> Text
forall a. Outputable a => a -> Text
printOutputable (OccName -> Text)
-> (IEWrappedName GhcPs -> OccName) -> IEWrappedName GhcPs -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (IEWrappedName GhcPs -> RdrName)
-> IEWrappedName GhcPs
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IEWrappedName GhcPs -> IdP GhcPs
IEWrappedName GhcPs -> RdrName
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName
safeTyThingType :: TyThing -> Maybe Type
safeTyThingType :: TyThing -> Maybe Type
safeTyThingType TyThing
thing
| Just Id
i <- TyThing -> Maybe Id
safeTyThingId TyThing
thing = Type -> Maybe Type
forall a. a -> Maybe a
Just (Id -> Type
varType Id
i)
safeTyThingType (ATyCon TyCon
tycon) = Type -> Maybe Type
forall a. a -> Maybe a
Just (TyCon -> Type
tyConKind TyCon
tycon)
safeTyThingType TyThing
_ = Maybe Type
forall a. Maybe a
Nothing
safeTyThingId :: TyThing -> Maybe Id
safeTyThingId :: TyThing -> Maybe Id
safeTyThingId (AnId Id
i) = Id -> Maybe Id
forall a. a -> Maybe a
Just Id
i
safeTyThingId (AConLike (RealDataCon DataCon
dataCon)) = Id -> Maybe Id
forall a. a -> Maybe a
Just (DataCon -> Id
dataConWrapId DataCon
dataCon)
safeTyThingId TyThing
_ = Maybe Id
forall a. Maybe a
Nothing
#if MIN_VERSION_ghc(9,3,0)
data SpanDoc
= SpanDocString [HsDocString] SpanDocUris
#else
data SpanDoc
= SpanDocString HsDocString SpanDocUris
#endif
| SpanDocText [T.Text] SpanDocUris
deriving stock (SpanDoc -> SpanDoc -> Bool
(SpanDoc -> SpanDoc -> Bool)
-> (SpanDoc -> SpanDoc -> Bool) -> Eq SpanDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanDoc -> SpanDoc -> Bool
== :: SpanDoc -> SpanDoc -> Bool
$c/= :: SpanDoc -> SpanDoc -> Bool
/= :: SpanDoc -> SpanDoc -> Bool
Eq, Int -> SpanDoc -> ShowS
[SpanDoc] -> ShowS
SpanDoc -> [Char]
(Int -> SpanDoc -> ShowS)
-> (SpanDoc -> [Char]) -> ([SpanDoc] -> ShowS) -> Show SpanDoc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpanDoc -> ShowS
showsPrec :: Int -> SpanDoc -> ShowS
$cshow :: SpanDoc -> [Char]
show :: SpanDoc -> [Char]
$cshowList :: [SpanDoc] -> ShowS
showList :: [SpanDoc] -> ShowS
Show, (forall x. SpanDoc -> Rep SpanDoc x)
-> (forall x. Rep SpanDoc x -> SpanDoc) -> Generic SpanDoc
forall x. Rep SpanDoc x -> SpanDoc
forall x. SpanDoc -> Rep SpanDoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SpanDoc -> Rep SpanDoc x
from :: forall x. SpanDoc -> Rep SpanDoc x
$cto :: forall x. Rep SpanDoc x -> SpanDoc
to :: forall x. Rep SpanDoc x -> SpanDoc
Generic)
deriving anyclass SpanDoc -> ()
(SpanDoc -> ()) -> NFData SpanDoc
forall a. (a -> ()) -> NFData a
$crnf :: SpanDoc -> ()
rnf :: SpanDoc -> ()
NFData
data SpanDocUris =
SpanDocUris
{ SpanDocUris -> Maybe Text
spanDocUriDoc :: Maybe T.Text
, SpanDocUris -> Maybe Text
spanDocUriSrc :: Maybe T.Text
} deriving stock (SpanDocUris -> SpanDocUris -> Bool
(SpanDocUris -> SpanDocUris -> Bool)
-> (SpanDocUris -> SpanDocUris -> Bool) -> Eq SpanDocUris
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanDocUris -> SpanDocUris -> Bool
== :: SpanDocUris -> SpanDocUris -> Bool
$c/= :: SpanDocUris -> SpanDocUris -> Bool
/= :: SpanDocUris -> SpanDocUris -> Bool
Eq, Int -> SpanDocUris -> ShowS
[SpanDocUris] -> ShowS
SpanDocUris -> [Char]
(Int -> SpanDocUris -> ShowS)
-> (SpanDocUris -> [Char])
-> ([SpanDocUris] -> ShowS)
-> Show SpanDocUris
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpanDocUris -> ShowS
showsPrec :: Int -> SpanDocUris -> ShowS
$cshow :: SpanDocUris -> [Char]
show :: SpanDocUris -> [Char]
$cshowList :: [SpanDocUris] -> ShowS
showList :: [SpanDocUris] -> ShowS
Show, (forall x. SpanDocUris -> Rep SpanDocUris x)
-> (forall x. Rep SpanDocUris x -> SpanDocUris)
-> Generic SpanDocUris
forall x. Rep SpanDocUris x -> SpanDocUris
forall x. SpanDocUris -> Rep SpanDocUris x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SpanDocUris -> Rep SpanDocUris x
from :: forall x. SpanDocUris -> Rep SpanDocUris x
$cto :: forall x. Rep SpanDocUris x -> SpanDocUris
to :: forall x. Rep SpanDocUris x -> SpanDocUris
Generic)
deriving anyclass SpanDocUris -> ()
(SpanDocUris -> ()) -> NFData SpanDocUris
forall a. (a -> ()) -> NFData a
$crnf :: SpanDocUris -> ()
rnf :: SpanDocUris -> ()
NFData
emptySpanDoc :: SpanDoc
emptySpanDoc :: SpanDoc
emptySpanDoc = [Text] -> SpanDocUris -> SpanDoc
SpanDocText [] (Maybe Text -> Maybe Text -> SpanDocUris
SpanDocUris Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing)
spanDocToMarkdown :: SpanDoc -> [T.Text]
spanDocToMarkdown :: SpanDoc -> [Text]
spanDocToMarkdown = \case
(SpanDocString [HsDocString]
docs SpanDocUris
uris) ->
let doc :: Text
doc = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ DocH [Char] [Char] -> [Char]
haddockToMarkdown (DocH [Char] [Char] -> [Char]) -> DocH [Char] [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ DocH [Char] Identifier -> DocH [Char] [Char]
forall mod. DocH mod Identifier -> DocH mod [Char]
H.toRegular (DocH [Char] Identifier -> DocH [Char] [Char])
-> DocH [Char] Identifier -> DocH [Char] [Char]
forall a b. (a -> b) -> a -> b
$ MetaDoc [Char] Identifier -> DocH [Char] Identifier
forall mod id. MetaDoc mod id -> DocH mod id
H._doc (MetaDoc [Char] Identifier -> DocH [Char] Identifier)
-> MetaDoc [Char] Identifier -> DocH [Char] Identifier
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> [Char] -> MetaDoc [Char] Identifier
forall mod. Maybe [Char] -> [Char] -> MetaDoc mod Identifier
H.parseParas Maybe [Char]
forall a. Maybe a
Nothing ([Char] -> MetaDoc [Char] Identifier)
-> [Char] -> MetaDoc [Char] Identifier
forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_ghc(9,3,0)
[HsDocString] -> [Char]
renderHsDocStrings [HsDocString]
docs
#else
unpackHDS docs
#endif
in [Text] -> SpanDocUris -> [Text]
go [Text
doc] SpanDocUris
uris
(SpanDocText [Text]
txt SpanDocUris
uris) -> [Text] -> SpanDocUris -> [Text]
go [Text]
txt SpanDocUris
uris
where
go :: [Text] -> SpanDocUris -> [Text]
go [] SpanDocUris
uris = Text -> Text
render (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpanDocUris -> [Text]
spanDocUrisToMarkdown SpanDocUris
uris
go [Text]
txt SpanDocUris
uris = [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
init [Text]
txt [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text -> Text
render ([Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
txt)] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
render (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpanDocUris -> [Text]
spanDocUrisToMarkdown SpanDocUris
uris)
render :: Text -> Text
render Text
txt
| Text -> Bool
T.null Text
txt = Text
txt
| HasCallStack => Text -> Char
Text -> Char
T.last Text
txt Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = Text
txt
| Bool
otherwise = Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
"\n"
spanDocUrisToMarkdown :: SpanDocUris -> [T.Text]
spanDocUrisToMarkdown :: SpanDocUris -> [Text]
spanDocUrisToMarkdown (SpanDocUris Maybe Text
mdoc Maybe Text
msrc) = [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
[ Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
linkify Text
"Documentation" (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mdoc
, Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
linkify Text
"Source" (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
msrc
]
where linkify :: a -> a -> a
linkify a
title a
uri = a
"[" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
title a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"](" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
uri a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
spanDocToMarkdownForTest :: String -> String
spanDocToMarkdownForTest :: ShowS
spanDocToMarkdownForTest
= DocH [Char] [Char] -> [Char]
haddockToMarkdown (DocH [Char] [Char] -> [Char])
-> ([Char] -> DocH [Char] [Char]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocH [Char] Identifier -> DocH [Char] [Char]
forall mod. DocH mod Identifier -> DocH mod [Char]
H.toRegular (DocH [Char] Identifier -> DocH [Char] [Char])
-> ([Char] -> DocH [Char] Identifier)
-> [Char]
-> DocH [Char] [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaDoc [Char] Identifier -> DocH [Char] Identifier
forall mod id. MetaDoc mod id -> DocH mod id
H._doc (MetaDoc [Char] Identifier -> DocH [Char] Identifier)
-> ([Char] -> MetaDoc [Char] Identifier)
-> [Char]
-> DocH [Char] Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char] -> [Char] -> MetaDoc [Char] Identifier
forall mod. Maybe [Char] -> [Char] -> MetaDoc mod Identifier
H.parseParas Maybe [Char]
forall a. Maybe a
Nothing
haddockToMarkdown
:: H.DocH String String -> String
haddockToMarkdown :: DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
H.DocEmpty
= [Char]
""
haddockToMarkdown (H.DocAppend DocH [Char] [Char]
d1 DocH [Char] [Char]
d2)
= DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
d1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
d2
haddockToMarkdown (H.DocString [Char]
s)
= ShowS
escapeBackticks [Char]
s
haddockToMarkdown (H.DocParagraph DocH [Char] [Char]
p)
= [Char]
"\n\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
p
haddockToMarkdown (H.DocIdentifier [Char]
i)
= [Char]
"`" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"`"
haddockToMarkdown (H.DocIdentifierUnchecked [Char]
i)
= [Char]
"`" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"`"
#if MIN_VERSION_haddock_library(1,10,0)
haddockToMarkdown (H.DocModule (H.ModLink [Char]
i Maybe (DocH [Char] [Char])
Nothing))
= [Char]
"`" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeBackticks [Char]
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"`"
haddockToMarkdown (H.DocModule (H.ModLink [Char]
i (Just DocH [Char] [Char]
label)))
= DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
label [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" ( `" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeBackticks [Char]
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"` )"
#else
haddockToMarkdown (H.DocModule i)
= "`" ++ escapeBackticks i ++ "`"
#endif
haddockToMarkdown (H.DocWarning DocH [Char] [Char]
w)
= DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
w
haddockToMarkdown (H.DocEmphasis DocH [Char] [Char]
d)
= [Char]
"*" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"*"
haddockToMarkdown (H.DocBold DocH [Char] [Char]
d)
= [Char]
"**" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"**"
haddockToMarkdown (H.DocMonospaced DocH [Char] [Char]
d)
= [Char]
"`" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
removeUnescapedBackticks (DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
d) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"`"
haddockToMarkdown (H.DocCodeBlock DocH [Char] [Char]
d)
= [Char]
"\n```haskell\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n```\n"
haddockToMarkdown (H.DocExamples [Example]
es)
= [Char]
"\n```haskell\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines ((Example -> [Char]) -> [Example] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Example -> [Char]
exampleToMarkdown [Example]
es) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n```\n"
where
exampleToMarkdown :: Example -> [Char]
exampleToMarkdown (H.Example [Char]
expr [[Char]]
result)
= [Char]
">>> " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
expr [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines [[Char]]
result
haddockToMarkdown (H.DocHyperlink (H.Hyperlink [Char]
url Maybe (DocH [Char] [Char])
Nothing))
= [Char]
"<" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
url [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">"
haddockToMarkdown (H.DocHyperlink (H.Hyperlink [Char]
url (Just DocH [Char] [Char]
label)))
= [Char]
"[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
label [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"](" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
url [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
haddockToMarkdown (H.DocPic (H.Picture [Char]
url Maybe [Char]
Nothing))
= [Char]
"![](" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
url [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
haddockToMarkdown (H.DocPic (H.Picture [Char]
url (Just [Char]
label)))
= [Char]
"![" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
label [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"](" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
url [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
haddockToMarkdown (H.DocAName [Char]
aname)
= [Char]
"[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeBackticks [Char]
aname [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]:"
haddockToMarkdown (H.DocHeader (H.Header Int
level DocH [Char] [Char]
title))
= Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
level Char
'#' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
title
haddockToMarkdown (H.DocUnorderedList [DocH [Char] [Char]]
things)
= Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: ([[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (DocH [Char] [Char] -> [Char]) -> [DocH [Char] [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char]
"+ " ++) ShowS
-> (DocH [Char] [Char] -> [Char]) -> DocH [Char] [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trimStart ShowS
-> (DocH [Char] [Char] -> [Char]) -> DocH [Char] [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
splitForList ShowS
-> (DocH [Char] [Char] -> [Char]) -> DocH [Char] [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocH [Char] [Char] -> [Char]
haddockToMarkdown) [DocH [Char] [Char]]
things)
haddockToMarkdown (H.DocOrderedList [(Int, DocH [Char] [Char])]
things) =
#if MIN_VERSION_haddock_library(1,11,0)
Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: ([[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Int, DocH [Char] [Char]) -> [Char])
-> [(Int, DocH [Char] [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((\(Int
num, [Char]
str) -> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
num [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
". " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
str) ((Int, [Char]) -> [Char])
-> ((Int, DocH [Char] [Char]) -> (Int, [Char]))
-> (Int, DocH [Char] [Char])
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocH [Char] [Char] -> [Char])
-> (Int, DocH [Char] [Char]) -> (Int, [Char])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (ShowS
trimStart ShowS
-> (DocH [Char] [Char] -> [Char]) -> DocH [Char] [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
splitForList ShowS
-> (DocH [Char] [Char] -> [Char]) -> DocH [Char] [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocH [Char] [Char] -> [Char]
haddockToMarkdown)) [(Int, DocH [Char] [Char])]
things)
#else
'\n' : (unlines $ map (("1. " ++) . trimStart . splitForList . haddockToMarkdown) things)
#endif
haddockToMarkdown (H.DocDefList [(DocH [Char] [Char], DocH [Char] [Char])]
things)
= Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: ([[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((DocH [Char] [Char], DocH [Char] [Char]) -> [Char])
-> [(DocH [Char] [Char], DocH [Char] [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(DocH [Char] [Char]
term, DocH [Char] [Char]
defn) -> [Char]
"+ **" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
term [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"**: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DocH [Char] [Char] -> [Char]
haddockToMarkdown DocH [Char] [Char]
defn) [(DocH [Char] [Char], DocH [Char] [Char])]
things)
haddockToMarkdown (H.DocMathInline [Char]
_)
= [Char]
"*cannot render inline math formula*"
haddockToMarkdown (H.DocMathDisplay [Char]
_)
= [Char]
"\n\n*cannot render display math formula*\n\n"
haddockToMarkdown (H.DocTable Table (DocH [Char] [Char])
_t)
= [Char]
"\n\n*tables are not yet supported*\n\n"
haddockToMarkdown (H.DocProperty [Char]
_)
= [Char]
""
escapeBackticks :: String -> String
escapeBackticks :: ShowS
escapeBackticks [Char]
"" = [Char]
""
escapeBackticks (Char
'`':[Char]
ss) = Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'`'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escapeBackticks [Char]
ss
escapeBackticks (Char
s :[Char]
ss) = Char
sChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escapeBackticks [Char]
ss
removeUnescapedBackticks :: String -> String
removeUnescapedBackticks :: ShowS
removeUnescapedBackticks = \case
Char
'\\' : Char
'`' : [Char]
ss -> Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'`' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
removeUnescapedBackticks [Char]
ss
Char
'`' : [Char]
ss -> ShowS
removeUnescapedBackticks [Char]
ss
[Char]
"" -> [Char]
""
Char
s : [Char]
ss -> Char
s Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
removeUnescapedBackticks [Char]
ss
splitForList :: String -> String
splitForList :: ShowS
splitForList [Char]
s
= case [Char] -> [[Char]]
lines [Char]
s of
[] -> [Char]
""
([Char]
first:[[Char]]
rest) -> [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
first [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char]
" " ++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trimStart) [[Char]]
rest