89bbbb9 · elk · git.iko.soy

12import Control.Arrow (second)

13import Data.Aeson

14import Data.Aeson.Encode.Pretty

15+import Data.Aeson.Types (Pair)

15import qualified Data.List as List

16import qualified Data.List as List

16import qualified Data.Map as Map

17import qualified Data.Map as Map

17import qualified Data.ByteString.Lazy as BS

18import qualified Data.ByteString.Lazy as BS

65

66

66docs :: IParser Value

67docs :: IParser Value

67docs = do

68docs = do

68− (name, exports, structure) <- moduleDocs

69+ (name, _exports, structure) <- moduleDocs

69 things <- document

70 things <- document

70− return $ documentToJson name exports structure things

71+ return $ documentToJson name structure things

71

72

72docComment :: IParser String

73docComment :: IParser String

73docComment = do

74docComment = do

76 let reversed = dropWhile (`elem` " \n\r") . drop 2 $ reverse contents

77 let reversed = dropWhile (`elem` " \n\r") . drop 2 $ reverse contents

77 return $ dropWhile (==' ') (reverse reversed)

78 return $ dropWhile (==' ') (reverse reversed)

78

79

79−--moduleDocs :: IParser (String, [String], String)

80+moduleDocs :: IParser (String, Var.Listing Var.Value, String)

80moduleDocs = do

81moduleDocs = do

81 optional freshLine

82 optional freshLine

82 (names,exports) <- moduleDef

83 (names,exports) <- moduleDef

85 structure <- docComment

86 structure <- docComment

86 return (List.intercalate "." names, exports, structure)

87 return (List.intercalate "." names, exports, structure)

87

88

88−--document :: IParser [(String, D.SourceDecl, String)]

89+document :: IParser [(String, D.SourceDecl, String)]

89document = onFreshLines (\t ts -> ts ++ [t]) [] docThing

90document = onFreshLines (\t ts -> ts ++ [t]) [] docThing

90

91

91−--docThing :: IParser (String, D.SourceDecl, String)

92+docThing :: IParser (String, D.SourceDecl, String)

92docThing = uncommentable <|> commented <|> uncommented ""

93docThing = uncommentable <|> commented <|> uncommented ""

93 where

94 where

94 uncommentable = do

95 uncommentable = do

105 return (comment, def, src)

106 return (comment, def, src)

106

107

108

109+documentToJson :: String -> String -> [(String, D.SourceDecl, String)] -> Value

108−documentToJson name exports structure things =

110+documentToJson name structure things =

111+ object

109− object $ [ "name" .= name

112+ [ "name" .= name

110− , "document" .= structure

113+ , "document" .= structure

111−-- , "values" .= toList values

114+ , "values" .= toList values

112−-- , "aliases" .= toList aliases

115+ , "aliases" .= toList aliases

113−-- , "datatypes" .= toList adts

116+ , "datatypes" .= toList adts

114− ]

117+ ]

115−{--

116 where

118 where

119+ (values, aliases, adts) =

117− (values, aliases, adts) = collect Map.empty Map.empty Map.empty Map.empty things

120+ collect Map.empty Map.empty Map.empty Map.empty things

118

121

122+ toList :: Map.Map String [Pair] -> [Value]

123+ toList dict =

119− toList dict = map object . Map.elems $ filterPublics dict

124+ map object (Map.elems dict)

120−

125+

121− exportMap = Map.fromList (zip exports exports)

126+type Pairs = Map.Map String [Pair]

122− filterPublics dict =

127+

123− case Map.null exportMap of

128+collect :: Map.Map String (D.Assoc, Int) -> Pairs -> Pairs -> Pairs

124− True -> dict

129+ -> [(String, D.SourceDecl, String)]

125− False -> Map.filterWithKey (\k _ -> Map.member k exportMap) dict

130+ -> (Pairs, Pairs, Pairs)

126−--}

