module Language.PureScript.Docs.AsMarkdown
( Docs
, runDocs
, moduleAsMarkdown
, codeToString
) where
import Prelude
import Control.Monad (unless, zipWithM_)
import Control.Monad.Writer (Writer, tell, execWriter)
import Data.Foldable (for_)
import Data.List (partition)
import Data.Text (Text)
import qualified Data.Text as T
import Language.PureScript.Docs.RenderedCode
import Language.PureScript.Docs.Types
import qualified Language.PureScript as P
import qualified Language.PureScript.Docs.Render as Render
moduleAsMarkdown :: Module -> Docs
moduleAsMarkdown :: Module -> Docs
moduleAsMarkdown Module{[(InPackage ModuleName, [Declaration])]
[Declaration]
Maybe Text
ModuleName
modReExports :: Module -> [(InPackage ModuleName, [Declaration])]
modDeclarations :: Module -> [Declaration]
modComments :: Module -> Maybe Text
modName :: Module -> ModuleName
modReExports :: [(InPackage ModuleName, [Declaration])]
modDeclarations :: [Declaration]
modComments :: Maybe Text
modName :: ModuleName
..} = do
Int -> Text -> Docs
headerLevel Int
2 forall a b. (a -> b) -> a -> b
$ Text
"Module " forall a. Semigroup a => a -> a -> a
<> ModuleName -> Text
P.runModuleName ModuleName
modName
Docs
spacer
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Text
modComments Text -> Docs
tell'
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Declaration -> Docs
declAsMarkdown [Declaration]
modDeclarations
Docs
spacer
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(InPackage ModuleName, [Declaration])]
modReExports forall a b. (a -> b) -> a -> b
$ \(InPackage ModuleName
mn', [Declaration]
decls) -> do
let mn :: ModuleName
mn = forall a. InPackage a -> a
ignorePackage InPackage ModuleName
mn'
Int -> Text -> Docs
headerLevel Int
3 forall a b. (a -> b) -> a -> b
$ Text
"Re-exported from " forall a. Semigroup a => a -> a -> a
<> ModuleName -> Text
P.runModuleName ModuleName
mn forall a. Semigroup a => a -> a -> a
<> Text
":"
Docs
spacer
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Declaration -> Docs
declAsMarkdown [Declaration]
decls
declAsMarkdown :: Declaration -> Docs
declAsMarkdown :: Declaration -> Docs
declAsMarkdown decl :: Declaration
decl@Declaration{[ChildDeclaration]
Maybe Text
Maybe SourceSpan
Maybe KindInfo
Text
DeclarationInfo
declKind :: Declaration -> Maybe KindInfo
declInfo :: Declaration -> DeclarationInfo
declChildren :: Declaration -> [ChildDeclaration]
declSourceSpan :: Declaration -> Maybe SourceSpan
declComments :: Declaration -> Maybe Text
declTitle :: Declaration -> Text
declKind :: Maybe KindInfo
declInfo :: DeclarationInfo
declChildren :: [ChildDeclaration]
declSourceSpan :: Maybe SourceSpan
declComments :: Maybe Text
declTitle :: Text
..} = do
Int -> Text -> Docs
headerLevel Int
4 (Text -> Text
ticks Text
declTitle)
Docs
spacer
let ([ChildDeclaration]
instances, [ChildDeclaration]
children) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ChildDeclarationInfo -> Bool
isChildInstance forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChildDeclaration -> ChildDeclarationInfo
cdeclInfo) [ChildDeclaration]
declChildren
Docs -> Docs
fencedBlock forall a b. (a -> b) -> a -> b
$ do
Text -> Docs
tell' (RenderedCode -> Text
codeToString forall a b. (a -> b) -> a -> b
$ Declaration -> RenderedCode
Render.renderDeclaration Declaration
decl)
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\First
f ChildDeclaration
c -> Text -> Docs
tell' (First -> ChildDeclaration -> Text
childToString First
f ChildDeclaration
c)) (First
First forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat First
NotFirst) [ChildDeclaration]
children
Docs
spacer
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Text
declComments Text -> Docs
tell'
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChildDeclaration]
instances) forall a b. (a -> b) -> a -> b
$ do
Int -> Text -> Docs
headerLevel Int
5 Text
"Instances"
Docs -> Docs
fencedBlock forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> Docs
tell' forall b c a. (b -> c) -> (a -> b) -> a -> c
. First -> ChildDeclaration -> Text
childToString First
NotFirst) [ChildDeclaration]
instances
Docs
spacer
where
isChildInstance :: ChildDeclarationInfo -> Bool
isChildInstance (ChildInstance [Constraint']
_ Type'
_) = Bool
True
isChildInstance ChildDeclarationInfo
_ = Bool
False
codeToString :: RenderedCode -> Text
codeToString :: RenderedCode -> Text
codeToString = forall a.
Monoid a =>
(RenderedCodeElement -> a) -> RenderedCode -> a
outputWith RenderedCodeElement -> Text
elemAsMarkdown
where
elemAsMarkdown :: RenderedCodeElement -> Text
elemAsMarkdown (Syntax Text
x) = Text
x
elemAsMarkdown (Keyword Text
x) = Text
x
elemAsMarkdown RenderedCodeElement
Space = Text
" "
elemAsMarkdown (Symbol Namespace
_ Text
x Link
_) = Text
x
elemAsMarkdown (Role Text
_) = Text
""
childToString :: First -> ChildDeclaration -> Text
childToString :: First -> ChildDeclaration -> Text
childToString First
f decl :: ChildDeclaration
decl@ChildDeclaration{Maybe Text
Maybe SourceSpan
Text
ChildDeclarationInfo
cdeclSourceSpan :: ChildDeclaration -> Maybe SourceSpan
cdeclComments :: ChildDeclaration -> Maybe Text
cdeclTitle :: ChildDeclaration -> Text
cdeclInfo :: ChildDeclarationInfo
cdeclSourceSpan :: Maybe SourceSpan
cdeclComments :: Maybe Text
cdeclTitle :: Text
cdeclInfo :: ChildDeclaration -> ChildDeclarationInfo
..} =
case ChildDeclarationInfo
cdeclInfo of
ChildDataConstructor [Type']
_ ->
let c :: Text
c = if First
f forall a. Eq a => a -> a -> Bool
== First
First then Text
"=" else Text
"|"
in Text
" " forall a. Semigroup a => a -> a -> a
<> Text
c forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
str
ChildTypeClassMember Type'
_ ->
Text
" " forall a. Semigroup a => a -> a -> a
<> Text
str
ChildInstance [Constraint']
_ Type'
_ ->
Text
str
where
str :: Text
str = RenderedCode -> Text
codeToString forall a b. (a -> b) -> a -> b
$ ChildDeclaration -> RenderedCode
Render.renderChildDeclaration ChildDeclaration
decl
data First
= First
| NotFirst
deriving (Int -> First -> ShowS
[First] -> ShowS
First -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [First] -> ShowS
$cshowList :: [First] -> ShowS
show :: First -> String
$cshow :: First -> String
showsPrec :: Int -> First -> ShowS
$cshowsPrec :: Int -> First -> ShowS
Show, First -> First -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: First -> First -> Bool
$c/= :: First -> First -> Bool
== :: First -> First -> Bool
$c== :: First -> First -> Bool
Eq, Eq First
First -> First -> Bool
First -> First -> Ordering
First -> First -> First
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: First -> First -> First
$cmin :: First -> First -> First
max :: First -> First -> First
$cmax :: First -> First -> First
>= :: First -> First -> Bool
$c>= :: First -> First -> Bool
> :: First -> First -> Bool
$c> :: First -> First -> Bool
<= :: First -> First -> Bool
$c<= :: First -> First -> Bool
< :: First -> First -> Bool
$c< :: First -> First -> Bool
compare :: First -> First -> Ordering
$ccompare :: First -> First -> Ordering
Ord)
type Docs = Writer [Text] ()
runDocs :: Docs -> Text
runDocs :: Docs -> Text
runDocs = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w a. Writer w a -> w
execWriter
tell' :: Text -> Docs
tell' :: Text -> Docs
tell' = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])
spacer :: Docs
spacer :: Docs
spacer = Text -> Docs
tell' Text
""
headerLevel :: Int -> Text -> Docs
Int
level Text
hdr = Text -> Docs
tell' (Int -> Text -> Text
T.replicate Int
level Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
hdr)
fencedBlock :: Docs -> Docs
fencedBlock :: Docs -> Docs
fencedBlock Docs
inner = do
Text -> Docs
tell' Text
"``` purescript"
Docs
inner
Text -> Docs
tell' Text
"```"
ticks :: Text -> Text
ticks :: Text -> Text
ticks = (Text
"`" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> Text
"`")