e748a7b · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Merge pull request #1168 from hdgarrood/extra-info-for-hoogle

e748a7bPhil Freeman11 years ago

purescript.cabal+1−1

compare with golang

unifiedsplit

@@ -42,7 +42,7 @@ library

42 aeson >= 0.8 && < 0.9,

43 vector -any,

44 bower-json >= 0.7,

45− aeson-better-errors >= 0.7,

45+ aeson-better-errors >= 0.8,

46 bytestring -any,

47 text -any,

48 split -any

src/Language/PureScript/Docs/AsMarkdown.hs+12−8

@@ -38,7 +38,7 @@ declAsMarkdown RenderedDeclaration{..} = do

38 headerLevel 4 (ticks rdTitle)

39 spacer

41− let (instances, children) = partition ((==) ChildInstance . rcdType) rdChildren

41+ let (instances, children) = partition (isChildInstance . rcdInfo) rdChildren

42 fencedBlock $ do

43 tell' (codeToString rdCode)

44 zipWithM_ (\f c -> tell' (childToString f c)) (First : repeat NotFirst) children

@@ -53,6 +53,10 @@ declAsMarkdown RenderedDeclaration{..} = do

53 fencedBlock $ mapM_ (tell' . childToString NotFirst) instances

54 spacer

56+ where

57+ isChildInstance (ChildInstance _) = True

58+ isChildInstance _ = False

59+

56codeToString :: RenderedCode -> String

60codeToString :: RenderedCode -> String

57codeToString = outputWith elemAsMarkdown

61codeToString = outputWith elemAsMarkdown

58 where

62 where

@@ -79,14 +83,14 @@ fixityAsMarkdown (P.Fixity associativity precedence) =

80childToString :: First -> RenderedChildDeclaration -> String

84childToString :: First -> RenderedChildDeclaration -> String

81childToString f RenderedChildDeclaration{..} =

85childToString f RenderedChildDeclaration{..} =

82− case rcdType of

86+ case rcdInfo of

83− ChildDataConstructor ->

87+ ChildDataConstructor sig _ ->

84 let c = if f == First then "=" else "|"

88 let c = if f == First then "=" else "|"

85− in " " ++ c ++ " " ++ codeToString rcdCode

89+ in " " ++ c ++ " " ++ codeToString sig

86− ChildTypeClassMember ->

90+ ChildTypeClassMember ty _ ->

87− " " ++ codeToString rcdCode

91+ " " ++ codeToString ty

88− ChildInstance ->

92+ ChildInstance code ->

89− codeToString rcdCode

93+ codeToString code

91data First

95data First

92 = First

96 = First

src/Language/PureScript/Docs/Render.hs+15−13

@@ -150,11 +150,14 @@ renderDeclaration (P.DataDeclaration dtype name args ctors) title =

150 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)

151 code = keyword (show dtype) <> sp <> renderType typeApp

152 children = map renderCtor ctors

153− -- TODO: Comments for data constructors?

154 renderCtor (ctor', tys) =

153 renderCtor (ctor', tys) =

154+ RenderedChildDeclaration (show ctor') Nothing Nothing (ChildDataConstructor ctorSignature ctorCode)

155+ where

155− let typeApp' = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing ctor')) tys

156+ ctor'' = P.TypeConstructor (P.Qualified Nothing ctor')

157+ typeApp' = foldl P.TypeApp ctor'' tys

156− childCode = renderType typeApp'

158+ ctorSignature = renderType typeApp'

157− in RenderedChildDeclaration (show ctor') Nothing childCode Nothing ChildDataConstructor

159+ ctorCode = ident (show ctor') <> sp <> syntax "::" <> sp <> renderType ctorType

160+ ctorType = P.quantify $ foldr (\a b -> P.TypeApp (P.TypeApp P.tyFunction a) b) typeApp tys

158renderDeclaration (P.ExternDataDeclaration name kind') title =

161renderDeclaration (P.ExternDataDeclaration name kind') title =

159 basicDeclaration title code

162 basicDeclaration title code

160 where

163 where

@@ -196,16 +199,15 @@ renderDeclaration (P.TypeClassDeclaration name args implies ds) title = do

196

199

197 children = map renderClassMember ds

200 children = map renderClassMember ds

198

201

199− -- TODO: Comments for type class members

200 renderClassMember (P.PositionedDeclaration _ _ d) = renderClassMember d

202 renderClassMember (P.PositionedDeclaration _ _ d) = renderClassMember d

201 renderClassMember (P.TypeDeclaration ident' ty) =

203 renderClassMember (P.TypeDeclaration ident' ty) =

202− let childCode =

204+ RenderedChildDeclaration (show ident') Nothing Nothing (ChildTypeClassMember contextualType actualType)

203− mintersperse sp

205+ where

204− [ ident (show ident')

206+ begin = ident (show ident') <> sp <> syntax "::" <> sp

205− , syntax "::"

206− , renderType ty

207+ contextualType = begin <> renderType ty

207− ]

208+ actualType = begin <> renderType (addConstraint classConstraint ty)

208− in RenderedChildDeclaration (show ident') Nothing childCode Nothing ChildTypeClassMember

209+ classConstraint = (P.Qualified Nothing name, map toTypeVar args)

210+ addConstraint c ty' = P.moveQuantifiersToFront (P.quantify (P.ConstrainedType [c] ty'))

209 renderClassMember _ = error "Invalid argument to renderClassMember."

211 renderClassMember _ = error "Invalid argument to renderClassMember."

210renderDeclaration (P.TypeInstanceDeclaration name constraints className tys _) title = do

212renderDeclaration (P.TypeInstanceDeclaration name constraints className tys _) title = do

211 Just (Left (classNameString : typeNameStrings, AugmentChild childDecl))

213 Just (Left (classNameString : typeNameStrings, AugmentChild childDecl))

@@ -218,7 +220,7 @@ renderDeclaration (P.TypeInstanceDeclaration name constraints className tys _) t

218 extractProperNames (P.SaturatedTypeSynonym n _) = [unQual n]

220 extractProperNames (P.SaturatedTypeSynonym n _) = [unQual n]

219 extractProperNames _ = []

221 extractProperNames _ = []

220

222

221− childDecl = RenderedChildDeclaration title Nothing code Nothing ChildInstance

223+ childDecl = RenderedChildDeclaration title Nothing Nothing (ChildInstance code)

222

224

223 code =

225 code =

224 mintersperse sp $

226 mintersperse sp $

src/Language/PureScript/Docs/Types.hs+45−30

@@ -12,7 +12,6 @@ module Language.PureScript.Docs.Types

12import Control.Arrow (first, (***))

13import Control.Applicative ((<$>), (<*>))

14import Data.Functor ((<$))

15−import Data.Char

16import Data.Maybe (mapMaybe)

15import Data.Maybe (mapMaybe)

17import Data.Version

16import Data.Version

18import Data.Aeson ((.=))

17import Data.Aeson ((.=))

@@ -87,27 +86,32 @@ data RenderedDeclaration = RenderedDeclaration

87data RenderedChildDeclaration = RenderedChildDeclaration

86data RenderedChildDeclaration = RenderedChildDeclaration

88 { rcdTitle :: String

87 { rcdTitle :: String

89 , rcdComments :: Maybe String

88 , rcdComments :: Maybe String

90− , rcdCode :: RenderedCode

91 , rcdSourceSpan :: Maybe P.SourceSpan

89 , rcdSourceSpan :: Maybe P.SourceSpan

92− , rcdType :: RenderedChildDeclarationType

90+ , rcdInfo :: RenderedChildDeclarationInfo

93 }

91 }

94 deriving (Show, Eq, Ord)

92 deriving (Show, Eq, Ord)

96−data RenderedChildDeclarationType

94+data RenderedChildDeclarationInfo

97− = ChildInstance

95+ = ChildInstance RenderedCode

96+ -- ^ A type instance declaration. The rendered code value looks like

97+ -- `instance showUnit :: Show Unit`

98− | ChildDataConstructor

98+ | ChildDataConstructor RenderedCode RenderedCode

99+ -- ^ A data constructor, with rendered code for both how it appears in the

100+ -- data declaration, and the constructor with its actual type. For example,

101+ -- the constructor `Just` from the type `Maybe` might have the rendered

102+ -- code values being `Just a` and `Just :: forall a. a -> Maybe a`.

99− | ChildTypeClassMember

103+ | ChildTypeClassMember RenderedCode RenderedCode

104+ -- ^ A type class member, with rendered code for its type in the context of

105+ -- the parent type class declaration (that is, without a constraint), and

106+ -- also for its actual type. For example, `add` from `Semiring` might have

107+ -- the rendered code values as `add :: a -> a -> a` and

108+ -- `add :: forall a. (Semiring a) => a -> a -> a` respectively.

100− deriving (Show, Eq, Ord, Bounded, Enum)

109+ deriving (Show, Eq, Ord)

101−

102−childDeclTypeToString :: RenderedChildDeclarationType -> String

103−childDeclTypeToString = withHead toLower . drop 5 . show

104− where

105− withHead f (x:xs) = f x : xs

106− withHead _ [] = []

107

110

108−childDeclarationTypes :: [(String, RenderedChildDeclarationType)]

111+childDeclTypeToString :: RenderedChildDeclarationInfo -> String

109−childDeclarationTypes =

112+childDeclTypeToString (ChildInstance _) = "instance"

113+childDeclTypeToString (ChildDataConstructor _ _) = "dataConstructor"

110− map (\t -> (childDeclTypeToString t, t)) [minBound .. maxBound]

114+childDeclTypeToString (ChildTypeClassMember _ _) = "typeClassMember"

111

115

112newtype GithubUser

116newtype GithubUser

113 = GithubUser { runGithubUser :: String }

117 = GithubUser { runGithubUser :: String }

@@ -120,7 +124,7 @@ newtype GithubRepo

120data PackageError

124data PackageError

121 = ErrorInPackageMeta BowerError

125 = ErrorInPackageMeta BowerError

122 | InvalidVersion

126 | InvalidVersion

123− | InvalidDeclarationType

127+ | InvalidChildDeclarationType String

124 | InvalidRenderedCode String

128 | InvalidRenderedCode String

125 | InvalidFixity

129 | InvalidFixity

126 deriving (Show, Eq, Ord)

130 deriving (Show, Eq, Ord)

@@ -232,16 +236,23 @@ asRenderedChildDeclaration :: Parse PackageError RenderedChildDeclaration

232asRenderedChildDeclaration =

236asRenderedChildDeclaration =

233 RenderedChildDeclaration <$> key "title" asString

237 RenderedChildDeclaration <$> key "title" asString

234 <*> key "comments" (perhaps asString)

238 <*> key "comments" (perhaps asString)

235− <*> key "code" asRenderedCode .! InvalidRenderedCode

236 <*> key "sourceSpan" (perhaps asSourceSpan)

239 <*> key "sourceSpan" (perhaps asSourceSpan)

237− <*> key "type" asRenderedChildDeclarationType .!! InvalidDeclarationType

240+ <*> key "info" asRenderedChildDeclarationInfo

241+

242+asRenderedChildDeclarationInfo :: Parse PackageError RenderedChildDeclarationInfo

243+asRenderedChildDeclarationInfo = do

244+ ty <- key "declType" asString

245+ case ty of

246+ "instance" ->

247+ ChildInstance <$> codeKey "code"

248+ "dataConstructor" ->

249+ ChildDataConstructor <$> codeKey "signature" <*> codeKey "type"

250+ "typeClassMember" ->

251+ ChildTypeClassMember <$> codeKey "contextualType" <*> codeKey "type"

252+ other ->

253+ throwCustomError $ InvalidChildDeclarationType other

238 where

254 where

239− p .!! err = p .! const err

255+ codeKey k = key k asRenderedCode .! InvalidRenderedCode

240−

241−asRenderedChildDeclarationType :: Parse PackageError RenderedChildDeclarationType

242−asRenderedChildDeclarationType =

243− withString (maybe (Left InvalidDeclarationType) Right .

244− flip lookup childDeclarationTypes)

245

256

246asSourcePos :: Parse e P.SourcePos

257asSourcePos :: Parse e P.SourcePos

247asSourcePos = P.SourcePos <$> nth 0 asIntegral

258asSourcePos = P.SourcePos <$> nth 0 asIntegral

@@ -317,13 +328,17 @@ instance A.ToJSON RenderedChildDeclaration where

317 toJSON RenderedChildDeclaration{..} =

328 toJSON RenderedChildDeclaration{..} =

318 A.object [ "title" .= rcdTitle

329 A.object [ "title" .= rcdTitle

319 , "comments" .= rcdComments

330 , "comments" .= rcdComments

320− , "code" .= rcdCode

321 , "sourceSpan" .= rcdSourceSpan

331 , "sourceSpan" .= rcdSourceSpan

322− , "type" .= rcdType

332+ , "info" .= rcdInfo

323 ]

333 ]

324

334

325−instance A.ToJSON RenderedChildDeclarationType where

335+instance A.ToJSON RenderedChildDeclarationInfo where

326− toJSON = A.toJSON . childDeclTypeToString

336+ toJSON info = A.object $ "declType" .= childDeclTypeToString info : props

337+ where

338+ props = case info of

339+ ChildInstance code -> ["code" .= code]

340+ ChildDataConstructor sig ty -> ["signature" .= sig, "type" .= ty]

341+ ChildTypeClassMember cTy ty -> ["contextualType" .= cTy, "type" .= ty]

327

342

328instance A.ToJSON GithubUser where

343instance A.ToJSON GithubUser where

329 toJSON = A.toJSON . runGithubUser

344 toJSON = A.toJSON . runGithubUser