Skip to content

Commit 7943881

Browse files
csicarcsicar
committed
references working
1 parent 0cd378e commit 7943881

File tree

2 files changed

+20
-11
lines changed

2 files changed

+20
-11
lines changed

‎src/Language/PureScript/Docs/Convert/Single.hs‎

Lines changed: 13 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ data AugmentType
4141
-- ^ Augment documentation for a type class
4242
| AugmentType
4343
-- ^ Augment documentation for a type constructor
44+
deriving (Show)
4445

4546
-- | The data type for an intermediate stage which we go through during
4647
-- converting.
@@ -82,23 +83,25 @@ augmentDeclarations (partitionEithers -> (augments, toplevels)) =
8283
where
8384
go ds (parentTitles, a) =
8485
map (\d ->
85-
if any (matches d) parentTitles
86-
then augmentWith a d
87-
else d) ds
86+
case find (matches d) (Tr.traceShow (parentTitles) parentTitles) of
87+
Just match -> Tr.traceShow match $ augmentWith match a d
88+
Nothing -> d) ds
8889

8990
matches d (name, AugmentType) = isType d && declTitle d == name
9091
matches d (name, AugmentClass) = isTypeClass d && declTitle d == name
9192

92-
augmentWith (AugmentChild child) d =
93+
augmentWith _ (AugmentChild child) d =
9394
d { declChildren = declChildren d ++ [child] }
94-
augmentWith (AugmentChain chainId instanceChainInfo) d =
95-
d {declChildren = augmentChildInstance chainId instanceChainInfo (declChildren d) }
95+
augmentWith (_, AugmentClass) (AugmentChain chainId instanceChainInfo) d =
96+
d { declChildren = augmentChildInstance chainId instanceChainInfo (declChildren d) }
97+
augmentWith (_, AugmentType) (AugmentChain chainId instanceChainInfo) d =
98+
d { declChildren = declChildren d ++ [ChildDeclaration (titleForInstanceChain chainId) Nothing Nothing (ChildPartOfInstanceChain instanceChainInfo)]}
9699

97-
titleForInstanceChain = T.intercalate " > "
100+
titleForInstanceChain = T.intercalate "-else-"
98101

99102
augmentChildInstance chainId instanceChainInfo [] = [ChildDeclaration (titleForInstanceChain chainId) Nothing Nothing (ChildInstanceChain [instanceChainInfo])]
100103
augmentChildInstance chainId instanceChainInfo (ChildDeclaration name comment span (ChildInstanceChain chain) : rest) =
101-
if traceShow ("compare", chainId, name) (titleForInstanceChain chainId == name) then
104+
if titleForInstanceChain chainId == name then
102105
(ChildDeclaration name comment span (ChildInstanceChain (chain ++ [instanceChainInfo])) : rest)
103106
else
104107
(ChildDeclaration name comment span (ChildInstanceChain chain) : augmentChildInstance chainId instanceChainInfo rest)
@@ -160,7 +163,7 @@ convertDeclaration (P.TypeClassDeclaration sa _ args implies fundeps ds) title =
160163
ChildDeclaration (P.showIdent ident') (convertComments com) (Just ss) (ChildTypeClassMember (ty $> ()))
161164
convertClassMember _ =
162165
P.internalError "convertDeclaration: Invalid argument to convertClassMember."
163-
convertDeclaration (P.TypeInstanceDeclaration (ss, com) instanceChain idx ident constraints className tys _) title =
166+
convertDeclaration (P.TypeInstanceDeclaration (ss, com) instanceChain _ _ constraints className tys _) title =
164167
Just (Left ((classNameString, AugmentClass) : map (, AugmentType) typeNameStrings, AugmentChain (P.runIdent <$> instanceChain) instanceChainDecl))
165168
where
166169
classNameString = unQual className
@@ -170,7 +173,7 @@ convertDeclaration (P.TypeInstanceDeclaration (ss, com) instanceChain idx ident
170173
extractProperNames (P.TypeConstructor _ n) = [unQual n]
171174
extractProperNames _ = []
172175

173-
instanceChainDecl = ChildInstanceChainInfo (Tr.traceShow ("declaration ", title, P.runIdent <$> instanceChain) title) (convertComments com) (Just ss) (fmap ($> ()) constraints) (classApp $> ())
176+
instanceChainDecl = ChildInstanceChainInfo title (convertComments com) (Just ss) (fmap ($> ()) constraints) (classApp $> ())
174177

175178
classApp = foldl' P.srcTypeApp (P.srcTypeConstructor (fmap P.coerceProperName className)) tys
176179
convertDeclaration (P.ValueFixityDeclaration sa fixity (P.Qualified mn alias) _) title =

‎src/Language/PureScript/Docs/Render.hs‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -91,7 +91,7 @@ renderChildDeclaration :: ChildDeclaration -> RenderedChildDeclaration
9191
renderChildDeclaration ChildDeclaration{..} =
9292
traceShowId $ case cdeclInfo of
9393
ChildInstanceChain instances ->
94-
RenderedAsStructure $ renderInstanceChain <$> instances
94+
RenderedAsStructure $ intersperseElse (renderInstanceChain <$> instances)
9595
-- List.intersperse keywordElse $ mintersperse sp <$> renderChildInstance <$> instances
9696
ChildPartOfInstanceChain childInstance ->
9797
RenderedAsCode $ mintersperse sp $ renderChildInstance childInstance
@@ -108,6 +108,12 @@ renderChildDeclaration ChildDeclaration{..} =
108108
]
109109

110110
where
111+
intersperseElse :: [(a, RenderedCode)] -> [(a, RenderedCode)]
112+
intersperseElse = zipWith ($) $ id : repeat (mapSnd $ ((keywordElse <> sp) <>))
113+
114+
mapSnd f (a, b) = (a, f b)
115+
116+
renderInstanceChain :: ChildInstanceChainInfo -> (Text, RenderedCode)
111117
renderInstanceChain inst =
112118
(icTitle inst, mintersperse sp $ renderChildInstance $ inst)
113119

0 commit comments

Comments
 (0)