127−{--

128collect infixes types aliases adts things =

131collect infixes types aliases adts things =

129 case things of

132 case things of

130 [] -> (Map.union customOps nonCustomOps, aliases, adts)

133 [] -> (Map.union customOps nonCustomOps, aliases, adts)

139 [ "associativity" .= show assoc, "precedence" .= prec ] ++ pairs

142 [ "associativity" .= show assoc, "precedence" .= prec ] ++ pairs

140

143

141 (comment, decl, source) : rest ->

144 (comment, decl, source) : rest ->

145+ let insert name fields dict = Map.insert name (obj name fields) dict

146+ obj name fields =

147+ [ "name" .= name

148+ , "raw" .= source

149+ , "comment" .= comment

150+ ] ++ fields

151+ in

142 case decl of

152 case decl of

143− D.Fixity assoc prec name ->

153+ D.Definition def ->

144− collect (Map.insert name (assoc,prec) infixes) types aliases adts rest

154+ case def of

145− D.Definition (Src.TypeAnnotation name tipe) ->

155+ Src.TypeAnnotation name tipe ->

146− collect infixes (insert name [ "type" .= tipe ] types) aliases adts rest

156+ collect infixes (insert name [ "type" .= tipe ] types) aliases adts rest

147− D.TypeAlias name vars tipe ->

157+

148− let fields = ["typeVariables" .= vars, "type" .= tipe ]

158+ Src.Definition _ _ ->

149− in collect infixes types (insert name fields aliases) adts rest

159+ collect infixes types aliases adts rest

160+

150 D.Datatype name vars ctors ->

161 D.Datatype name vars ctors ->

151− let tipe = T.App (T.Type name) (map T.Var vars)

162+ let tipe = T.App (T.Type (Var.Raw name)) (map T.Var vars)

152− fields = ["typeVariables" .= vars

163+ fields = [ "typeVariables" .= vars

153− , "constructors" .= map (ctorToJson tipe) ctors ]

164+ , "constructors" .= map (ctorToJson tipe) ctors

165+ ]

154 in collect infixes types aliases (insert name fields adts) rest

166 in collect infixes types aliases (insert name fields adts) rest

155− where

167+

156− insert name fields dict = Map.insert name (obj name fields) dict

168+ D.TypeAlias name vars tipe ->

157− obj name fields =

169+ let fields = [ "typeVariables" .= vars, "type" .= tipe ]

158− [ "name" .= name, "raw" .= source, "comment" .= comment ] ++ fields

170+ in collect infixes types (insert name fields aliases) adts rest

159−--}

171+

172+ D.Port _ ->

173+ collect infixes types aliases adts rest

174+

175+ D.Fixity assoc prec name ->

176+ collect (Map.insert name (assoc,prec) infixes) types aliases adts rest

177+

178+

160instance Var.ToString var => ToJSON (T.Type var) where

179instance Var.ToString var => ToJSON (T.Type var) where

161 toJSON tipe =

180 toJSON tipe =

162− object $

181+ object (getFields tipe)

182+ where

183+ getFields tipe =

163− case tipe of

184+ case tipe of

164− T.Lambda _ _ ->

185+ T.Lambda _ _ ->

165− let tipes = T.collectLambdas tipe in

186+ let tipes = T.collectLambdas tipe in

166− [ "tag" .= ("function" :: Text.Text)

187+ [ "tag" .= ("function" :: Text.Text)

167− , "args" .= toJSON (init tipes)

188+ , "args" .= toJSON (init tipes)

168− , "result" .= toJSON (last tipes)

189+ , "result" .= toJSON (last tipes)

169− ]

190+ ]

170−

191+

171− T.Var x ->

192+ T.Var x ->

172− [ "tag" .= ("var" :: Text.Text)

193+ [ "tag" .= ("var" :: Text.Text)

173− , "name" .= toJSON x

194+ , "name" .= toJSON x

174− ]

195+ ]

175−

196+

176− T.Type name ->

197+ T.Type name ->

177− [ "tag" .= ("adt" :: Text.Text)

198+ [ "tag" .= ("adt" :: Text.Text)

178− , "name" .= toJSON (Var.toString name)

199+ , "name" .= toJSON (Var.toString name)

179− , "args" .= ([] :: [()])

200+ , "args" .= ([] :: [()])

180− ]

201+ ]

181−

202+

182− T.App (T.Type name) ts ->

203+ T.App (T.Type name) ts ->

183− [ "tag" .= ("adt" :: Text.Text)

204+ [ "tag" .= ("adt" :: Text.Text)

184− , "name" .= toJSON (Var.toString name)

205+ , "name" .= toJSON (Var.toString name)

185− , "args" .= map toJSON ts

206+ , "args" .= map toJSON ts

186− ]

207+ ]

187−

208+

209+ T.App _ _ -> error "This is an unexpected error with elm-doc, please report it at <https://github.com/elm-lang/Elm/issues>"

210+

188− T.Record fields ext ->

211+ T.Record fields ext ->

189− [ "tag" .= ("record" :: Text.Text)

212+ [ "tag" .= ("record" :: Text.Text)

190− , "fields" .= toJSON (map (toJSON . second toJSON) fields)

213+ , "fields" .= toJSON (map (toJSON . second toJSON) fields)

191− , "extension" .= toJSON ext

214+ , "extension" .= toJSON ext

192− ]

215+ ]

193−

216+

217+ T.Aliased _ t ->

218+ getFields t

219+

194−ctorToJson :: Var.ToString var => T.Type var -> (String, [T.Type var]) -> Value

220+ctorToJson :: T.RawType -> (String, [T.RawType]) -> Value

195ctorToJson tipe (ctor, tipes) =

221ctorToJson tipe (ctor, tipes) =

196 object [ "name" .= ctor

222 object [ "name" .= ctor

197− , "type" .= foldr T.Lambda tipe tipes ]

223+ , "type" .= foldr T.Lambda tipe tipes

224+ ]