module Language.PureScript.Docs.Convert.Single
  ( convertSingleModule
  , convertComments
  ) where

import Protolude hiding (moduleName)

import Control.Category ((>>>))

import qualified Data.Text as T

import Language.PureScript.Docs.Types

import qualified Language.PureScript.AST as P
import qualified Language.PureScript.Comments as P
import qualified Language.PureScript.Crash as P
import qualified Language.PureScript.Names as P
import qualified Language.PureScript.Roles as P
import qualified Language.PureScript.Types as P

-- |
-- Convert a single Module, but ignore re-exports; any re-exported types or
-- values will not appear in the result.
--
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

-- | Different declarations we can augment
data AugmentType
  = AugmentClass
  -- ^ Augment documentation for a type class
  | AugmentType
  -- ^ Augment documentation for a type constructor

-- | The data type for an intermediate stage which we go through during
-- converting.
--
-- In the first pass, we take all top level declarations in the module, and
-- collect other information which will later be used to augment the top level
-- declarations. These two situation correspond to the Right and Left
-- constructors, respectively.
--
-- In the second pass, we go over all of the Left values and augment the
-- relevant declarations, leaving only the augmented Right values.
--
-- Note that in the Left case, we provide a [Text] as well as augment
-- information. The [Text] value should be a list of titles of declarations
-- that the augmentation should apply to. For example, for a type instance
-- declaration, that would be any types or type classes mentioned in the
-- instance. For a fixity declaration, it would be just the relevant operator's
-- name.
type IntermediateDeclaration
  = Either ([(Text, AugmentType)], DeclarationAugment) Declaration

-- | Some data which will be used to augment a Declaration in the
-- output.
--
-- The AugmentChild constructor allows us to move all children under their
-- respective parents. It is only necessary for type instance declarations,
-- since they appear at the top level in the AST, and since they might need to
-- appear as children in two places (for example, if a data type defined in a
-- module is an instance of a type class also defined in that module).
--
-- The AugmentKindSig constructor allows us to add a kind signature
-- to its corresponding declaration. Comments for both declarations
-- are also merged together.
data DeclarationAugment
  = AugmentChild ChildDeclaration
  | AugmentKindSig KindSignatureInfo
  | AugmentRole (Maybe Text) [P.Role]

data KindSignatureInfo = KindSignatureInfo
  { KindSignatureInfo -> Maybe Text
ksiComments :: Maybe Text
  , KindSignatureInfo -> KindSignatureFor
ksiKeyword :: P.KindSignatureFor
  , KindSignatureInfo -> Type'
ksiKind :: Type'
  }

-- | Augment top-level declarations; the second pass. See the comments under
-- the type synonym IntermediateDeclaration for more information.
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

-- | Create a basic Declaration value.
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 -- TODO: make this non-optional when we next break the format
              , declChildren :: [ChildDeclaration]
declChildren   = []
              , declInfo :: DeclarationInfo
declInfo       = DeclarationInfo
info
              , declKind :: Maybe KindInfo
declKind       = forall a. Maybe a
Nothing -- kind sigs are added in augment pass
              }

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 =
  -- If no explicit type declaration was provided, insert a wildcard, so that
  -- the actual type will be added during type checking.
  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
convertComments :: [Comment] -> Maybe Text
convertComments [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)