git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Flip comment/decl, add fenced blocks for decl
commit84193e2aebdb12e4f1992d1e38d6837bdb4c743e authorGary Burgess <gary.burgess@gmail.com> dateSat 21 Feb 2015, 01:52 (12 years ago) parent446d7c1
1 file changed+25−14
psc-docs/Main.hs+25−14
psc-docs/Main.hs+25−14
@@ -67,6 +67,15 @@ atIndent indent text =
6767 let ls = lines text in
6868 withIndent indent (tell ls)
6969
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+
7079ticks :: String -> String
7180ticks = ("`" ++) . (++ "`")
7281
@@ -109,45 +118,48 @@ getDeclarationTitle _ = Nothing
109118
110119renderDeclaration :: Maybe [P.DeclarationRef] -> P.Declaration -> Docs
111120renderDeclaration _ (P.TypeDeclaration ident ty) =
112− atIndent 4 $ show ident ++ " :: " ++ prettyPrintType' ty
121+ fenced $ show ident ++ " :: " ++ prettyPrintType' ty
113122renderDeclaration _ (P.ExternDeclaration _ ident _ ty) =
114− atIndent 4 $ show ident ++ " :: " ++ prettyPrintType' ty
123+ fenced $ show ident ++ " :: " ++ prettyPrintType' ty
115124renderDeclaration exps (P.DataDeclaration dtype name args ctors) = do
116125 let
117126 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
118127 typeName = prettyPrintType' typeApp
119128 exported = filter (P.isDctorExported name exps . fst) ctors
120− atIndent 4 $ show dtype ++ " " ++ typeName
121− zipWithM_ (\isFirst (ctor, tys) ->
122− atIndent 6 $ (if isFirst then "= " else "| ") ++ P.runProperName ctor ++ " " ++ unwords (map P.prettyPrintTypeAtom tys))
123− (True : repeat False) exported
129+ fencedBlock $ do
130+ tell [show dtype ++ " " ++ typeName]
131+ zipWithM_ (\isFirst (ctor, tys) ->
132+ atIndent 2 $ (if isFirst then "= " else "| ") ++ P.runProperName ctor ++ " " ++ unwords (map P.prettyPrintTypeAtom tys))
133+ (True : repeat False) exported
124134renderDeclaration _ (P.ExternDataDeclaration name kind) =
125− atIndent 4 $ "data " ++ P.runProperName name ++ " :: " ++ P.prettyPrintKind kind
135+ fenced $ "data " ++ P.runProperName name ++ " :: " ++ P.prettyPrintKind kind
126136renderDeclaration _ (P.TypeSynonymDeclaration name args ty) = do
127137 let
128138 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
129139 typeName = prettyPrintType' typeApp
130− atIndent 4 $ "type " ++ typeName ++ " = " ++ prettyPrintType' ty
140+ fenced $ "type " ++ typeName ++ " = " ++ prettyPrintType' ty
131141renderDeclaration _ (P.TypeClassDeclaration name args implies ds) = do
132142 let impliesText = case implies of
133143 [] -> ""
134144 is -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) is) ++ ") <= "
135145 classApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
136146 className = prettyPrintType' classApp
137− atIndent 4 $ "class " ++ impliesText ++ className ++ " where"
138− mapM_ renderClassMember ds
147+ fencedBlock $ do
148+ tell ["class " ++ impliesText ++ className ++ " where"]
149+ mapM_ renderClassMember ds
139150 where
140151 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
142153 renderClassMember _ = error "Invalid argument to renderClassMember."
143154renderDeclaration _ (P.TypeInstanceDeclaration name constraints className tys _) = do
144155 let constraintsText = case constraints of
145156 [] -> ""
146157 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)
148159renderDeclaration exps (P.PositionedDeclaration _ com d) = do
149− renderComments com
150160 renderDeclaration exps d
161+ spacer
162+ renderComments com
151163renderDeclaration _ _ = return ()
152164
153165renderComments :: [P.Comment] -> Docs
@@ -158,7 +170,6 @@ renderComments cs = do
158170 then atIndent 0 . unlines . map stripPipes $ raw
159171 else atIndent 4 $ unlines raw
160172
161− unless (null raw) spacer
162173 where
163174
164175 toLines (P.LineComment s) = [s]