git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Flip comment/decl, add fenced blocks for decl
84193e2Gary Burgess
psc-docs/Main.hs+25−14
compare with golang
unifiedsplit
@@ -67,6 +67,15 @@ atIndent indent text =
67 let ls = lines text in
67 let ls = lines text in
68 withIndent indent (tell ls)
68 withIndent indent (tell ls)
69
69
70+fenced :: String -> Docs
71+fenced text = fencedBlock (tell $ lines text)
72+
73+fencedBlock :: Docs -> Docs
74+fencedBlock inner = do
75+ tell ["``` purescript"]
76+ inner
77+ tell ["```"]
78+
70ticks :: String -> String
79ticks :: String -> String
71ticks = ("`" ++) . (++ "`")
80ticks = ("`" ++) . (++ "`")
72
81
@@ -109,45 +118,48 @@ getDeclarationTitle _ = Nothing
109
118
110renderDeclaration :: Maybe [P.DeclarationRef] -> P.Declaration -> Docs
119renderDeclaration :: Maybe [P.DeclarationRef] -> P.Declaration -> Docs
111renderDeclaration _ (P.TypeDeclaration ident ty) =
120renderDeclaration _ (P.TypeDeclaration ident ty) =
112− atIndent 4 $ show ident ++ " :: " ++ prettyPrintType' ty
121+ fenced $ show ident ++ " :: " ++ prettyPrintType' ty
113renderDeclaration _ (P.ExternDeclaration _ ident _ ty) =
122renderDeclaration _ (P.ExternDeclaration _ ident _ ty) =
114− atIndent 4 $ show ident ++ " :: " ++ prettyPrintType' ty
123+ fenced $ show ident ++ " :: " ++ prettyPrintType' ty
115renderDeclaration exps (P.DataDeclaration dtype name args ctors) = do
124renderDeclaration exps (P.DataDeclaration dtype name args ctors) = do
116 let
125 let
117 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
126 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
118 typeName = prettyPrintType' typeApp
127 typeName = prettyPrintType' typeApp
119 exported = filter (P.isDctorExported name exps . fst) ctors
128 exported = filter (P.isDctorExported name exps . fst) ctors
129+ fencedBlock $ do
120− atIndent 4 $ show dtype ++ " " ++ typeName
130+ tell [show dtype ++ " " ++ typeName]
121− zipWithM_ (\isFirst (ctor, tys) ->
131+ zipWithM_ (\isFirst (ctor, tys) ->
122− atIndent 6 $ (if isFirst then "= " else "| ") ++ P.runProperName ctor ++ " " ++ unwords (map P.prettyPrintTypeAtom tys))
132+ atIndent 2 $ (if isFirst then "= " else "| ") ++ P.runProperName ctor ++ " " ++ unwords (map P.prettyPrintTypeAtom tys))
123− (True : repeat False) exported
133+ (True : repeat False) exported
124renderDeclaration _ (P.ExternDataDeclaration name kind) =
134renderDeclaration _ (P.ExternDataDeclaration name kind) =
125− atIndent 4 $ "data " ++ P.runProperName name ++ " :: " ++ P.prettyPrintKind kind
135+ fenced $ "data " ++ P.runProperName name ++ " :: " ++ P.prettyPrintKind kind
126renderDeclaration _ (P.TypeSynonymDeclaration name args ty) = do
136renderDeclaration _ (P.TypeSynonymDeclaration name args ty) = do
127 let
137 let
128 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
138 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
129 typeName = prettyPrintType' typeApp
139 typeName = prettyPrintType' typeApp
130− atIndent 4 $ "type " ++ typeName ++ " = " ++ prettyPrintType' ty
140+ fenced $ "type " ++ typeName ++ " = " ++ prettyPrintType' ty
131renderDeclaration _ (P.TypeClassDeclaration name args implies ds) = do
141renderDeclaration _ (P.TypeClassDeclaration name args implies ds) = do
132 let impliesText = case implies of
142 let impliesText = case implies of
133 [] -> ""
143 [] -> ""
134 is -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) is) ++ ") <= "
144 is -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) is) ++ ") <= "
135 classApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
145 classApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
136 className = prettyPrintType' classApp
146 className = prettyPrintType' classApp
147+ fencedBlock $ do
137− atIndent 4 $ "class " ++ impliesText ++ className ++ " where"
148+ tell ["class " ++ impliesText ++ className ++ " where"]
138− mapM_ renderClassMember ds
149+ mapM_ renderClassMember ds
139 where
150 where
140 renderClassMember (P.PositionedDeclaration _ _ d) = renderClassMember d
151 renderClassMember (P.PositionedDeclaration _ _ d) = renderClassMember d
141− renderClassMember (P.TypeDeclaration ident ty) = atIndent 6 $ show ident ++ " :: " ++ prettyPrintType' ty
152+ renderClassMember (P.TypeDeclaration ident ty) = atIndent 2 $ show ident ++ " :: " ++ prettyPrintType' ty
142 renderClassMember _ = error "Invalid argument to renderClassMember."
153 renderClassMember _ = error "Invalid argument to renderClassMember."
143renderDeclaration _ (P.TypeInstanceDeclaration name constraints className tys _) = do
154renderDeclaration _ (P.TypeInstanceDeclaration name constraints className tys _) = do
144 let constraintsText = case constraints of
155 let constraintsText = case constraints of
145 [] -> ""
156 [] -> ""
146 cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) cs) ++ ") => "
157 cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) cs) ++ ") => "
147− atIndent 4 $ "instance " ++ show name ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map P.prettyPrintTypeAtom tys)
158+ fenced $ "instance " ++ show name ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map P.prettyPrintTypeAtom tys)
148renderDeclaration exps (P.PositionedDeclaration _ com d) = do
159renderDeclaration exps (P.PositionedDeclaration _ com d) = do
149− renderComments com
150 renderDeclaration exps d
160 renderDeclaration exps d
161+ spacer
162+ renderComments com
151renderDeclaration _ _ = return ()
163renderDeclaration _ _ = return ()
152
164
153renderComments :: [P.Comment] -> Docs
165renderComments :: [P.Comment] -> Docs
@@ -158,7 +170,6 @@ renderComments cs = do
158 then atIndent 0 . unlines . map stripPipes $ raw
170 then atIndent 0 . unlines . map stripPipes $ raw
159 else atIndent 4 $ unlines raw
171 else atIndent 4 $ unlines raw
160
172
161− unless (null raw) spacer
162 where
173 where
163
174
164 toLines (P.LineComment s) = [s]
175 toLines (P.LineComment s) = [s]