module Language.PureScript.Docs.Convert.Single
( convertSingleModule
, convertComments
) where
import Protolude hiding (moduleName)
import Control.Category ((>>>))
import Data.Text qualified as T
import Language.PureScript.Docs.Types (ChildDeclaration(..), ChildDeclarationInfo(..), Declaration(..), DeclarationInfo(..), KindInfo(..), Module(..), Type', convertFundepsToStrings, isType, isTypeClass)
import Language.PureScript.AST qualified as P
import Language.PureScript.Comments qualified as P
import Language.PureScript.Crash qualified as P
import Language.PureScript.Names qualified as P
import Language.PureScript.Roles qualified as P
import Language.PureScript.Types qualified as P
convertSingleModule :: P.Module -> Module
convertSingleModule :: Module -> Module
convertSingleModule m :: Module
m@(P.Module SourceSpan
_ [Comment]
coms ModuleName
moduleName [Declaration]
_ Maybe [DeclarationRef]
_) =
ModuleName
-> Maybe Text
-> [Declaration]
-> [(InPackage ModuleName, [Declaration])]
-> Module
Module ModuleName
moduleName Maybe Text
comments (Module -> [Declaration]
declarations Module
m) []
where
comments :: Maybe Text
comments = [Comment] -> Maybe Text
convertComments [Comment]
coms
declarations :: Module -> [Declaration]
declarations =
Module -> [Declaration]
P.exportedDeclarations
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Declaration
d -> Declaration -> Maybe Text
getDeclarationTitle Declaration
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Declaration -> Text -> Maybe IntermediateDeclaration
convertDeclaration Declaration
d)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [IntermediateDeclaration] -> [Declaration]
augmentDeclarations
data AugmentType
= AugmentClass
| AugmentType
type IntermediateDeclaration
= Either ([(Text, AugmentType)], DeclarationAugment) Declaration
data DeclarationAugment
= AugmentChild ChildDeclaration
| AugmentKindSig KindSignatureInfo
| AugmentRole (Maybe Text) [P.Role]
data KindSignatureInfo = KindSignatureInfo
{ :: Maybe Text
, KindSignatureInfo -> KindSignatureFor
ksiKeyword :: P.KindSignatureFor
, KindSignatureInfo -> Type'
ksiKind :: Type'
}
augmentDeclarations :: [IntermediateDeclaration] -> [Declaration]
augmentDeclarations :: [IntermediateDeclaration] -> [Declaration]
augmentDeclarations (forall a b. [Either a b] -> ([a], [b])
partitionEithers -> ([([(Text, AugmentType)], DeclarationAugment)]
augments, [Declaration]
toplevels)) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {f :: * -> *} {t :: * -> *}.
(Functor f, Foldable t) =>
f Declaration
-> (t (Text, AugmentType), DeclarationAugment) -> f Declaration
go [Declaration]
toplevels [([(Text, AugmentType)], DeclarationAugment)]
augments
where
go :: f Declaration
-> (t (Text, AugmentType), DeclarationAugment) -> f Declaration
go f Declaration
ds (t (Text, AugmentType)
parentTitles, DeclarationAugment
a) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Declaration
d ->
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Declaration -> (Text, AugmentType) -> Bool
matches Declaration
d) t (Text, AugmentType)
parentTitles
then DeclarationAugment -> Declaration -> Declaration
augmentWith DeclarationAugment
a Declaration
d
else Declaration
d) f Declaration
ds
matches :: Declaration -> (Text, AugmentType) -> Bool
matches Declaration
d (Text
name, AugmentType
AugmentType) = Declaration -> Bool
isType Declaration
d Bool -> Bool -> Bool
&& Declaration -> Text
declTitle Declaration
d forall a. Eq a => a -> a -> Bool
== Text
name
matches Declaration
d (Text
name, AugmentType
AugmentClass) = Declaration -> Bool
isTypeClass Declaration
d Bool -> Bool -> Bool
&& Declaration -> Text
declTitle Declaration
d forall a. Eq a => a -> a -> Bool
== Text
name
augmentWith :: DeclarationAugment -> Declaration -> Declaration
augmentWith (AugmentChild ChildDeclaration
child) Declaration
d =
Declaration
d { declChildren :: [ChildDeclaration]
declChildren = Declaration -> [ChildDeclaration]
declChildren Declaration
d forall a. [a] -> [a] -> [a]
++ [ChildDeclaration
child] }
augmentWith (AugmentKindSig KindSignatureInfo{Maybe Text
Type'
KindSignatureFor
ksiKind :: Type'
ksiKeyword :: KindSignatureFor
ksiComments :: Maybe Text
ksiKind :: KindSignatureInfo -> Type'
ksiKeyword :: KindSignatureInfo -> KindSignatureFor
ksiComments :: KindSignatureInfo -> Maybe Text
..}) Declaration
d =
Declaration
d { declComments :: Maybe Text
declComments = Maybe Text -> Maybe Text -> Maybe Text
mergeComments Maybe Text
ksiComments forall a b. (a -> b) -> a -> b
$ Declaration -> Maybe Text
declComments Declaration
d
, declKind :: Maybe KindInfo
declKind = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ KindInfo { kiKeyword :: KindSignatureFor
kiKeyword = KindSignatureFor
ksiKeyword, kiKind :: Type'
kiKind = Type'
ksiKind }
}
augmentWith (AugmentRole Maybe Text
comms [Role]
roles) Declaration
d =
Declaration
d { declComments :: Maybe Text
declComments = Maybe Text -> Maybe Text -> Maybe Text
mergeComments (Declaration -> Maybe Text
declComments Declaration
d) Maybe Text
comms
, declInfo :: DeclarationInfo
declInfo = DeclarationInfo
insertRoles
}
where
insertRoles :: DeclarationInfo
insertRoles = case Declaration -> DeclarationInfo
declInfo Declaration
d of
DataDeclaration DataDeclType
dataDeclType [(Text, Maybe Type')]
args [] ->
DataDeclType -> [(Text, Maybe Type')] -> [Role] -> DeclarationInfo
DataDeclaration DataDeclType
dataDeclType [(Text, Maybe Type')]
args [Role]
roles
DataDeclaration DataDeclType
_ [(Text, Maybe Type')]
_ [Role]
_ ->
forall a. HasCallStack => String -> a
P.internalError String
"augmentWith: could not add a second role declaration to a data declaration"
ExternDataDeclaration Type'
kind [] ->
Type' -> [Role] -> DeclarationInfo
ExternDataDeclaration Type'
kind [Role]
roles
ExternDataDeclaration Type'
_ [Role]
_ ->
forall a. HasCallStack => String -> a
P.internalError String
"augmentWith: could not add a second role declaration to an FFI declaration"
DeclarationInfo
_ -> forall a. HasCallStack => String -> a
P.internalError String
"augmentWith: could not add role to declaration"
mergeComments :: Maybe Text -> Maybe Text -> Maybe Text
mergeComments :: Maybe Text -> Maybe Text -> Maybe Text
mergeComments Maybe Text
Nothing Maybe Text
bot = Maybe Text
bot
mergeComments Maybe Text
top Maybe Text
Nothing = Maybe Text
top
mergeComments (Just Text
topComs) (Just Text
bottomComs) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
topComs forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
bottomComs
getDeclarationTitle :: P.Declaration -> Maybe Text
getDeclarationTitle :: Declaration -> Maybe Text
getDeclarationTitle (P.ValueDeclaration ValueDeclarationData [GuardedExpr]
vd) = forall a. a -> Maybe a
Just (Ident -> Text
P.showIdent (forall a. ValueDeclarationData a -> Ident
P.valdeclIdent ValueDeclarationData [GuardedExpr]
vd))
getDeclarationTitle (P.ExternDeclaration SourceAnn
_ Ident
name SourceType
_) = forall a. a -> Maybe a
Just (Ident -> Text
P.showIdent Ident
name)
getDeclarationTitle (P.DataDeclaration SourceAnn
_ DataDeclType
_ ProperName 'TypeName
name [(Text, Maybe SourceType)]
_ [DataConstructorDeclaration]
_) = forall a. a -> Maybe a
Just (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'TypeName
name)
getDeclarationTitle (P.ExternDataDeclaration SourceAnn
_ ProperName 'TypeName
name SourceType
_) = forall a. a -> Maybe a
Just (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'TypeName
name)
getDeclarationTitle (P.TypeSynonymDeclaration SourceAnn
_ ProperName 'TypeName
name [(Text, Maybe SourceType)]
_ SourceType
_) = forall a. a -> Maybe a
Just (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'TypeName
name)
getDeclarationTitle (P.TypeClassDeclaration SourceAnn
_ ProperName 'ClassName
name [(Text, Maybe SourceType)]
_ [SourceConstraint]
_ [FunctionalDependency]
_ [Declaration]
_) = forall a. a -> Maybe a
Just (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'ClassName
name)
getDeclarationTitle (P.TypeInstanceDeclaration SourceAnn
_ SourceAnn
_ ChainId
_ Integer
_ Either Text Ident
name [SourceConstraint]
_ Qualified (ProperName 'ClassName)
_ [SourceType]
_ TypeInstanceBody
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Text
"<anonymous>") Ident -> Text
P.showIdent Either Text Ident
name
getDeclarationTitle (P.TypeFixityDeclaration SourceAnn
_ Fixity
_ Qualified (ProperName 'TypeName)
_ OpName 'TypeOpName
op) = forall a. a -> Maybe a
Just (Text
"type " forall a. Semigroup a => a -> a -> a
<> forall (a :: OpNameType). OpName a -> Text
P.showOp OpName 'TypeOpName
op)
getDeclarationTitle (P.ValueFixityDeclaration SourceAnn
_ Fixity
_ Qualified (Either Ident (ProperName 'ConstructorName))
_ OpName 'ValueOpName
op) = forall a. a -> Maybe a
Just (forall (a :: OpNameType). OpName a -> Text
P.showOp OpName 'ValueOpName
op)
getDeclarationTitle (P.KindDeclaration SourceAnn
_ KindSignatureFor
_ ProperName 'TypeName
n SourceType
_) = forall a. a -> Maybe a
Just (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'TypeName
n)
getDeclarationTitle (P.RoleDeclaration P.RoleDeclarationData{[Role]
SourceAnn
ProperName 'TypeName
rdeclRoles :: RoleDeclarationData -> [Role]
rdeclIdent :: RoleDeclarationData -> ProperName 'TypeName
rdeclSourceAnn :: RoleDeclarationData -> SourceAnn
rdeclRoles :: [Role]
rdeclIdent :: ProperName 'TypeName
rdeclSourceAnn :: SourceAnn
..}) = forall a. a -> Maybe a
Just (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'TypeName
rdeclIdent)
getDeclarationTitle Declaration
_ = forall a. Maybe a
Nothing
mkDeclaration :: P.SourceAnn -> Text -> DeclarationInfo -> Declaration
mkDeclaration :: SourceAnn -> Text -> DeclarationInfo -> Declaration
mkDeclaration (SourceSpan
ss, [Comment]
com) Text
title DeclarationInfo
info =
Declaration { declTitle :: Text
declTitle = Text
title
, declComments :: Maybe Text
declComments = [Comment] -> Maybe Text
convertComments [Comment]
com
, declSourceSpan :: Maybe SourceSpan
declSourceSpan = forall a. a -> Maybe a
Just SourceSpan
ss
, declChildren :: [ChildDeclaration]
declChildren = []
, declInfo :: DeclarationInfo
declInfo = DeclarationInfo
info
, declKind :: Maybe KindInfo
declKind = forall a. Maybe a
Nothing
}
basicDeclaration :: P.SourceAnn -> Text -> DeclarationInfo -> Maybe IntermediateDeclaration
basicDeclaration :: SourceAnn
-> Text -> DeclarationInfo -> Maybe IntermediateDeclaration
basicDeclaration SourceAnn
sa Text
title = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceAnn -> Text -> DeclarationInfo -> Declaration
mkDeclaration SourceAnn
sa Text
title
convertDeclaration :: P.Declaration -> Text -> Maybe IntermediateDeclaration
convertDeclaration :: Declaration -> Text -> Maybe IntermediateDeclaration
convertDeclaration (P.ValueDecl SourceAnn
sa Ident
_ NameKind
_ [Binder]
_ [P.MkUnguarded (P.TypedValue Bool
_ Expr
_ SourceType
ty)]) Text
title =
SourceAnn
-> Text -> DeclarationInfo -> Maybe IntermediateDeclaration
basicDeclaration SourceAnn
sa Text
title (Type' -> DeclarationInfo
ValueDeclaration (SourceType
ty forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()))
convertDeclaration (P.ValueDecl SourceAnn
sa Ident
_ NameKind
_ [Binder]
_ [GuardedExpr]
_) Text
title =
SourceAnn
-> Text -> DeclarationInfo -> Maybe IntermediateDeclaration
basicDeclaration SourceAnn
sa Text
title (Type' -> DeclarationInfo
ValueDeclaration (forall a. a -> WildcardData -> Type a
P.TypeWildcard () WildcardData
P.UnnamedWildcard))
convertDeclaration (P.ExternDeclaration SourceAnn
sa Ident
_ SourceType
ty) Text
title =
SourceAnn
-> Text -> DeclarationInfo -> Maybe IntermediateDeclaration
basicDeclaration SourceAnn
sa Text
title (Type' -> DeclarationInfo
ValueDeclaration (SourceType
ty forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()))
convertDeclaration (P.DataDeclaration SourceAnn
sa DataDeclType
dtype ProperName 'TypeName
_ [(Text, Maybe SourceType)]
args [DataConstructorDeclaration]
ctors) Text
title =
forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (SourceAnn -> Text -> DeclarationInfo -> Declaration
mkDeclaration SourceAnn
sa Text
title DeclarationInfo
info) { declChildren :: [ChildDeclaration]
declChildren = [ChildDeclaration]
children })
where
info :: DeclarationInfo
info = DataDeclType -> [(Text, Maybe Type')] -> [Role] -> DeclarationInfo
DataDeclaration DataDeclType
dtype (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()))) [(Text, Maybe SourceType)]
args) []
children :: [ChildDeclaration]
children = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map DataConstructorDeclaration -> ChildDeclaration
convertCtor [DataConstructorDeclaration]
ctors
convertCtor :: P.DataConstructorDeclaration -> ChildDeclaration
convertCtor :: DataConstructorDeclaration -> ChildDeclaration
convertCtor P.DataConstructorDeclaration{[(Ident, SourceType)]
SourceAnn
ProperName 'ConstructorName
dataCtorFields :: DataConstructorDeclaration -> [(Ident, SourceType)]
dataCtorName :: DataConstructorDeclaration -> ProperName 'ConstructorName
dataCtorAnn :: DataConstructorDeclaration -> SourceAnn
dataCtorFields :: [(Ident, SourceType)]
dataCtorName :: ProperName 'ConstructorName
dataCtorAnn :: SourceAnn
..} =
let (SourceSpan
sourceSpan, [Comment]
comments) = SourceAnn
dataCtorAnn
in Text
-> Maybe Text
-> Maybe SourceSpan
-> ChildDeclarationInfo
-> ChildDeclaration
ChildDeclaration (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'ConstructorName
dataCtorName) ([Comment] -> Maybe Text
convertComments [Comment]
comments) (forall a. a -> Maybe a
Just SourceSpan
sourceSpan) ([Type'] -> ChildDeclarationInfo
ChildDataConstructor (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Ident, SourceType)]
dataCtorFields))
convertDeclaration (P.ExternDataDeclaration SourceAnn
sa ProperName 'TypeName
_ SourceType
kind') Text
title =
SourceAnn
-> Text -> DeclarationInfo -> Maybe IntermediateDeclaration
basicDeclaration SourceAnn
sa Text
title (Type' -> [Role] -> DeclarationInfo
ExternDataDeclaration (SourceType
kind' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) [])
convertDeclaration (P.TypeSynonymDeclaration SourceAnn
sa ProperName 'TypeName
_ [(Text, Maybe SourceType)]
args SourceType
ty) Text
title =
SourceAnn
-> Text -> DeclarationInfo -> Maybe IntermediateDeclaration
basicDeclaration SourceAnn
sa Text
title ([(Text, Maybe Type')] -> Type' -> DeclarationInfo
TypeSynonymDeclaration (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()))) [(Text, Maybe SourceType)]
args) (SourceType
ty forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()))
convertDeclaration (P.TypeClassDeclaration SourceAnn
sa ProperName 'ClassName
_ [(Text, Maybe SourceType)]
args [SourceConstraint]
implies [FunctionalDependency]
fundeps [Declaration]
ds) Text
title =
forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (SourceAnn -> Text -> DeclarationInfo -> Declaration
mkDeclaration SourceAnn
sa Text
title DeclarationInfo
info) { declChildren :: [ChildDeclaration]
declChildren = [ChildDeclaration]
children })
where
args' :: [(Text, Maybe Type')]
args' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()))) [(Text, Maybe SourceType)]
args
info :: DeclarationInfo
info = [(Text, Maybe Type')]
-> [Constraint'] -> [([Text], [Text])] -> DeclarationInfo
TypeClassDeclaration [(Text, Maybe Type')]
args' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) [SourceConstraint]
implies) ([(Text, Maybe Type')]
-> [FunctionalDependency] -> [([Text], [Text])]
convertFundepsToStrings [(Text, Maybe Type')]
args' [FunctionalDependency]
fundeps)
children :: [ChildDeclaration]
children = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Declaration -> ChildDeclaration
convertClassMember [Declaration]
ds
convertClassMember :: Declaration -> ChildDeclaration
convertClassMember (P.TypeDeclaration (P.TypeDeclarationData (SourceSpan
ss, [Comment]
com) Ident
ident' SourceType
ty)) =
Text
-> Maybe Text
-> Maybe SourceSpan
-> ChildDeclarationInfo
-> ChildDeclaration
ChildDeclaration (Ident -> Text
P.showIdent Ident
ident') ([Comment] -> Maybe Text
convertComments [Comment]
com) (forall a. a -> Maybe a
Just SourceSpan
ss) (Type' -> ChildDeclarationInfo
ChildTypeClassMember (SourceType
ty forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()))
convertClassMember Declaration
_ =
forall a. HasCallStack => String -> a
P.internalError String
"convertDeclaration: Invalid argument to convertClassMember."
convertDeclaration (P.TypeInstanceDeclaration (SourceSpan
ss, [Comment]
com) SourceAnn
_ ChainId
_ Integer
_ Either Text Ident
_ [SourceConstraint]
constraints Qualified (ProperName 'ClassName)
className [SourceType]
tys TypeInstanceBody
_) Text
title =
forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left ((Text
classNameString, AugmentType
AugmentClass) forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (, AugmentType
AugmentType) [Text]
typeNameStrings, ChildDeclaration -> DeclarationAugment
AugmentChild ChildDeclaration
childDecl))
where
classNameString :: Text
classNameString = forall {a :: ProperNameType}. Qualified (ProperName a) -> Text
unQual Qualified (ProperName 'ClassName)
className
typeNameStrings :: [Text]
typeNameStrings = forall a. Ord a => [a] -> [a]
ordNub (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall r a. (r -> r -> r) -> (Type a -> r) -> Type a -> r
P.everythingOnTypes forall a. [a] -> [a] -> [a]
(++) forall {a}. Type a -> [Text]
extractProperNames) [SourceType]
tys)
unQual :: Qualified (ProperName a) -> Text
unQual Qualified (ProperName a)
x = let (P.Qualified QualifiedBy
_ ProperName a
y) = Qualified (ProperName a)
x in forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName a
y
extractProperNames :: Type a -> [Text]
extractProperNames (P.TypeConstructor a
_ Qualified (ProperName 'TypeName)
n) = [forall {a :: ProperNameType}. Qualified (ProperName a) -> Text
unQual Qualified (ProperName 'TypeName)
n]
extractProperNames Type a
_ = []
childDecl :: ChildDeclaration
childDecl = Text
-> Maybe Text
-> Maybe SourceSpan
-> ChildDeclarationInfo
-> ChildDeclaration
ChildDeclaration Text
title ([Comment] -> Maybe Text
convertComments [Comment]
com) (forall a. a -> Maybe a
Just SourceSpan
ss) ([Constraint'] -> Type' -> ChildDeclarationInfo
ChildInstance (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) [SourceConstraint]
constraints) (SourceType
classApp forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()))
classApp :: SourceType
classApp = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SourceType -> SourceType -> SourceType
P.srcTypeApp (Qualified (ProperName 'TypeName) -> SourceType
P.srcTypeConstructor (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
P.coerceProperName Qualified (ProperName 'ClassName)
className)) [SourceType]
tys
convertDeclaration (P.ValueFixityDeclaration SourceAnn
sa Fixity
fixity (P.Qualified QualifiedBy
mn Either Ident (ProperName 'ConstructorName)
alias) OpName 'ValueOpName
_) Text
title =
forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SourceAnn -> Text -> DeclarationInfo -> Declaration
mkDeclaration SourceAnn
sa Text
title (Fixity -> FixityAlias -> DeclarationInfo
AliasDeclaration Fixity
fixity (forall a. QualifiedBy -> a -> Qualified a
P.Qualified QualifiedBy
mn (forall a b. b -> Either a b
Right Either Ident (ProperName 'ConstructorName)
alias)))
convertDeclaration (P.TypeFixityDeclaration SourceAnn
sa Fixity
fixity (P.Qualified QualifiedBy
mn ProperName 'TypeName
alias) OpName 'TypeOpName
_) Text
title =
forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SourceAnn -> Text -> DeclarationInfo -> Declaration
mkDeclaration SourceAnn
sa Text
title (Fixity -> FixityAlias -> DeclarationInfo
AliasDeclaration Fixity
fixity (forall a. QualifiedBy -> a -> Qualified a
P.Qualified QualifiedBy
mn (forall a b. a -> Either a b
Left ProperName 'TypeName
alias)))
convertDeclaration (P.KindDeclaration SourceAnn
sa KindSignatureFor
keyword ProperName 'TypeName
_ SourceType
kind) Text
title =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ([(Text
title, AugmentType
AugmentType), (Text
title, AugmentType
AugmentClass)], KindSignatureInfo -> DeclarationAugment
AugmentKindSig KindSignatureInfo
ksi)
where
comms :: Maybe Text
comms = [Comment] -> Maybe Text
convertComments forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd SourceAnn
sa
ksi :: KindSignatureInfo
ksi = KindSignatureInfo { ksiComments :: Maybe Text
ksiComments = Maybe Text
comms, ksiKeyword :: KindSignatureFor
ksiKeyword = KindSignatureFor
keyword, ksiKind :: Type'
ksiKind = SourceType
kind forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> () }
convertDeclaration (P.RoleDeclaration P.RoleDeclarationData{[Role]
SourceAnn
ProperName 'TypeName
rdeclRoles :: [Role]
rdeclIdent :: ProperName 'TypeName
rdeclSourceAnn :: SourceAnn
rdeclRoles :: RoleDeclarationData -> [Role]
rdeclIdent :: RoleDeclarationData -> ProperName 'TypeName
rdeclSourceAnn :: RoleDeclarationData -> SourceAnn
..}) Text
title =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ([(Text
title, AugmentType
AugmentType)], Maybe Text -> [Role] -> DeclarationAugment
AugmentRole Maybe Text
comms [Role]
rdeclRoles)
where
comms :: Maybe Text
comms = [Comment] -> Maybe Text
convertComments forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd SourceAnn
rdeclSourceAnn
convertDeclaration Declaration
_ Text
_ = forall a. Maybe a
Nothing
convertComments :: [P.Comment] -> Maybe Text
[Comment]
cs = do
let raw :: [Text]
raw = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Comment -> [Text]
toLines [Comment]
cs
let docs :: [Text]
docs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Text
stripPipe [Text]
raw
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
docs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Text
T.unlines [Text]
docs)
where
toLines :: Comment -> [Text]
toLines (P.LineComment Text
s) = [Text
s]
toLines (P.BlockComment Text
s) = Text -> [Text]
T.lines Text
s
stripPipe :: Text -> Maybe Text
stripPipe =
(Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ')
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> Text -> Maybe Text
T.stripPrefix Text
"|"
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
dropPrefix Text
" ")
dropPrefix :: Text -> Text -> Text
dropPrefix Text
prefix Text
str =
forall a. a -> Maybe a -> a
fromMaybe Text
str (Text -> Text -> Maybe Text
T.stripPrefix Text
prefix Text
str)