git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Various changes to Docs for Pursuit
213cfc3Harry Garrood
psc-publish/Main.hs+2−2
compare with golang
unifiedsplit
@@ -103,9 +103,9 @@ preparePackage' = do
103 let declaredDeps = map fst (bowerDependencies pkgMeta ++ bowerDevDependencies pkgMeta)
103 let declaredDeps = map fst (bowerDependencies pkgMeta ++ bowerDevDependencies pkgMeta)
104 pkgResolvedDependencies <- getResolvedDependencies declaredDeps
104 pkgResolvedDependencies <- getResolvedDependencies declaredDeps
105
105
106− let pkgUploader = Nothing
106+ let pkgUploader = D.NotYetKnown
107
107
108− return D.UploadedPackage{..}
108+ return D.Package{..}
109
109
110getModulesAndBookmarks :: PrepareM ([D.Bookmark], [D.RenderedModule])
110getModulesAndBookmarks :: PrepareM ([D.Bookmark], [D.RenderedModule])
111getModulesAndBookmarks = do
111getModulesAndBookmarks = do
purescript.cabal+2−8
@@ -40,14 +40,10 @@ library
40 aeson >= 0.8 && < 0.9,
40 aeson >= 0.8 && < 0.9,
41 vector -any,
41 vector -any,
42 bower-json >= 0.7,
42 bower-json >= 0.7,
43− aeson-better-errors >= 0.5,
43+ aeson-better-errors >= 0.7,
44 bytestring -any,
44 bytestring -any,
45 text -any,
45 text -any,
46− split -any,
46+ split -any
47− lucid -any,
48− blaze-html -any,
49− data-default -any,
50− cheapskate -any
51 exposed-modules: Language.PureScript
47 exposed-modules: Language.PureScript
52 Language.PureScript.AST
48 Language.PureScript.AST
53 Language.PureScript.AST.Binders
49 Language.PureScript.AST.Binders
@@ -131,9 +127,7 @@ library
131 Language.PureScript.Docs.RenderedCode.Types
127 Language.PureScript.Docs.RenderedCode.Types
132 Language.PureScript.Docs.RenderedCode.Render
128 Language.PureScript.Docs.RenderedCode.Render
133 Language.PureScript.Docs.AsMarkdown
129 Language.PureScript.Docs.AsMarkdown
134− Language.PureScript.Docs.AsHtml
135 Language.PureScript.Docs.ParseAndDesugar
130 Language.PureScript.Docs.ParseAndDesugar
136− Language.PureScript.Docs.Utils.HtmlHelpers
137 Language.PureScript.Docs.Utils.MonoidExtras
131 Language.PureScript.Docs.Utils.MonoidExtras
138
132
139 Control.Monad.Unify
133 Control.Monad.Unify
src/Language/PureScript/Docs/AsHtml.hsdeleted−219
@@ -1,219 +0,0 @@
1−{-# LANGUAGE RecordWildCards #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TemplateHaskell #-}
4−{-# LANGUAGE ViewPatterns #-}
5−
6−-- | Functions for rendering generated documentation from PureScript code as
7−-- HTML.
8−
9−module Language.PureScript.Docs.AsHtml (
10− HtmlOutput(..),
11− packageAsHtml
12−) where
13−
14−import Control.Arrow (second)
15−import Control.Category ((>>>))
16−import Data.Char (toUpper)
17−import Data.Ord (comparing)
18−import Data.Monoid (mconcat)
19−import Data.Foldable (for_)
20−import Data.List (intercalate, find, sortBy)
21−import qualified Data.DList as DList
22−import Data.List.Split (splitOn)
23−import Data.Default (def)
24−import Data.Version
25−import qualified Data.Map as M
26−
27−import qualified Data.Text as T
28−
29−import Lucid hiding (for_)
30−import qualified Text.Blaze.Html as H
31−import qualified Text.Blaze.Html.Renderer.Text as H
32−import qualified Cheapskate
33−
34−import System.FilePath ((</>))
35−
36−import Web.Bower.PackageMeta hiding (Version)
37−
38−import qualified Language.PureScript as P
39−
40−import Language.PureScript.Docs.Types
41−import Language.PureScript.Docs.RenderedCode hiding (sp)
42−import Language.PureScript.Docs.Utils.HtmlHelpers
43−
44−data LinksContext = LinksContext
45− { ctxGithub :: (GithubUser, GithubRepo)
46− , ctxBookmarks :: [Bookmark]
47− , ctxResolvedDependencies :: [(PackageName, Version)]
48− }
49− deriving (Show, Eq, Ord)
50−
51−-- | A LinksContext with the current module name.
52−type LinksContext' = (LinksContext, P.ModuleName)
53−
54−data DocLink
55− -- | A link to a declaration in the same module; in this case, only the title
56− -- is needed to generate the link.
57− = SameModule String
58−
59− -- | A link to a declaration in a different module, but still in the current
60− -- package; we need to store the current module, the other declaration's
61− -- module, and the declaration title.
62− | LocalModule P.ModuleName P.ModuleName String
63−
64− -- | A link to a declaration in a different package. We store: current module
65− -- name, name of the other package, version of the other package, name of
66− -- the module in the other package that the declaration is in, and
67− -- declaration title.
68− | DepsModule P.ModuleName PackageName Version P.ModuleName String
69− deriving (Show, Eq, Ord)
70−
71−data HtmlOutput = HtmlOutput
72− { htmlIndex :: [(Maybe Char, Html ())]
73− , htmlModules :: [(P.ModuleName, Html ())]
74− }
75− deriving (Show)
76−
77−packageAsHtml :: UploadedPackage -> HtmlOutput
78−packageAsHtml UploadedPackage{..} = HtmlOutput indexFile modules
79− where
80− indexFile = renderIndex ctx
81− modules = map (moduleAsHtml ctx) pkgModules
82− ctx = LinksContext pkgGithub pkgBookmarks pkgResolvedDependencies
83−
84−moduleAsHtml :: LinksContext -> RenderedModule -> (P.ModuleName, Html ())
85−moduleAsHtml ctx RenderedModule{..} = (mn, html)
86− where
87− mn = P.moduleNameFromString rmName
88− ctx' = (ctx, mn)
89− html = do
90− h1_ $ do
91− text "module "
92− strong_ (text rmName)
93− for_ rmComments renderComments
94− for_ rmDeclarations (declAsHtml ctx')
95−
96−renderIndex :: LinksContext -> [(Maybe Char, Html ())]
97−renderIndex LinksContext{..} = go ctxBookmarks
98− where
99− go = takeLocals
100− >>> groupIndex getIndex renderEntry
101− >>> map (second (ul_ . mconcat))
102−
103− getIndex (_, ((toUpper -> c) :_))
104− | c `elem` ['A'..'Z'] = Just c
105− | otherwise = Nothing
106− getIndex _ = Nothing
107−
108− renderEntry (mn, title) =
109− li_ $ do
110− let url = T.pack ((filePathFor mn `relativeTo` "index") ++ "#" ++ title)
111− code_ (a_ [href_ url] (text title))
112− sp
113− text ("(" ++ show mn ++ ")")
114−
115− groupIndex :: Ord i => (a -> Maybe i) -> (a -> b) -> [a] -> [(Maybe i, [b])]
116− groupIndex f g =
117− map (second DList.toList) . M.toList . foldr go' M.empty . sortBy (comparing f)
118− where
119− go' x = insertOrAppend (f x) (g x)
120− insertOrAppend idx val m =
121− let cur = M.findWithDefault DList.empty idx m
122− new = DList.snoc cur val
123− in M.insert idx new m
124−
125−declAsHtml :: LinksContext' -> RenderedDeclaration -> Html ()
126−declAsHtml ctx RenderedDeclaration{..} = do
127− a_ [name_ (T.pack rdTitle), href_ (T.pack ('#' : rdTitle))] $
128− h2_ (code_ (text rdTitle))
129− para "decl" (code_ (codeAsHtml ctx rdCode))
130− renderChildren ctx rdChildren
131− case rdComments of
132− Just cs -> renderComments cs
133− Nothing -> return ()
134− for_ rdSourceSpan (linkToSource ctx)
135−
136−renderChildren :: LinksContext' -> [RenderedChildDeclaration] -> Html ()
137−renderChildren _ [] = return ()
138−renderChildren ctx xs = go xs
139− where
140− go = ul_ . mapM_ (li_ . code_ . codeAsHtml ctx . rcdCode)
141−
142−codeAsHtml :: LinksContext' -> RenderedCode -> Html ()
143−codeAsHtml ctx = outputWith elemAsHtml
144− where
145− elemAsHtml (Syntax x) = withClass "syntax" (text x)
146− elemAsHtml (Ident x) = withClass "ident" (text x)
147− elemAsHtml (Ctor x mn) = linkToConstructor ctx x mn (withClass "ctor" (text x))
148− elemAsHtml (Kind x) = text x
149− elemAsHtml (Keyword x) = withClass "keyword" (text x)
150− elemAsHtml Space = text " "
151−
152−getLink :: LinksContext' -> String -> ContainingModule -> Maybe DocLink
153−getLink (LinksContext{..}, curMn) ctor' containingMod = do
154− let bookmark' = (fromContainingModule curMn containingMod, ctor')
155− bookmark <- find ((bookmark' ==) . ignorePackage) ctxBookmarks
156−
157− case containingMod of
158− ThisModule -> return (SameModule ctor')
159− OtherModule destMn ->
160− case bookmark of
161− Local _ -> return (LocalModule curMn destMn ctor')
162− FromDep pkgName _ -> do
163− pkgVersion <- lookup pkgName ctxResolvedDependencies
164− return (DepsModule curMn pkgName pkgVersion destMn ctor')
165−
166−renderLink :: DocLink -> Html () -> Html ()
167−renderLink (SameModule x) = linkTo ('#' : x)
168−renderLink (LocalModule srcMn destMn x) =
169− let uri = filePathFor destMn `relativeTo` filePathFor srcMn
170− in linkTo (uri ++ "#" ++ x)
171−renderLink (DepsModule srcMn pkgName pkgVersion destMn x) =
172− let relativeTo' = relativeToOtherPackage pkgName pkgVersion
173− uri = filePathFor destMn `relativeTo'` filePathFor srcMn
174− in linkTo (uri ++ "#" ++ x)
175−
176−linkToConstructor :: LinksContext' -> String -> ContainingModule -> Html () -> Html ()
177−linkToConstructor ctx ctor' containMn =
178− maybe id renderLink (getLink ctx ctor' containMn)
179−
180−linkToSource :: LinksContext' -> P.SourceSpan -> Html ()
181−linkToSource (LinksContext{..}, _) (P.SourceSpan name start end) =
182− linkTo (concat
183− [githubBaseUrl, "/tree/master/", relativeToBase name, "#", fragment])
184− (text "Source")
185− where
186− (P.SourcePos startLine _) = start
187− (P.SourcePos endLine _) = end
188− (GithubUser user, GithubRepo repo) = ctxGithub
189−
190− relativeToBase = intercalate "/" . dropWhile (/= "src") . splitOn "/"
191− githubBaseUrl = concat ["https://github.com/", user, "/", repo]
192− fragment = "L" ++ show startLine ++ "-L" ++ show endLine
193−
194−-- TODO: use GitHub API instead?
195−renderComments :: String -> Html ()
196−renderComments = toHtml . H.renderHtml . H.toHtml . Cheapskate.markdown def . T.pack
197−
198−-- | if `to` and `from` are both files in the current package, generate a
199−-- FilePath for `to` relative to `from`.
200−relativeTo :: FilePath -> FilePath -> FilePath
201−relativeTo to from = go (splitOn "/" to) (splitOn "/" from)
202− where
203− go (x : xs) (y : ys) | x == y = go xs ys
204− go xs ys = intercalate "/" $ replicate (length ys - 1) ".." ++ xs
205−
206−-- | Generate a FilePath for module documentation for a module in the current
207−-- package.
208−filePathFor :: P.ModuleName -> FilePath
209−filePathFor (P.ModuleName parts) = go parts
210− where
211− go [] = "index.html"
212− go (x : xs) = show x </> go xs
213−
214−-- | Like `relativeTo`, but in the case where `to` is in another package.
215−relativeToOtherPackage :: PackageName -> Version -> FilePath -> FilePath -> FilePath
216−relativeToOtherPackage name (showVersion -> vers) to from =
217− intercalate "/" (dots ++ [runPackageName name, vers] ++ splitOn "/" to)
218− where
219− dots = replicate (length from - 1) ".."
src/Language/PureScript/Docs/Types.hs+76−24
@@ -1,6 +1,7 @@
1{-# LANGUAGE RecordWildCards #-}
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE TupleSections #-}
3{-# LANGUAGE TupleSections #-}
4+{-# LANGUAGE RankNTypes #-}
4
5
5module Language.PureScript.Docs.Types
6module Language.PureScript.Docs.Types
6 ( module Language.PureScript.Docs.Types
7 ( module Language.PureScript.Docs.Types
@@ -10,6 +11,7 @@ module Language.PureScript.Docs.Types
10
11
11import Control.Arrow (first, (***))
12import Control.Arrow (first, (***))
12import Control.Applicative ((<$>), (<*>))
13import Control.Applicative ((<$>), (<*>))
14+import Data.Functor ((<$))
13import Data.Char
15import Data.Char
14import Data.Maybe (mapMaybe)
16import Data.Maybe (mapMaybe)
15import Data.Version
17import Data.Version
@@ -18,6 +20,7 @@ import qualified Data.Aeson as A
18import Data.Aeson.BetterErrors
20import Data.Aeson.BetterErrors
19import Text.ParserCombinators.ReadP (readP_to_S)
21import Text.ParserCombinators.ReadP (readP_to_S)
20import Data.Text (Text)
22import Data.Text (Text)
23+import Data.ByteString.Lazy (ByteString)
21import qualified Data.Text as T
24import qualified Data.Text as T
22
25
23import Web.Bower.PackageMeta hiding (Version)
26import Web.Bower.PackageMeta hiding (Version)
@@ -32,17 +35,35 @@ import Language.PureScript.Docs.RenderedCode as ReExports
32--------------------
35--------------------
33-- Types
36-- Types
34
37
35−data UploadedPackage = UploadedPackage
38+data Package a = Package
36 { pkgMeta :: PackageMeta
39 { pkgMeta :: PackageMeta
37 , pkgVersion :: Version
40 , pkgVersion :: Version
38 , pkgModules :: [RenderedModule]
41 , pkgModules :: [RenderedModule]
39 , pkgBookmarks :: [Bookmark]
42 , pkgBookmarks :: [Bookmark]
40 , pkgResolvedDependencies :: [(PackageName, Version)]
43 , pkgResolvedDependencies :: [(PackageName, Version)]
41 , pkgGithub :: (GithubUser, GithubRepo)
44 , pkgGithub :: (GithubUser, GithubRepo)
42− , pkgUploader :: Maybe GithubUser
45+ , pkgUploader :: a
43 }
46 }
44 deriving (Show, Eq, Ord)
47 deriving (Show, Eq, Ord)
45
48
49+data NotYetKnown = NotYetKnown
50+
51+type UploadedPackage = Package NotYetKnown
52+type VerifiedPackage = Package GithubUser
53+
54+verifyPackage :: GithubUser -> UploadedPackage -> VerifiedPackage
55+verifyPackage verifiedUser Package{..} =
56+ Package pkgMeta
57+ pkgVersion
58+ pkgModules
59+ pkgBookmarks
60+ pkgResolvedDependencies
61+ pkgGithub
62+ verifiedUser
63+
64+packageName :: Package a -> PackageName
65+packageName = bowerName . pkgMeta
66+
46data RenderedModule = RenderedModule
67data RenderedModule = RenderedModule
47 { rmName :: String
68 { rmName :: String
48 , rmComments :: Maybe String
69 , rmComments :: Maybe String
@@ -92,7 +113,7 @@ newtype GithubRepo
92 = GithubRepo { runGithubRepo :: String }
113 = GithubRepo { runGithubRepo :: String }
93 deriving (Show, Eq, Ord)
114 deriving (Show, Eq, Ord)
94
115
95−data UploadedPackageError
116+data PackageError
96 = ErrorInPackageMeta BowerError
117 = ErrorInPackageMeta BowerError
97 | InvalidVersion
118 | InvalidVersion
98 | InvalidDeclarationType
119 | InvalidDeclarationType
@@ -124,17 +145,46 @@ ignorePackage (FromDep _ x) = x
124----------------------
145----------------------
125-- Parsing
146-- Parsing
126
147
127−asUploadedPackage :: Parse UploadedPackageError UploadedPackage
148+parseUploadedPackage :: ByteString -> Either (ParseError PackageError) UploadedPackage
128−asUploadedPackage =
149+parseUploadedPackage = parse asUploadedPackage
150+
151+parseVerifiedPackage :: ByteString -> Either (ParseError PackageError) VerifiedPackage
152+parseVerifiedPackage = parse asVerifiedPackage
153+
154+asPackage :: (forall e. Parse e a) -> Parse PackageError (Package a)
155+asPackage uploader =
129− UploadedPackage <$> key "packageMeta" asPackageMeta .! ErrorInPackageMeta
156+ Package <$> key "packageMeta" asPackageMeta .! ErrorInPackageMeta
130− <*> key "version" asVersion
157+ <*> key "version" asVersion
131− <*> key "modules" (eachInArray asRenderedModule)
158+ <*> key "modules" (eachInArray asRenderedModule)
132− <*> key "bookmarks" asBookmarks .! ErrorInPackageMeta
159+ <*> key "bookmarks" asBookmarks .! ErrorInPackageMeta
133− <*> key "resolvedDependencies" asResolvedDependencies
160+ <*> key "resolvedDependencies" asResolvedDependencies
134− <*> key "github" asGithub
161+ <*> key "github" asGithub
162+ <*> key "uploader" uploader
163+
164+asUploadedPackage :: Parse PackageError UploadedPackage
165+asUploadedPackage = asPackage asNotYetKnown
166+
167+asNotYetKnown :: Parse e NotYetKnown
168+asNotYetKnown = NotYetKnown <$ asNull
169+
170+instance A.FromJSON NotYetKnown where
171+ parseJSON = toAesonParser' asNotYetKnown
172+
173+asVerifiedPackage :: Parse PackageError VerifiedPackage
174+asVerifiedPackage = asPackage asGithubUser
175+
176+asGithubUser :: Parse e GithubUser
135− <*> keyMay "uploader" (GithubUser <$> asString)
177+asGithubUser = GithubUser <$> asString
136−
178+
179+instance A.FromJSON GithubUser where
180+ parseJSON = toAesonParser' asGithubUser
181+
182+instance A.FromJSON a => A.FromJSON (Package a) where
183+ -- TODO: actual error display
184+ parseJSON = toAesonParser (T.pack . show)
185+ (asPackage fromAesonParser)
186+
137−asVersion :: Parse UploadedPackageError Version
187+asVersion :: Parse PackageError Version
138asVersion = withString (maybe (Left InvalidVersion) Right . parseVersion')
188asVersion = withString (maybe (Left InvalidVersion) Right . parseVersion')
139
189
140parseVersion' :: String -> Maybe Version
190parseVersion' :: String -> Maybe Version
@@ -143,13 +193,13 @@ parseVersion' str =
143 [(vers, "")] -> Just vers
193 [(vers, "")] -> Just vers
144 _ -> Nothing
194 _ -> Nothing
145
195
146−asRenderedModule :: Parse UploadedPackageError RenderedModule
196+asRenderedModule :: Parse PackageError RenderedModule
147asRenderedModule =
197asRenderedModule =
148 RenderedModule <$> key "name" asString
198 RenderedModule <$> key "name" asString
149 <*> key "comments" (perhaps asString)
199 <*> key "comments" (perhaps asString)
150 <*> key "declarations" (eachInArray asDeclaration)
200 <*> key "declarations" (eachInArray asDeclaration)
151
201
152−asDeclaration :: Parse UploadedPackageError RenderedDeclaration
202+asDeclaration :: Parse PackageError RenderedDeclaration
153asDeclaration =
203asDeclaration =
154 RenderedDeclaration <$> key "title" asString
204 RenderedDeclaration <$> key "title" asString
155 <*> key "comments" (perhaps asString)
205 <*> key "comments" (perhaps asString)
@@ -157,7 +207,7 @@ asDeclaration =
157 <*> key "sourceSpan" (perhaps asSourceSpan)
207 <*> key "sourceSpan" (perhaps asSourceSpan)
158 <*> key "children" (eachInArray asRenderedChildDeclaration)
208 <*> key "children" (eachInArray asRenderedChildDeclaration)
159
209
160−asRenderedChildDeclaration :: Parse UploadedPackageError RenderedChildDeclaration
210+asRenderedChildDeclaration :: Parse PackageError RenderedChildDeclaration
161asRenderedChildDeclaration =
211asRenderedChildDeclaration =
162 RenderedChildDeclaration <$> key "title" asString
212 RenderedChildDeclaration <$> key "title" asString
163 <*> key "comments" (perhaps asString)
213 <*> key "comments" (perhaps asString)
@@ -167,7 +217,7 @@ asRenderedChildDeclaration =
167 where
217 where
168 p .!! err = p .! const err
218 p .!! err = p .! const err
169
219
170−asRenderedChildDeclarationType :: Parse UploadedPackageError RenderedChildDeclarationType
220+asRenderedChildDeclarationType :: Parse PackageError RenderedChildDeclarationType
171asRenderedChildDeclarationType =
221asRenderedChildDeclarationType =
172 withString (maybe (Left InvalidDeclarationType) Right .
222 withString (maybe (Left InvalidDeclarationType) Right .
173 flip lookup childDeclarationTypes)
223 flip lookup childDeclarationTypes)
@@ -188,7 +238,7 @@ asBookmark =
188 build Nothing = Local
238 build Nothing = Local
189 build (Just pn) = FromDep pn
239 build (Just pn) = FromDep pn
190
240
191−asResolvedDependencies :: Parse UploadedPackageError [(PackageName, Version)]
241+asResolvedDependencies :: Parse PackageError [(PackageName, Version)]
192asResolvedDependencies =
242asResolvedDependencies =
193 eachInObjectWithKey (mapLeft ErrorInPackageMeta . parsePackageName . T.unpack) asVersion
243 eachInObjectWithKey (mapLeft ErrorInPackageMeta . parsePackageName . T.unpack) asVersion
194 where
244 where
@@ -207,8 +257,8 @@ asSourceSpan = P.SourceSpan <$> key "name" asString
207---------------------
257---------------------
208-- ToJSON instances
258-- ToJSON instances
209
259
210−instance A.ToJSON UploadedPackage where
260+instance A.ToJSON a => A.ToJSON (Package a) where
211− toJSON UploadedPackage{..} =
261+ toJSON Package{..} =
212 A.object $
262 A.object $
213 [ "packageMeta" .= pkgMeta
263 [ "packageMeta" .= pkgMeta
214 , "version" .= showVersion pkgVersion
264 , "version" .= showVersion pkgVersion
@@ -218,9 +268,11 @@ instance A.ToJSON UploadedPackage where
218 (T.pack . showVersion)
268 (T.pack . showVersion)
219 pkgResolvedDependencies
269 pkgResolvedDependencies
220 , "github" .= pkgGithub
270 , "github" .= pkgGithub
221− ] ++ case pkgUploader of
271+ , "uploader" .= pkgUploader
222− Just u -> [ "uploader" .= u ]
272+ ]
223− Nothing -> []
273+
274+instance A.ToJSON NotYetKnown where
275+ toJSON _ = A.Null
224
276
225instance A.ToJSON RenderedModule where
277instance A.ToJSON RenderedModule where
226 toJSON RenderedModule{..} =
278 toJSON RenderedModule{..} =
src/Language/PureScript/Docs/Utils/HtmlHelpers.hsdeleted−20
@@ -1,20 +0,0 @@
1−
2−module Language.PureScript.Docs.Utils.HtmlHelpers where
3−
4−import Data.String
5−import Lucid
6−
7−text :: String -> Html ()
8−text = toHtml
9−
10−sp :: Html ()
11−sp = text " "
12−
13−para :: String -> Html () -> Html ()
14−para className content = p_ [class_ (fromString className)] content
15−
16−withClass :: String -> Html () -> Html ()
17−withClass className content = span_ [class_ (fromString className)] content
18−
19−linkTo :: String -> Html () -> Html ()
20−linkTo href inner = a_ [href_ (fromString href)] inner