git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Add new executable psc-publish
785324aHarry Garrood
.gitignore+1
compare with golang
unifiedsplit
@@ -9,3 +9,4 @@ cabal.sandbox.config
9*.lksh*
9*.lksh*
10.virthualenv
10.virthualenv
11.psci_modules/
11.psci_modules/
12+tmp/
psc-publish/BoxesHelpers.hsnew file+38
@@ -0,0 +1,38 @@
1+module BoxesHelpers
2+ ( Boxes.Box
3+ , Boxes.nullBox
4+ , module BoxesHelpers
5+ ) where
6+
7+import System.IO (hPutStr, stderr)
8+import qualified Text.PrettyPrint.Boxes as Boxes
9+
10+width :: Int
11+width = 79
12+
13+indentWidth :: Int
14+indentWidth = 2
15+
16+para :: String -> Boxes.Box
17+para = Boxes.para Boxes.left width
18+
19+indented :: Boxes.Box -> Boxes.Box
20+indented b = Boxes.hcat Boxes.left [Boxes.emptyBox 1 indentWidth, b]
21+
22+successivelyIndented :: [String] -> Boxes.Box
23+successivelyIndented [] =
24+ Boxes.nullBox
25+successivelyIndented (x:xs) =
26+ Boxes.vcat Boxes.left [para x, indented (successivelyIndented xs)]
27+
28+vcat :: [Boxes.Box] -> Boxes.Box
29+vcat = Boxes.vcat Boxes.left
30+
31+spacer :: Boxes.Box
32+spacer = Boxes.emptyBox 1 1
33+
34+bulletedList :: (a -> String) -> [a] -> [Boxes.Box]
35+bulletedList f = map (indented . para . ("* " ++) . f)
36+
37+printToStderr :: Boxes.Box -> IO ()
38+printToStderr = hPutStr stderr . Boxes.render
psc-publish/ErrorsWarnings.hsnew file+298
@@ -0,0 +1,298 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module ErrorsWarnings where
4+
5+import Data.Aeson.BetterErrors
6+import Data.Version
7+import Data.Maybe
8+import Data.List (intersperse)
9+import Data.List.NonEmpty (NonEmpty(..))
10+import qualified Data.List.NonEmpty as NonEmpty
11+
12+import qualified Data.Text as T
13+
14+import Control.Exception (IOException)
15+import Web.Bower.PackageMeta (BowerError, PackageName, runPackageName)
16+import qualified Web.Bower.PackageMeta as Bower
17+
18+import BoxesHelpers
19+
20+-- | An error which meant that it was not possible to retrieve metadata for a
21+-- package.
22+data PackageError
23+ = UserError UserError
24+ | InternalError InternalError
25+ | OtherError OtherError
26+ deriving (Show)
27+
28+data PackageWarning
29+ = ResolutionNotVersion PackageName
30+ | UndeclaredDependency PackageName
31+ deriving (Show)
32+
33+-- | An error that should be fixed by the user.
34+data UserError
35+ = BowerJSONNotFound
36+ | CouldntParseBowerJSON (ParseError BowerError)
37+ | BowerJSONNameMissing
38+ | TagMustBeCheckedOut
39+ | AmbiguousVersions [Version] -- Invariant: should contain at least two elements
40+ | BadRepositoryField RepositoryFieldError
41+ | MissingDependencies (NonEmpty PackageName)
42+ deriving (Show)
43+
44+data RepositoryFieldError
45+ = RepositoryFieldMissing
46+ | BadRepositoryType String
47+ | NotOnGithub
48+ deriving (Show)
49+
50+-- | An error that probably indicates a bug in this module.
51+data InternalError
52+ = JSONError JSONSource (ParseError BowerError)
53+ deriving (Show)
54+
55+data JSONSource
56+ = FromFile FilePath
57+ | FromBowerList
58+ deriving (Show)
59+
60+data OtherError
61+ = ProcessFailed String [String] IOException
62+ | IOExceptionThrown IOException
63+ deriving (Show)
64+
65+printError :: PackageError -> IO ()
66+printError = printToStderr . renderError
67+
68+renderError :: PackageError -> Box
69+renderError err =
70+ case err of
71+ UserError e ->
72+ vcat
73+ [ para (concat
74+ [ "There is a problem with your package, which meant that "
75+ , "it could not be published."
76+ ])
77+ , para "Details:"
78+ , indented (displayUserError e)
79+ ]
80+ InternalError e ->
81+ vcat
82+ [ para "Internal error: this is probably a bug. Please report it:"
83+ , indented (para "https://github.com/purescript/purescript/issues/new")
84+ , spacer
85+ , para "Details:"
86+ , successivelyIndented (displayInternalError e)
87+ ]
88+ OtherError e ->
89+ vcat
90+ [ para "An error occurred, and your package could not be published."
91+ , para "Details:"
92+ , indented (displayOtherError e)
93+ ]
94+
95+displayUserError :: UserError -> Box
96+displayUserError e = case e of
97+ BowerJSONNotFound ->
98+ para (concat
99+ [ "The bower.json file was not found. Please create one, or run "
100+ , "`pulp init`."
101+ ])
102+ CouldntParseBowerJSON err ->
103+ vcat
104+ [ successivelyIndented
105+ [ "The bower.json file could not be parsed as JSON:"
106+ , "aeson reported: " ++ show err
107+ ]
108+ , para "Please ensure that your bower.json file is valid JSON."
109+ ]
110+ BowerJSONNameMissing ->
111+ vcat
112+ [ successivelyIndented
113+ [ "In bower.json:"
114+ , "the \"name\" key was not found."
115+ ]
116+ , para "Please give your package a name first."
117+ ]
118+ TagMustBeCheckedOut ->
119+ vcat
120+ [ para (concat
121+ [ "psc-publish requires a tagged version to be checked out in "
122+ , "order to build documentation, and no suitable tag was found. "
123+ , "Please check out a previously tagged version, or tag a new "
124+ , "version."
125+ ])
126+ , spacer
127+ , para "Note: tagged versions must be in one of the following forms:"
128+ , indented (para "* v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")
129+ , indented (para "* {MAJOR}.{MINOR}.{PATCH} (example: \"1.6.2\")")
130+ ]
131+ AmbiguousVersions vs ->
132+ vcat $
133+ [ para (concat
134+ [ "The currently checked out commit seems to have been tagged with "
135+ , "more than 1 version, and I don't know which one should be used. "
136+ , "Please either delete some of the tags, or create a new commit "
137+ , "to tag the desired verson with."
138+ ])
139+ , spacer
140+ , para "Tags for the currently checked out commit:"
141+ ] ++ bulletedList showVersion vs
142+ BadRepositoryField err ->
143+ displayRepositoryError err
144+ MissingDependencies pkgs ->
145+ let singular = NonEmpty.length pkgs == 1
146+ pl a b = if singular then b else a
147+ do_ = pl "do" "does"
148+ dependencies = pl "dependencies" "dependency"
149+ them = pl "them" "it"
150+ in vcat $
151+ [ para (concat
152+ [ "The following Bower ", dependencies, " ", do_, " not appear to be "
153+ , "installed:"
154+ ])
155+ ] ++
156+ bulletedList runPackageName (NonEmpty.toList pkgs)
157+ ++
158+ [ spacer
159+ , para (concat
160+ [ "Please install ", them, " first, by running `bower install`."
161+ ])
162+ ]
163+
164+displayRepositoryError :: RepositoryFieldError -> Box
165+displayRepositoryError err = case err of
166+ RepositoryFieldMissing ->
167+ vcat
168+ [ para (concat
169+ [ "The 'repository' field is not present in your bower.json file. "
170+ , "Without this information, Pursuit would not be able to generate "
171+ , "source links in your package's documentation. Please add one - like "
172+ , "this, for example:"
173+ ])
174+ , spacer
175+ , indented (vcat
176+ [ para "\"repository\": {"
177+ , indented (para "\"type\": \"git\",")
178+ , indented (para "\"url\": \"git://github.com/purescript/purescript-prelude.git\"")
179+ , para "}"
180+ ]
181+ )
182+ ]
183+ BadRepositoryType ty ->
184+ para (concat
185+ [ "In your bower.json file, the repository type is currently listed as "
186+ , "\"" ++ ty ++ "\". Currently, only git repositories are supported. "
187+ , "Please publish your code in a git repository, and then update the "
188+ , "repository type in your bower.json file to \"git\"."
189+ ])
190+ NotOnGithub ->
191+ vcat
192+ [ para (concat
193+ [ "The repository url in your bower.json file does not point to a "
194+ , "GitHub repository. Currently, Pursuit does not support packages "
195+ , "which are not hosted on GitHub."
196+ ])
197+ , spacer
198+ , para (concat
199+ [ "Please update your bower.json file to point to a GitHub repository. "
200+ , "Alternatively, if you would prefer not to host your package on "
201+ , "GitHub, please open an issue:"
202+ ])
203+ , indented (para "https://github.com/purescript/purescript/issues/new")
204+ ]
205+
206+displayInternalError :: InternalError -> [String]
207+displayInternalError e = case e of
208+ JSONError src r ->
209+ [ "Error in JSON " ++ displayJSONSource src ++ ":"
210+ , T.unpack (Bower.displayError r)
211+ ]
212+
213+displayJSONSource :: JSONSource -> String
214+displayJSONSource s = case s of
215+ FromFile fp ->
216+ "in file " ++ show fp
217+ FromBowerList ->
218+ "in the output of `bower list --json --offline`"
219+
220+displayOtherError :: OtherError -> Box
221+displayOtherError e = case e of
222+ ProcessFailed prog args exc ->
223+ successivelyIndented
224+ [ "While running `" ++ prog ++ " " ++ unwords args ++ "`:"
225+ , show exc
226+ ]
227+ IOExceptionThrown exc ->
228+ successivelyIndented
229+ [ "An IO exception occurred:", show exc ]
230+
231+renderWarnings :: [PackageWarning] -> Box
232+renderWarnings =
233+ collectWarnings
234+ [ (getResolutionNotVersion, warnResolutionNotVersions)
235+ , (getUndeclaredDependency, warnUndeclaredDependencies)
236+ ]
237+ where
238+ collectWarnings patterns warns =
239+ let boxes = mapMaybe (collectWarnings' warns) patterns
240+ in vcat
241+ [ para "Warnings:"
242+ , indented (vcat (intersperse spacer boxes))
243+ ]
244+
245+ getResolutionNotVersion (ResolutionNotVersion n) = Just n
246+ getResolutionNotVersion _ = Nothing
247+
248+ getUndeclaredDependency (UndeclaredDependency n) = Just n
249+ getUndeclaredDependency _ = Nothing
250+
251+collectWarnings' :: [PackageWarning] -> ((PackageWarning -> Maybe a), (NonEmpty a -> Box)) -> Maybe Box
252+collectWarnings' warns (pattern, render) =
253+ case mapMaybe pattern warns of
254+ [] -> Nothing
255+ (x:xs) -> Just (render (x :| xs))
256+
257+warnResolutionNotVersions :: NonEmpty PackageName -> Box
258+warnResolutionNotVersions pkgNames =
259+ let singular = NonEmpty.length pkgNames == 1
260+ pl a b = if singular then b else a
261+
262+ packages = pl "packages" "package"
263+ were = pl "were" "was"
264+ anyOfThese = pl "any of these" "this"
265+ these = pl "these" "this"
266+ in vcat $
267+ [ para (concat
268+ ["The following ", packages, " ", were, " not resolved to a version:"])
269+ ] ++
270+ bulletedList runPackageName (NonEmpty.toList pkgNames)
271+ ++
272+ [ spacer
273+ , para (concat
274+ ["Links to types in ", anyOfThese, " ", packages, " will not work. In "
275+ , "order to make links work, edit your bower.json to specify a version"
276+ , " or a version range for ", these, " ", packages, ", and rerun "
277+ , "`bower install`."
278+ ])
279+ ]
280+
281+warnUndeclaredDependencies :: NonEmpty PackageName -> Box
282+warnUndeclaredDependencies pkgNames =
283+ let singular = NonEmpty.length pkgNames == 1
284+ pl a b = if singular then b else a
285+
286+ packages = pl "packages" "package"
287+ are = pl "are" "is"
288+ dependencies = pl "dependencies" "a dependency"
289+ in vcat $
290+ [ para (concat
291+ [ "The following Bower ", packages, " ", are, " installed, but not "
292+ , "declared as ", dependencies, " in your bower.json file:"
293+ ])
294+ ] ++
295+ bulletedList runPackageName (NonEmpty.toList pkgNames)
296+
297+printWarnings :: [PackageWarning] -> IO ()
298+printWarnings = printToStderr . renderWarnings
psc-publish/Main.hsnew file+258
@@ -0,0 +1,258 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards #-}
3+{-# LANGUAGE TupleSections #-}
4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5+
6+import Prelude hiding (userError)
7+
8+import Data.Maybe
9+import Data.Char (isSpace)
10+import Data.String (fromString)
11+import Data.List (stripPrefix, isSuffixOf, (\\))
12+import Data.List.Split (splitOn)
13+import Data.List.NonEmpty (NonEmpty(..))
14+import Data.Version
15+
16+import qualified Data.ByteString.Lazy.Char8 as BL
17+import qualified Data.Text as T
18+
19+import qualified Data.Aeson as A
20+import Data.Aeson.BetterErrors
21+
22+import Control.Applicative
23+import Control.Category ((>>>))
24+import Control.Arrow ((***))
25+import Control.Exception (catch, try)
26+import Control.Monad.Trans.Except
27+import Control.Monad.Error.Class (MonadError(..))
28+import Control.Monad.Writer
29+
30+import System.Directory (doesFileExist)
31+import System.Process (readProcess)
32+import System.Exit (exitFailure)
33+import qualified System.FilePath.Glob as Glob
34+
35+import Web.Bower.PackageMeta (PackageMeta(..), BowerError(..), PackageName,
36+ runPackageName, parsePackageName, Repository(..))
37+import qualified Web.Bower.PackageMeta as Bower
38+
39+import qualified Language.PureScript.Docs as D
40+import Output (parseAndDesugar, getInputAndDepsFiles)
41+import Utils
42+import ErrorsWarnings
43+
44+main :: IO ()
45+main = do
46+ pkg <- preparePackage
47+ BL.putStrLn (A.encode pkg)
48+
49+-- | Attempt to retrieve package metadata from the current directory.
50+-- Calls exitFailure if no package metadata could be retrieved.
51+preparePackage :: IO D.UploadedPackage
52+preparePackage =
53+ runPrepareM preparePackage'
54+ >>= either (\e -> printError e >> exitFailure)
55+ handleWarnings
56+ where
57+ handleWarnings (result, warns) = do
58+ printWarnings warns
59+ return result
60+
61+newtype PrepareM a =
62+ PrepareM { unPrepareM :: WriterT [PackageWarning] (ExceptT PackageError IO) a }
63+ deriving (Functor, Applicative, Monad,
64+ MonadWriter [PackageWarning],
65+ MonadError PackageError)
66+
67+-- This MonadIO instance ensures that IO errors don't crash the program.
68+instance MonadIO PrepareM where
69+ liftIO act =
70+ lift' (try act) >>= either (otherError . IOExceptionThrown) return
71+ where
72+ lift' :: IO a -> PrepareM a
73+ lift' = PrepareM . lift . lift
74+
75+runPrepareM :: PrepareM a -> IO (Either PackageError (a, [PackageWarning]))
76+runPrepareM = runExceptT . runWriterT . unPrepareM
77+
78+warn :: PackageWarning -> PrepareM ()
79+warn w = tell [w]
80+
81+userError :: UserError -> PrepareM a
82+userError = throwError . UserError
83+
84+internalError :: InternalError -> PrepareM a
85+internalError = throwError . InternalError
86+
87+otherError :: OtherError -> PrepareM a
88+otherError = throwError . OtherError
89+
90+catchLeft :: Applicative f => Either a b -> (a -> f b) -> f b
91+catchLeft a f = either f pure a
92+
93+preparePackage' :: PrepareM D.UploadedPackage
94+preparePackage' = do
95+ exists <- liftIO (doesFileExist "bower.json")
96+ unless exists (userError BowerJSONNotFound)
97+
98+ pkgMeta <- liftIO (Bower.decodeFile "bower.json")
99+ >>= flip catchLeft (userError . CouldntParseBowerJSON)
100+ pkgVersion <- getVersionFromGitTag
101+ pkgGithub <- getBowerInfo pkgMeta
102+ (pkgBookmarks, pkgModules) <- liftIO getModulesAndBookmarks
103+
104+ let declaredDeps = map fst (bowerDependencies pkgMeta ++ bowerDevDependencies pkgMeta)
105+ pkgResolvedDependencies <- getResolvedDependencies declaredDeps
106+
107+ let pkgUploader = Nothing
108+
109+ return D.UploadedPackage{..}
110+
111+getModulesAndBookmarks :: IO ([D.Bookmark], [D.RenderedModule])
112+getModulesAndBookmarks = do
113+ (inputFiles, depsFiles) <- getInputAndDepsFiles
114+ parseAndDesugar inputFiles depsFiles $ \bookmarks modules ->
115+ return (bookmarks, map D.renderModule modules)
116+
117+getVersionFromGitTag :: PrepareM Version
118+getVersionFromGitTag = do
119+ out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""
120+ let vs = map clean (lines out)
121+ case mapMaybe D.parseVersion' vs of
122+ [] -> userError TagMustBeCheckedOut
123+ [x] -> return x
124+ xs -> userError (AmbiguousVersions xs)
125+ where
126+ clean =
127+ trimWhitespace >>> dropPrefix "v"
128+ trimWhitespace =
129+ dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse
130+ dropPrefix prefix str =
131+ fromMaybe str (stripPrefix prefix str)
132+
133+getBowerInfo :: PackageMeta -> PrepareM (D.GithubUser, D.GithubRepo)
134+getBowerInfo = either (userError . BadRepositoryField) return . tryExtract
135+ where
136+ tryExtract pkgMeta =
137+ case bowerRepository pkgMeta of
138+ Nothing -> Left RepositoryFieldMissing
139+ Just Repository{..} -> do
140+ unless (repositoryType == "git")
141+ (Left (BadRepositoryType repositoryType))
142+ maybe (Left NotOnGithub) Right (extractGithub repositoryUrl)
143+
144+extractGithub :: String -> Maybe (D.GithubUser, D.GithubRepo)
145+extractGithub =
146+ stripPrefix "git://github.com/"
147+ >>> fmap (splitOn "/")
148+ >=> takeTwo
149+ >>> fmap (D.GithubUser *** (D.GithubRepo . dropDotGit))
150+
151+ where
152+ takeTwo :: [a] -> Maybe (a, a)
153+ takeTwo [x, y] = Just (x, y)
154+ takeTwo _ = Nothing
155+
156+ dropDotGit :: String -> String
157+ dropDotGit str
158+ | ".git" `isSuffixOf` str = take (length str - 4) str
159+ | otherwise = str
160+
161+readProcess' :: String -> [String] -> String -> PrepareM String
162+readProcess' prog args stdin = do
163+ out <- liftIO (catch (Right <$> readProcess prog args stdin)
164+ (return . Left))
165+ either (otherError . ProcessFailed prog args) return out
166+
167+data DependencyStatus
168+ = Missing
169+ | ResolvedOther String
170+ -- ^ Resolved, but to something other than a version. The String argument
171+ -- is the resolution type. The values it can take that I'm aware of are
172+ -- "commit" and "branch".
173+ | ResolvedVersion String
174+ -- ^ Resolved to a version. The String argument is the resolution tag (eg,
175+ -- "v0.1.0").
176+ deriving (Show, Eq)
177+
178+-- Go through all bower dependencies which contain purescript code, and
179+-- extract their versions.
180+--
181+-- In the case where a bower dependency is taken from a particular version,
182+-- that's easy; take that version. In any other case (eg, a branch, or a commit
183+-- sha) we print a warning that documentation links will not work, and avoid
184+-- linking to documentation for any types from that package.
185+--
186+-- The rationale for this is: people will prefer to use a released version
187+-- where possible. If they are not using a released version, then this is
188+-- probably for a reason. However, docs are only ever available for released
189+-- versions. Therefore there will probably be no version of the docs which is
190+-- appropriate to link to, and we should omit links.
191+getResolvedDependencies :: [PackageName] -> PrepareM [(PackageName, Version)]
192+getResolvedDependencies declaredDeps = do
193+ depsBS <- fromString <$> readProcess' "bower" ["list", "--json", "--offline"] ""
194+
195+ deps <- catchLeft (parse asBowerResolvedDependencies depsBS)
196+ (internalError . JSONError FromBowerList)
197+
198+ warnUndeclared declaredDeps (map fst deps)
199+ handleDeps deps
200+
201+ where
202+ asBowerResolvedDependencies ::
203+ Parse BowerError [(PackageName, DependencyStatus)]
204+ asBowerResolvedDependencies =
205+ key "dependencies"
206+ (eachInObjectWithKey (parsePackageName . T.unpack) asDependencyStatus)
207+
208+asDependencyStatus :: Parse e DependencyStatus
209+asDependencyStatus = do
210+ isMissing <- keyOrDefault "missing" False asBool
211+ if isMissing
212+ then
213+ return Missing
214+ else
215+ key "pkgMeta" $
216+ key "_resolution" $ do
217+ type_ <- key "type" asString
218+ case type_ of
219+ "version" -> ResolvedVersion <$> key "tag" asString
220+ other -> return (ResolvedOther other)
221+
222+warnUndeclared :: [PackageName] -> [PackageName] -> PrepareM ()
223+warnUndeclared declared actual =
224+ mapM_ (warn . UndeclaredDependency) (actual \\ declared)
225+
226+handleDeps ::
227+ [(PackageName, DependencyStatus)] -> PrepareM [(PackageName, Version)]
228+handleDeps deps = do
229+ let (missing, notVersion, installed) = partitionDeps deps
230+ case missing of
231+ (x:xs) ->
232+ userError (MissingDependencies (x :| xs))
233+ [] -> do
234+ mapM_ (warn . ResolutionNotVersion . fst) notVersion
235+ let withVersions = mapMaybe tryExtractVersion installed
236+ filterM (liftIO . isPureScript . bowerDir . fst) withVersions
237+
238+ where
239+ partitionDeps = foldr go ([], [], [])
240+ go (pkgName, d) (ms, os, is) =
241+ case d of
242+ Missing -> (pkgName : ms, os, is)
243+ ResolvedOther o -> (ms, (pkgName, o) : os, is)
244+ ResolvedVersion v -> (ms, os, (pkgName, v) : is)
245+
246+ bowerDir pkgName = "bower_components/" ++ runPackageName pkgName
247+
248+tryExtractVersion :: (PackageName, String) -> Maybe (PackageName, Version)
249+tryExtractVersion (pkgName, tag) =
250+ let tag' = fromMaybe tag (stripPrefix "v" tag)
251+ in (pkgName,) <$> D.parseVersion' tag'
252+
253+-- | Returns whether it looks like there is a purescript package checked out
254+-- in the given directory.
255+isPureScript :: FilePath -> IO Bool
256+isPureScript dir = do
257+ files <- Glob.globDir1 purescriptSourceFiles dir
258+ return (not (null files))
psc-publish/Output.hsnew file+131
@@ -0,0 +1,131 @@
1+{-# LANGUAGE TupleSections #-}
2+
3+-- | Functions and types relevant to producing some form of output after
4+-- rendering documentation.
5+
6+module Output where
7+
8+import qualified Data.Map as M
9+import Data.Maybe (mapMaybe)
10+import Data.List.Split (splitOn)
11+import Data.List (stripPrefix)
12+
13+import Control.Applicative
14+import Control.Monad
15+import Control.Arrow (first)
16+
17+import qualified Language.PureScript as P
18+import qualified Language.PureScript.Constants as C
19+
20+import System.Exit (exitFailure)
21+import System.IO (hPutStrLn, stderr)
22+
23+import Language.PureScript.Docs
24+import Web.Bower.PackageMeta hiding (Version)
25+
26+import Utils
27+
28+-- | Specifies whether a PureScript source file is considered as:
29+--
30+-- 1) with the `Local` constructor, a target source file, i.e., we want to see
31+-- its modules in the output
32+-- 2) with the `FromDep` constructor, a dependencies source file, i.e. we do
33+-- not want its modules in the output; it is there to enable desugaring, and
34+-- to ensure that links between modules are constructed correctly.
35+type FileInfo = InPackage FilePath
36+
37+fileInfoToString :: FileInfo -> FilePath
38+fileInfoToString (Local fn) = fn
39+fileInfoToString (FromDep _ fn) = fn
40+
41+addDefaultImport :: P.ModuleName -> P.Module -> P.Module
42+addDefaultImport toImport m@(P.Module coms mn decls exps) =
43+ if isExistingImport `any` decls || mn == toImport then m
44+ else P.Module coms mn (P.ImportDeclaration toImport P.Implicit Nothing : decls) exps
45+ where
46+ isExistingImport (P.ImportDeclaration mn' _ _) | mn' == toImport = True
47+ isExistingImport (P.PositionedDeclaration _ _ d) = isExistingImport d
48+ isExistingImport _ = False
49+
50+importPrim :: P.Module -> P.Module
51+importPrim = addDefaultImport (P.ModuleName [P.ProperName C.prim])
52+
53+importPrelude :: P.Module -> P.Module
54+importPrelude = addDefaultImport (P.ModuleName [P.ProperName C.prelude])
55+
56+desugar :: [P.Module] -> Either P.MultipleErrors [P.Module]
57+desugar = P.evalSupplyT 0 . desugar'
58+ where
59+ desugar' :: [P.Module] -> P.SupplyT (Either P.MultipleErrors) [P.Module]
60+ desugar' = mapM P.desugarDoModule >=> P.desugarCasesModule >=> P.desugarImports
61+
62+parseFile :: FilePath -> IO (FilePath, String)
63+parseFile input' = (,) input' <$> readFile input'
64+
65+parseAndDesugar ::
66+ [FilePath]
67+ -> [(PackageName, FilePath)]
68+ -> ([Bookmark] -> [P.Module] -> IO a)
69+ -> IO a
70+parseAndDesugar inputFiles depsFiles callback = do
71+ inputFiles' <- mapM (parseAs Local) inputFiles
72+ depsFiles' <- mapM (\(pkgName, f) -> parseAs (FromDep pkgName) f) depsFiles
73+
74+ case P.parseModulesFromFiles fileInfoToString (inputFiles' ++ depsFiles') of
75+ Left err -> do
76+ hPutStrLn stderr "parse failed:"
77+ hPutStrLn stderr $ show err
78+ exitFailure
79+ Right ms -> do
80+ let depsModules = getDepsModuleNames (map (\(fp, m) -> (,m) <$> fp) ms)
81+ case P.sortModules . map (importPrim . importPrelude . snd) $ ms of
82+ Left e' -> do
83+ hPutStrLn stderr "sortModules failed:"
84+ hPutStrLn stderr (P.prettyPrintMultipleErrors False e')
85+ exitFailure
86+ Right (ms', _) ->
87+ case desugar ms' of
88+ Left err -> do
89+ hPutStrLn stderr "desugar failed:"
90+ hPutStrLn stderr (P.prettyPrintMultipleErrors False err)
91+ exitFailure
92+ Right modules ->
93+ let modules' = map (addPackage depsModules) modules
94+ bookmarks = concatMap collectBookmarks modules'
95+ in callback bookmarks (takeLocals modules')
96+
97+ where
98+ parseAs :: (FilePath -> a) -> FilePath -> IO (a, String)
99+ parseAs g = fmap (first g) . parseFile
100+
101+ getDepsModuleNames :: [InPackage (FilePath, P.Module)] -> M.Map P.ModuleName PackageName
102+ getDepsModuleNames = foldl go M.empty
103+ where
104+ go deps p = deps # case p of
105+ Local _ -> id
106+ FromDep pkgName (_, m) -> M.insert (P.getModuleName m) pkgName
107+ (#) = flip ($)
108+
109+ addPackage :: M.Map P.ModuleName PackageName -> P.Module -> InPackage P.Module
110+ addPackage depsModules m =
111+ case M.lookup (P.getModuleName m) depsModules of
112+ Just pkgName -> FromDep pkgName m
113+ Nothing -> Local m
114+
115+getInputAndDepsFiles :: IO ([FilePath], [(PackageName, FilePath)])
116+getInputAndDepsFiles = do
117+ inputFiles <- globRelative purescriptSourceFiles
118+ depsFiles' <- globRelative purescriptDepsFiles
119+ return (inputFiles, mapMaybe withPackageName depsFiles')
120+
121+withPackageName :: FilePath -> Maybe (PackageName, FilePath)
122+withPackageName fp = (,fp) <$> getPackageName fp
123+
124+getPackageName :: FilePath -> Maybe PackageName
125+getPackageName fp = do
126+ let xs = splitOn "/" fp
127+ ys <- stripPrefix ["bower_components"] xs
128+ y <- headMay ys
129+ case mkPackageName y of
130+ Right name -> Just name
131+ Left _ -> Nothing
psc-publish/Utils.hsnew file+26
@@ -0,0 +1,26 @@
1+
2+module Utils where
3+
4+import Data.List
5+import Data.Maybe
6+import System.Directory
7+import qualified System.FilePath.Glob as Glob
8+
9+headMay :: [a] -> Maybe a
10+headMay (x:_) = Just x
11+headMay [] = Nothing
12+
13+-- | Glob relative to the current directory, and produce relative pathnames.
14+globRelative :: Glob.Pattern -> IO [FilePath]
15+globRelative pat = do
16+ currentDir <- getCurrentDirectory
17+ filesAbsolute <- Glob.globDir1 pat currentDir
18+ return (mapMaybe (stripPrefix (currentDir ++ "/")) filesAbsolute)
19+
20+-- | Glob pattern for PureScript source files.
21+purescriptSourceFiles :: Glob.Pattern
22+purescriptSourceFiles = Glob.compile "src/**/*.purs"
23+
24+-- | Glob pattern for PureScript dependency files.
25+purescriptDepsFiles :: Glob.Pattern
26+purescriptDepsFiles = Glob.compile "bower_components/*/src/**/*.purs"
psc-publish/tests/Test.hsnew file+76
@@ -0,0 +1,76 @@
1+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
2+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
3+
4+-- | To run these tests:
5+--
6+-- * `cabal repl psc-publish`
7+-- * `:l psc-publish/tests/Test.hs`
8+-- * `test`
9+
10+module Test where
11+
12+import Control.Monad
13+import Control.Applicative
14+import System.Process
15+import System.Directory
16+import qualified Data.ByteString.Lazy as BL
17+import Data.ByteString.Lazy (ByteString)
18+import qualified Data.Aeson as A
19+import Data.Aeson.BetterErrors
20+
21+import Main
22+import Language.PureScript.Docs
23+
24+packageName = "purescript-integers"
25+packageUrl = "https://github.com/purescript/" ++ packageName
26+packageDir = "tmp/" ++ packageName
27+
28+pushd :: FilePath -> IO a -> IO a
29+pushd dir act = do
30+ original <- getCurrentDirectory
31+ setCurrentDirectory dir
32+ result <- act
33+ setCurrentDirectory original
34+ return result
35+
36+clonePackage :: IO ()
37+clonePackage = do
38+ createDirectoryIfMissing True packageDir
39+ pushd packageDir $ do
40+ exists <- doesDirectoryExist ".git"
41+ unless exists $ do
42+ putStrLn ("Cloning " ++ packageName ++ " into " ++ packageDir ++ "...")
43+ readProcess "git" ["clone", packageUrl, "."] "" >>= putStr
44+
45+bowerInstall :: IO ()
46+bowerInstall = do
47+ pushd packageDir $ do
48+ readProcess "bower" ["install"] "" >>= putStr
49+
50+getPackage :: IO UploadedPackage
51+getPackage = do
52+ clonePackage
53+ bowerInstall
54+ pushd packageDir preparePackage
55+
56+data TestResult
57+ = ParseFailed (ParseError UploadedPackageError)
58+ | Mismatch ByteString ByteString -- ^ encoding before, encoding after
59+ | Pass ByteString
60+ deriving (Show)
61+
62+-- | Test JSON encoding/decoding; parse the package, roundtrip to/from JSON,
63+-- and check we get the same string.
64+test :: IO TestResult
65+test = roundTrip <$> getPackage
66+
67+roundTrip :: UploadedPackage -> TestResult
68+roundTrip pkg =
69+ let before = A.encode pkg
70+ in case parse asUploadedPackage before of
71+ Left err -> ParseFailed err
72+ Right parsed -> do
73+ let after = A.encode parsed
74+ if before == after
75+ then Pass before
76+ else Mismatch before after
purescript.cabal+34−4
@@ -26,6 +26,7 @@ library
26 build-depends: base >=4.6 && <5,
26 build-depends: base >=4.6 && <5,
27 containers -any,
27 containers -any,
28 unordered-containers -any,
28 unordered-containers -any,
29+ dlist -any,
29 directory >= 1.2,
30 directory >= 1.2,
30 filepath -any,
31 filepath -any,
31 mtl >= 2.1.0 && < 2.3.0,
32 mtl >= 2.1.0 && < 2.3.0,
@@ -35,7 +36,18 @@ library
35 utf8-string >= 1 && < 2,
36 utf8-string >= 1 && < 2,
36 pattern-arrows >= 0.0.2 && < 0.1,
37 pattern-arrows >= 0.0.2 && < 0.1,
37 time -any,
38 time -any,
38− boxes >= 0.1.4 && < 0.2.0
39+ boxes >= 0.1.4 && < 0.2.0,
40+ aeson >= 0.8 && < 0.9,
41+ vector -any,
42+ bower-json >= 0.7,
43+ aeson-better-errors >= 0.5,
44+ bytestring -any,
45+ text -any,
46+ split -any,
47+ lucid -any,
48+ blaze-html -any,
49+ data-default -any,
50+ cheapskate -any
39 exposed-modules: Language.PureScript
51 exposed-modules: Language.PureScript
40 Language.PureScript.AST
52 Language.PureScript.AST
41 Language.PureScript.AST.Binders
53 Language.PureScript.AST.Binders
@@ -118,8 +130,10 @@ library
118 Language.PureScript.Docs.RenderedCode
130 Language.PureScript.Docs.RenderedCode
119 Language.PureScript.Docs.RenderedCode.Types
131 Language.PureScript.Docs.RenderedCode.Types
120 Language.PureScript.Docs.RenderedCode.Render
132 Language.PureScript.Docs.RenderedCode.Render
121− Language.PureScript.Docs.MonoidExtras
122 Language.PureScript.Docs.AsMarkdown
133 Language.PureScript.Docs.AsMarkdown
134+ Language.PureScript.Docs.AsHtml
135+ Language.PureScript.Docs.Utils.HtmlHelpers
136+ Language.PureScript.Docs.Utils.MonoidExtras
123
137
124 Control.Monad.Unify
138 Control.Monad.Unify
125 Control.Monad.Supply
139 Control.Monad.Supply
@@ -169,8 +183,7 @@ executable psci
169
183
170executable psc-docs
184executable psc-docs
171 build-depends: base >=4 && <5, purescript -any,
185 build-depends: base >=4 && <5, purescript -any,
172− optparse-applicative >= 0.10.0, process -any, mtl -any,
186+ optparse-applicative >= 0.10.0, process -any, mtl -any
173− pattern-arrows -any
174 main-is: Main.hs
187 main-is: Main.hs
175 buildable: True
188 buildable: True
176 hs-source-dirs: psc-docs
189 hs-source-dirs: psc-docs
@@ -179,6 +192,23 @@ executable psc-docs
179 Tags
192 Tags
180 ghc-options: -Wall -O2
193 ghc-options: -Wall -O2
181
194
195+executable psc-publish
196+ build-depends: base >=4 && <5, purescript -any,
197+ optparse-applicative >= 0.10.0, process -any, mtl -any,
198+ pattern-arrows -any, aeson -any, bytestring -any,
199+ directory -any, transformers -any, text -any, containers
200+ -any, boxes -any, split -any, Glob -any, aeson-better-errors
201+ -any, transformers-compat -any, bower-json -any, semigroups
202+ -any
203+ main-is: Main.hs
204+ buildable: True
205+ hs-source-dirs: psc-publish
206+ other-modules: Output
207+ Utils
208+ ErrorsWarnings
209+ BoxesHelpers
210+ ghc-options: -Wall -O2
211+
182executable psc-hierarchy
212executable psc-hierarchy
183 build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,
213 build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,
184 process -any, mtl -any, parsec -any, filepath -any, directory -any
214 process -any, mtl -any, parsec -any, filepath -any, directory -any
src/Language/PureScript/AST/SourcePos.hs+16−3
@@ -12,11 +12,13 @@
12--
12--
13-----------------------------------------------------------------------------
13-----------------------------------------------------------------------------
14
14
15−{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
15+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, RecordWildCards, OverloadedStrings #-}
16
16
17module Language.PureScript.AST.SourcePos where
17module Language.PureScript.AST.SourcePos where
18
18
19import qualified Data.Data as D
19import qualified Data.Data as D
20+import Data.Aeson ((.=))
21+import qualified Data.Aeson as A
20
22
21-- |
23-- |
22-- Source position information
24-- Source position information
@@ -30,13 +32,17 @@ data SourcePos = SourcePos
30 -- Column number
32 -- Column number
31 --
33 --
32 , sourcePosColumn :: Int
34 , sourcePosColumn :: Int
33− } deriving (Eq, Show, D.Data, D.Typeable)
35+ } deriving (Eq, Ord, Show, D.Data, D.Typeable)
34
36
35displaySourcePos :: SourcePos -> String
37displaySourcePos :: SourcePos -> String
36displaySourcePos sp =
38displaySourcePos sp =
37 "line " ++ show (sourcePosLine sp) ++
39 "line " ++ show (sourcePosLine sp) ++
38 ", column " ++ show (sourcePosColumn sp)
40 ", column " ++ show (sourcePosColumn sp)
39
41
42+instance A.ToJSON SourcePos where
43+ toJSON SourcePos{..} =
44+ A.toJSON [sourcePosLine, sourcePosColumn]
45+
40data SourceSpan = SourceSpan
46data SourceSpan = SourceSpan
41 { -- |
47 { -- |
42 -- Source name
48 -- Source name
@@ -49,10 +55,17 @@ data SourceSpan = SourceSpan
49 -- End of the span
55 -- End of the span
50 --
56 --
51 , spanEnd :: SourcePos
57 , spanEnd :: SourcePos
52− } deriving (Eq, Show, D.Data, D.Typeable)
58+ } deriving (Eq, Ord, Show, D.Data, D.Typeable)
53
59
54displaySourceSpan :: SourceSpan -> String
60displaySourceSpan :: SourceSpan -> String
55displaySourceSpan sp =
61displaySourceSpan sp =
56 spanName sp ++ " " ++
62 spanName sp ++ " " ++
57 displaySourcePos (spanStart sp) ++ " - " ++
63 displaySourcePos (spanStart sp) ++ " - " ++
58 displaySourcePos (spanEnd sp)
64 displaySourcePos (spanEnd sp)
65+
66+instance A.ToJSON SourceSpan where
67+ toJSON SourceSpan{..} =
68+ A.object [ "name" .= spanName
69+ , "start" .= spanStart
70+ , "end" .= spanEnd
71+ ]
src/Language/PureScript/Docs.hs+1−1
@@ -9,4 +9,4 @@ module Language.PureScript.Docs (
9import Language.PureScript.Docs.Types as Docs
9import Language.PureScript.Docs.Types as Docs
10import Language.PureScript.Docs.RenderedCode.Types as Docs
10import Language.PureScript.Docs.RenderedCode.Types as Docs
11import Language.PureScript.Docs.RenderedCode.Render as Docs
11import Language.PureScript.Docs.RenderedCode.Render as Docs
12−
12+import Language.PureScript.Docs.Render as Docs
src/Language/PureScript/Docs/AsHtml.hsnew file+219
@@ -0,0 +1,219 @@
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/Render.hs+14−12
@@ -6,30 +6,21 @@
6-- | Functions for rendering documentation generated from PureScript code.
6-- | Functions for rendering documentation generated from PureScript code.
7
7
8module Language.PureScript.Docs.Render (
8module Language.PureScript.Docs.Render (
9− renderPackage,
9+ renderModule,
10− renderModule
10+ collectBookmarks
11) where
11) where
12
12
13import Control.Monad
13import Control.Monad
14import Data.Either
14import Data.Either
15−import Data.Version (Version)
16import Data.Monoid ((<>))
15import Data.Monoid ((<>))
17import Data.Maybe (mapMaybe)
16import Data.Maybe (mapMaybe)
18import Data.List (nub)
17import Data.List (nub)
19
18
20import qualified Language.PureScript as P
19import qualified Language.PureScript as P
21
20
22−import Language.PureScript.Docs.MonoidExtras
23import Language.PureScript.Docs.RenderedCode
21import Language.PureScript.Docs.RenderedCode
24import Language.PureScript.Docs.Types
22import Language.PureScript.Docs.Types
25−
23+import Language.PureScript.Docs.Utils.MonoidExtras
26−-- |
27−-- Render a Package, given its name, its current version, and a list of
28−-- contained modules.
29−--
30−renderPackage :: String -> Version -> [P.Module] -> RenderedPackage
31−renderPackage name vers mods =
32− RenderedPackage name vers (map renderModule mods)
33
24
34-- |
25-- |
35-- Render a single Module.
26-- Render a single Module.
@@ -235,3 +226,14 @@ renderComments cs = do
235toTypeVar :: (String, Maybe P.Kind) -> P.Type
226toTypeVar :: (String, Maybe P.Kind) -> P.Type
236toTypeVar (s, Nothing) = P.TypeVar s
227toTypeVar (s, Nothing) = P.TypeVar s
237toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k
228toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k
229+
230+collectBookmarks :: InPackage P.Module -> [Bookmark]
231+collectBookmarks (Local m) = map Local (collectBookmarks' m)
232+collectBookmarks (FromDep pkg m) = map (FromDep pkg) (collectBookmarks' m)
233+
234+collectBookmarks' :: P.Module -> [(P.ModuleName, String)]
235+collectBookmarks' m =
236+ map (P.getModuleName m, )
237+ (mapMaybe getDeclarationTitle
238+ (P.exportedDeclarations m))
239+
src/Language/PureScript/Docs/RenderedCode/Render.hs+2−9
@@ -20,8 +20,8 @@ import Language.PureScript.Kinds
20import Language.PureScript.Pretty.Kinds
20import Language.PureScript.Pretty.Kinds
21import Language.PureScript.Environment
21import Language.PureScript.Environment
22
22
23−import Language.PureScript.Docs.MonoidExtras
24import Language.PureScript.Docs.RenderedCode.Types
23import Language.PureScript.Docs.RenderedCode.Types
24+import Language.PureScript.Docs.Utils.MonoidExtras
25
25
26typeLiterals :: Pattern () Type RenderedCode
26typeLiterals :: Pattern () Type RenderedCode
27typeLiterals = mkPattern match
27typeLiterals = mkPattern match
@@ -36,14 +36,8 @@ typeLiterals = mkPattern match
36 , renderRow row
36 , renderRow row
37 , syntax "}"
37 , syntax "}"
38 ]
38 ]
39− match (PrettyPrintArray ty) =
40− Just $ mconcat
41− [ syntax "["
42− , renderType ty
43− , syntax "]"
44− ]
45 match (TypeConstructor (Qualified mn name)) =
39 match (TypeConstructor (Qualified mn name)) =
46− Just (ctor (show name) (toContainingModule mn))
40+ Just (ctor (show name) (maybeToContainingModule mn))
47 match (ConstrainedType deps ty) =
41 match (ConstrainedType deps ty) =
48 Just $ mintersperse sp
42 Just $ mintersperse sp
49 [ syntax "(" <> constraints <> syntax ")"
43 [ syntax "(" <> constraints <> syntax ")"
@@ -137,7 +131,6 @@ dePrim other = other
137
131
138convert :: Type -> Type
132convert :: Type -> Type
139convert (TypeApp (TypeApp f arg) ret) | f == tyFunction = PrettyPrintFunction arg ret
133convert (TypeApp (TypeApp f arg) ret) | f == tyFunction = PrettyPrintFunction arg ret
140−convert (TypeApp a el) | a == tyArray = PrettyPrintArray el
141convert (TypeApp o r) | o == tyObject = PrettyPrintObject r
134convert (TypeApp o r) | o == tyObject = PrettyPrintObject r
142convert other = other
135convert other = other
143
136
src/Language/PureScript/Docs/RenderedCode/Types.hs+68−4
@@ -1,14 +1,19 @@
1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
2
3
3-- | Data types and functions for representing a simplified form of PureScript
4-- | Data types and functions for representing a simplified form of PureScript
4-- code, intended for use in e.g. HTML documentation.
5-- code, intended for use in e.g. HTML documentation.
5
6
6module Language.PureScript.Docs.RenderedCode.Types
7module Language.PureScript.Docs.RenderedCode.Types
7 ( RenderedCodeElement(..)
8 ( RenderedCodeElement(..)
9+ , asRenderedCodeElement
8 , ContainingModule(..)
10 , ContainingModule(..)
9− , toContainingModule
11+ , asContainingModule
12+ , containingModuleToMaybe
13+ , maybeToContainingModule
10 , fromContainingModule
14 , fromContainingModule
11 , RenderedCode
15 , RenderedCode
16+ , asRenderedCode
12 , outputWith
17 , outputWith
13 , sp
18 , sp
14 , syntax
19 , syntax
@@ -25,8 +30,12 @@ module Language.PureScript.Docs.RenderedCode.Types
25 , keywordWhere
30 , keywordWhere
26 ) where
31 ) where
27
32
33+import Control.Applicative ((<$>), (<*>), (*>), pure)
28import Data.Foldable
34import Data.Foldable
29import Data.Monoid
35import Data.Monoid
36+import qualified Data.Aeson as A
37+import Data.Aeson.BetterErrors
38+import Control.Monad.Error.Class (MonadError(..))
30
39
31import qualified Language.PureScript as P
40import qualified Language.PureScript as P
32
41
@@ -43,6 +52,40 @@ data RenderedCodeElement
43 | Space
52 | Space
44 deriving (Show, Eq, Ord)
53 deriving (Show, Eq, Ord)
45
54
55+instance A.ToJSON RenderedCodeElement where
56+ toJSON (Syntax str) =
57+ A.toJSON ["syntax", str]
58+ toJSON (Ident str) =
59+ A.toJSON ["ident", str]
60+ toJSON (Ctor str mn) =
61+ A.toJSON ["ctor", A.toJSON str, A.toJSON mn ]
62+ toJSON (Kind str) =
63+ A.toJSON ["kind", str]
64+ toJSON (Keyword str) =
65+ A.toJSON ["keyword", str]
66+ toJSON Space =
67+ A.toJSON ["space" :: String]
68+
69+asRenderedCodeElement :: Parse String RenderedCodeElement
70+asRenderedCodeElement =
71+ a Syntax "syntax" <|>
72+ a Ident "ident" <|>
73+ asCtor <|>
74+ a Kind "kind" <|>
75+ a Keyword "keyword" <|>
76+ asSpace <|>
77+ unableToParse
78+ where
79+ p <|> q = catchError p (const q)
80+
81+ a ctor' ctorStr = ctor' <$> (nth 0 (withString (eq ctorStr)) *> nth 1 asString)
82+ asCtor = nth 0 (withString (eq "ctor")) *> (Ctor <$> nth 1 asString <*> nth 2 asContainingModule)
83+ asSpace = nth 0 (withString (eq "space")) *> pure Space
84+
85+ eq s s' = if s == s' then Right () else Left ""
86+
87+ unableToParse = withString (Left . show)
88+
46-- |
89-- |
47-- This type is isomorphic to 'Maybe' 'P.ModuleName'. It makes code a bit easier
90-- This type is isomorphic to 'Maybe' 'P.ModuleName'. It makes code a bit easier
48-- to read, as the meaning is more explicit.
91-- to read, as the meaning is more explicit.
@@ -52,13 +95,28 @@ data ContainingModule
52 | OtherModule P.ModuleName
95 | OtherModule P.ModuleName
53 deriving (Show, Eq, Ord)
96 deriving (Show, Eq, Ord)
54
97
98+instance A.ToJSON ContainingModule where
99+ toJSON mn = A.toJSON (P.runModuleName <$> containingModuleToMaybe mn)
100+
101+asContainingModule :: Parse e ContainingModule
102+asContainingModule =
103+ maybeToContainingModule <$> perhaps (P.moduleNameFromString <$> asString)
104+
55-- |
105-- |
56-- Convert a 'Maybe' 'P.ModuleName' to a 'ContainingModule', using the obvious
106-- Convert a 'Maybe' 'P.ModuleName' to a 'ContainingModule', using the obvious
57-- isomorphism.
107-- isomorphism.
58--
108--
59−toContainingModule :: Maybe P.ModuleName -> ContainingModule
109+maybeToContainingModule :: Maybe P.ModuleName -> ContainingModule
60−toContainingModule Nothing = ThisModule
110+maybeToContainingModule Nothing = ThisModule
61−toContainingModule (Just mn) = OtherModule mn
111+maybeToContainingModule (Just mn) = OtherModule mn
112+
113+-- |
114+-- Convert a 'ContainingModule' to a 'Maybe' 'P.ModuleName', using the obvious
115+-- isomorphism.
116+--
117+containingModuleToMaybe :: ContainingModule -> Maybe P.ModuleName
118+containingModuleToMaybe ThisModule = Nothing
119+containingModuleToMaybe (OtherModule mn) = Just mn
62
120
63-- |
121-- |
64-- A version of 'fromMaybe' for 'ContainingModule' values.
122-- A version of 'fromMaybe' for 'ContainingModule' values.
@@ -75,6 +133,12 @@ newtype RenderedCode
75 = RC { unRC :: [RenderedCodeElement] }
133 = RC { unRC :: [RenderedCodeElement] }
76 deriving (Show, Eq, Ord, Monoid)
134 deriving (Show, Eq, Ord, Monoid)
77
135
136+instance A.ToJSON RenderedCode where
137+ toJSON (RC elems) = A.toJSON elems
138+
139+asRenderedCode :: Parse String RenderedCode
140+asRenderedCode = RC <$> eachInArray asRenderedCodeElement
141+
78-- |
142-- |
79-- This function allows conversion of a 'RenderedCode' value into a value of
143-- This function allows conversion of a 'RenderedCode' value into a value of
80-- some other type (for example, plain text, or HTML). The first argument
144-- some other type (for example, plain text, or HTML). The first argument
src/Language/PureScript/Docs/Types.hs+238−9
@@ -1,3 +1,6 @@
1+{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE TupleSections #-}
1
4
2module Language.PureScript.Docs.Types
5module Language.PureScript.Docs.Types
3 ( module Language.PureScript.Docs.Types
6 ( module Language.PureScript.Docs.Types
@@ -5,24 +8,47 @@ module Language.PureScript.Docs.Types
5 )
8 )
6 where
9 where
7
10
11+import Control.Arrow (first, (***))
12+import Control.Applicative ((<$>), (<*>))
13+import Data.Char
14+import Data.Maybe (mapMaybe)
8import Data.Version
15import Data.Version
16+import Data.Aeson ((.=))
17+import qualified Data.Aeson as A
18+import Data.Aeson.BetterErrors
19+import Text.ParserCombinators.ReadP (readP_to_S)
20+import Data.Text (Text)
21+import qualified Data.Text as T
22+
23+import Web.Bower.PackageMeta hiding (Version)
24+
9import qualified Language.PureScript as P
25import qualified Language.PureScript as P
10
26
11−import Language.PureScript.Docs.RenderedCode as ReExports (RenderedCode, ContainingModule(..))
27+import Language.PureScript.Docs.RenderedCode as ReExports
28+ (RenderedCode, asRenderedCode,
29+ ContainingModule(..), asContainingModule,
30+ RenderedCodeElement(..), asRenderedCodeElement)
12
31
13−data RenderedPackage = RenderedPackage
32+--------------------
14− { rpName :: String
33+-- Types
34+
35+data UploadedPackage = UploadedPackage
36+ { pkgMeta :: PackageMeta
15− , rpVersion :: Version
37+ , pkgVersion :: Version
16− , rpModules :: [RenderedModule]
38+ , pkgModules :: [RenderedModule]
39+ , pkgBookmarks :: [Bookmark]
40+ , pkgResolvedDependencies :: [(PackageName, Version)]
41+ , pkgGithub :: (GithubUser, GithubRepo)
42+ , pkgUploader :: Maybe GithubUser
17 }
43 }
18− deriving (Show)
44+ deriving (Show, Eq, Ord)
19
45
20data RenderedModule = RenderedModule
46data RenderedModule = RenderedModule
21 { rmName :: String
47 { rmName :: String
22 , rmComments :: Maybe String
48 , rmComments :: Maybe String
23 , rmDeclarations :: [RenderedDeclaration]
49 , rmDeclarations :: [RenderedDeclaration]
24 }
50 }
25− deriving (Show)
51+ deriving (Show, Eq, Ord)
26
52
27data RenderedDeclaration = RenderedDeclaration
53data RenderedDeclaration = RenderedDeclaration
28 { rdTitle :: String
54 { rdTitle :: String
@@ -31,7 +57,7 @@ data RenderedDeclaration = RenderedDeclaration
31 , rdSourceSpan :: Maybe P.SourceSpan
57 , rdSourceSpan :: Maybe P.SourceSpan
32 , rdChildren :: [RenderedChildDeclaration]
58 , rdChildren :: [RenderedChildDeclaration]
33 }
59 }
34− deriving (Show)
60+ deriving (Show, Eq, Ord)
35
61
36data RenderedChildDeclaration = RenderedChildDeclaration
62data RenderedChildDeclaration = RenderedChildDeclaration
37 { rcdTitle :: String
63 { rcdTitle :: String
@@ -40,10 +66,213 @@ data RenderedChildDeclaration = RenderedChildDeclaration
40 , rcdSourceSpan :: Maybe P.SourceSpan
66 , rcdSourceSpan :: Maybe P.SourceSpan
41 , rcdType :: RenderedChildDeclarationType
67 , rcdType :: RenderedChildDeclarationType
42 }
68 }
43− deriving (Show)
69+ deriving (Show, Eq, Ord)
44
70
45data RenderedChildDeclarationType
71data RenderedChildDeclarationType
46 = ChildInstance
72 = ChildInstance
47 | ChildDataConstructor
73 | ChildDataConstructor
48 | ChildTypeClassMember
74 | ChildTypeClassMember
75+ deriving (Show, Eq, Ord, Bounded, Enum)
76+
77+childDeclTypeToString :: RenderedChildDeclarationType -> String
78+childDeclTypeToString = withHead toLower . drop 5 . show
79+ where
80+ withHead f (x:xs) = f x : xs
81+ withHead _ [] = []
82+
83+childDeclarationTypes :: [(String, RenderedChildDeclarationType)]
84+childDeclarationTypes =
85+ map (\t -> (childDeclTypeToString t, t)) [minBound .. maxBound]
86+
87+newtype GithubUser
88+ = GithubUser { runGithubUser :: String }
89+ deriving (Show, Eq, Ord)
90+
91+newtype GithubRepo
92+ = GithubRepo { runGithubRepo :: String }
49 deriving (Show, Eq, Ord)
93 deriving (Show, Eq, Ord)
94+
95+data UploadedPackageError
96+ = ErrorInPackageMeta BowerError
97+ | InvalidVersion
98+ | InvalidDeclarationType
99+ | InvalidRenderedCode String
100+ deriving (Show, Eq, Ord)
101+
102+type Bookmark = InPackage (P.ModuleName, String)
103+
104+data InPackage a
105+ = Local a
106+ | FromDep PackageName a
107+ deriving (Show, Eq, Ord)
108+
109+instance Functor InPackage where
110+ fmap f (Local x) = Local (f x)
111+ fmap f (FromDep pkgName x) = FromDep pkgName (f x)
112+
113+takeLocal :: InPackage a -> Maybe a
114+takeLocal (Local a) = Just a
115+takeLocal _ = Nothing
116+
117+takeLocals :: [InPackage a] -> [a]
118+takeLocals = mapMaybe takeLocal
119+
120+ignorePackage :: InPackage a -> a
121+ignorePackage (Local x) = x
122+ignorePackage (FromDep _ x) = x
123+
124+----------------------
125+-- Parsing
126+
127+asUploadedPackage :: Parse UploadedPackageError UploadedPackage
128+asUploadedPackage =
129+ UploadedPackage <$> key "packageMeta" asPackageMeta .! ErrorInPackageMeta
130+ <*> key "version" asVersion
131+ <*> key "modules" (eachInArray asRenderedModule)
132+ <*> key "bookmarks" asBookmarks .! ErrorInPackageMeta
133+ <*> key "resolvedDependencies" asResolvedDependencies
134+ <*> key "github" asGithub
135+ <*> keyMay "uploader" (GithubUser <$> asString)
136+
137+asVersion :: Parse UploadedPackageError Version
138+asVersion = withString (maybe (Left InvalidVersion) Right . parseVersion')
139+
140+parseVersion' :: String -> Maybe Version
141+parseVersion' str =
142+ case filter (null . snd) $ readP_to_S parseVersion str of
143+ [(vers, "")] -> Just vers
144+ _ -> Nothing
145+
146+asRenderedModule :: Parse UploadedPackageError RenderedModule
147+asRenderedModule =
148+ RenderedModule <$> key "name" asString
149+ <*> key "comments" (perhaps asString)
150+ <*> key "declarations" (eachInArray asDeclaration)
151+
152+asDeclaration :: Parse UploadedPackageError RenderedDeclaration
153+asDeclaration =
154+ RenderedDeclaration <$> key "title" asString
155+ <*> key "comments" (perhaps asString)
156+ <*> key "code" asRenderedCode .! InvalidRenderedCode
157+ <*> key "sourceSpan" (perhaps asSourceSpan)
158+ <*> key "children" (eachInArray asRenderedChildDeclaration)
159+
160+asRenderedChildDeclaration :: Parse UploadedPackageError RenderedChildDeclaration
161+asRenderedChildDeclaration =
162+ RenderedChildDeclaration <$> key "title" asString
163+ <*> key "comments" (perhaps asString)
164+ <*> key "code" asRenderedCode .! InvalidRenderedCode
165+ <*> key "sourceSpan" (perhaps asSourceSpan)
166+ <*> key "type" asRenderedChildDeclarationType .!! InvalidDeclarationType
167+ where
168+ p .!! err = p .! const err
169+
170+asRenderedChildDeclarationType :: Parse UploadedPackageError RenderedChildDeclarationType
171+asRenderedChildDeclarationType =
172+ withString (maybe (Left InvalidDeclarationType) Right .
173+ flip lookup childDeclarationTypes)
174+
175+asSourcePos :: Parse e P.SourcePos
176+asSourcePos = P.SourcePos <$> nth 0 asIntegral
177+ <*> nth 1 asIntegral
178+
179+asBookmarks :: Parse BowerError [Bookmark]
180+asBookmarks = eachInArray asBookmark
181+
182+asBookmark :: Parse BowerError Bookmark
183+asBookmark =
184+ build <$> key "package" (perhaps (withString parsePackageName))
185+ <*> key "item" ((,) <$> nth 0 (P.moduleNameFromString <$> asString)
186+ <*> nth 1 asString)
187+ where
188+ build Nothing = Local
189+ build (Just pn) = FromDep pn
190+
191+asResolvedDependencies :: Parse UploadedPackageError [(PackageName, Version)]
192+asResolvedDependencies =
193+ eachInObjectWithKey (mapLeft ErrorInPackageMeta . parsePackageName . T.unpack) asVersion
194+ where
195+ mapLeft f (Left x) = Left (f x)
196+ mapLeft _ (Right x) = Right x
197+
198+asGithub :: Parse e (GithubUser, GithubRepo)
199+asGithub = (,) <$> nth 0 (GithubUser <$> asString)
200+ <*> nth 1 (GithubRepo <$> asString)
201+
202+asSourceSpan :: Parse e P.SourceSpan
203+asSourceSpan = P.SourceSpan <$> key "name" asString
204+ <*> key "start" asSourcePos
205+ <*> key "end" asSourcePos
206+
207+---------------------
208+-- ToJSON instances
209+
210+instance A.ToJSON UploadedPackage where
211+ toJSON UploadedPackage{..} =
212+ A.object $
213+ [ "packageMeta" .= pkgMeta
214+ , "version" .= showVersion pkgVersion
215+ , "modules" .= pkgModules
216+ , "bookmarks" .= map (fmap (first P.runModuleName)) pkgBookmarks
217+ , "resolvedDependencies" .= assocListToJSON (T.pack . runPackageName)
218+ (T.pack . showVersion)
219+ pkgResolvedDependencies
220+ , "github" .= pkgGithub
221+ ] ++ case pkgUploader of
222+ Just u -> [ "uploader" .= u ]
223+ Nothing -> []
224+
225+instance A.ToJSON RenderedModule where
226+ toJSON RenderedModule{..} =
227+ A.object [ "name" .= rmName
228+ , "comments" .= rmComments
229+ , "declarations" .= rmDeclarations
230+ ]
231+
232+instance A.ToJSON RenderedDeclaration where
233+ toJSON RenderedDeclaration{..} =
234+ A.object [ "title" .= rdTitle
235+ , "comments" .= rdComments
236+ , "code" .= rdCode
237+ , "sourceSpan" .= rdSourceSpan
238+ , "children" .= rdChildren
239+ ]
240+
241+instance A.ToJSON RenderedChildDeclaration where
242+ toJSON RenderedChildDeclaration{..} =
243+ A.object [ "title" .= rcdTitle
244+ , "comments" .= rcdComments
245+ , "code" .= rcdCode
246+ , "sourceSpan" .= rcdSourceSpan
247+ , "type" .= rcdType
248+ ]
249+
250+instance A.ToJSON RenderedChildDeclarationType where
251+ toJSON = A.toJSON . childDeclTypeToString
252+
253+instance A.ToJSON GithubUser where
254+ toJSON = A.toJSON . runGithubUser
255+
256+instance A.ToJSON GithubRepo where
257+ toJSON = A.toJSON . runGithubRepo
258+
259+-- | Given a function for turning association list keys into JSON object keys,
260+-- and a function for turning association list values to JSON string values,
261+-- turns an association list into a JSON object.
262+--
263+-- For example:
264+-- @assocListToJSON T.pack T.pack [("a", "b")]@ will give @{"a": "b"}@.
265+assocListToJSON :: (a -> Text) -> (b -> Text) -> [(a, b)] -> A.Value
266+assocListToJSON f g xs = A.object (map (uncurry (.=) . (f *** g)) xs)
267+
268+instance A.ToJSON a => A.ToJSON (InPackage a) where
269+ toJSON x =
270+ case x of
271+ Local y -> withPackage (Nothing :: Maybe ()) y
272+ FromDep pn y -> withPackage (Just pn) y
273+ where
274+ withPackage :: (A.ToJSON p, A.ToJSON x) => p -> x -> A.Value
275+ withPackage p y =
276+ A.object [ "package" .= p
277+ , "item" .= y
278+ ]
src/Language/PureScript/Docs/Utils/HtmlHelpers.hsnew file+20
@@ -0,0 +1,20 @@
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
src/Language/PureScript/Docs/MonoidExtras.hs → src/Language/PureScript/Docs/Utils/MonoidExtras.hsrenamed+1−1
@@ -1,4 +1,4 @@
1−module Language.PureScript.Docs.MonoidExtras where
1+module Language.PureScript.Docs.Utils.MonoidExtras where
2
2
3import Data.Monoid
3import Data.Monoid
4
4