mirror of
https://github.com/gren-lang/compiler.git
synced 2024-09-11 08:45:42 +03:00
Create a new docs command, and remove the --docs flag from make.
This commit is contained in:
parent
7d07060bd2
commit
bb4af7a90d
@ -57,6 +57,7 @@ Common gren-common
|
||||
Init
|
||||
Install
|
||||
Make
|
||||
Docs
|
||||
Publish
|
||||
Repl
|
||||
|
||||
|
152
terminal/src/Docs.hs
Normal file
152
terminal/src/Docs.hs
Normal file
@ -0,0 +1,152 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Docs
|
||||
( Flags (..),
|
||||
Output (..),
|
||||
ReportType (..),
|
||||
run,
|
||||
reportType,
|
||||
output,
|
||||
docsFile,
|
||||
)
|
||||
where
|
||||
|
||||
import BackgroundWriter qualified as BW
|
||||
import Build qualified
|
||||
import Data.ByteString.Builder qualified as B
|
||||
import Data.NonEmptyList qualified as NE
|
||||
import Directories qualified as Dirs
|
||||
import Gren.Details qualified as Details
|
||||
import Gren.Docs qualified as Docs
|
||||
import Gren.ModuleName qualified as ModuleName
|
||||
import Json.Encode qualified as Json
|
||||
import Reporting qualified
|
||||
import Reporting.Exit qualified as Exit
|
||||
import Reporting.Task qualified as Task
|
||||
import System.FilePath qualified as FP
|
||||
import System.IO qualified as IO
|
||||
import Terminal (Parser (..))
|
||||
|
||||
-- FLAGS
|
||||
|
||||
data Flags = Flags
|
||||
{ _output :: Maybe Output,
|
||||
_report :: Maybe ReportType
|
||||
}
|
||||
|
||||
data Output
|
||||
= JSON FilePath
|
||||
| DevNull
|
||||
| DevStdOut
|
||||
|
||||
data ReportType
|
||||
= Json
|
||||
|
||||
-- RUN
|
||||
|
||||
type Task a = Task.Task Exit.Make a
|
||||
|
||||
run :: () -> Flags -> IO ()
|
||||
run () flags@(Flags _ report) =
|
||||
do
|
||||
style <- getStyle report
|
||||
maybeRoot <- Dirs.findRoot
|
||||
Reporting.attemptWithStyle style Exit.makeToReport $
|
||||
case maybeRoot of
|
||||
Just root -> runHelp root style flags
|
||||
Nothing -> return $ Left $ Exit.MakeNoOutline
|
||||
|
||||
runHelp :: FilePath -> Reporting.Style -> Flags -> IO (Either Exit.Make ())
|
||||
runHelp root style (Flags maybeOutput _) =
|
||||
BW.withScope $ \scope ->
|
||||
Dirs.withRootLock root $
|
||||
Task.run $
|
||||
do
|
||||
details <- Task.eio Exit.MakeBadDetails (Details.load style scope root)
|
||||
exposed <- getExposed details
|
||||
case maybeOutput of
|
||||
Just DevNull ->
|
||||
do
|
||||
buildExposed style root details Build.IgnoreDocs exposed
|
||||
return ()
|
||||
Just DevStdOut ->
|
||||
do
|
||||
docs <- buildExposed style root details Build.KeepDocs exposed
|
||||
let builder = Json.encodeUgly $ Docs.encode docs
|
||||
Task.io $ B.hPutBuilder IO.stdout builder
|
||||
Nothing ->
|
||||
buildExposed style root details (Build.WriteDocs "docs.json") exposed
|
||||
Just (JSON target) ->
|
||||
buildExposed style root details (Build.WriteDocs target) exposed
|
||||
|
||||
-- GET INFORMATION
|
||||
|
||||
getStyle :: Maybe ReportType -> IO Reporting.Style
|
||||
getStyle report =
|
||||
case report of
|
||||
Nothing -> Reporting.terminal
|
||||
Just Json -> return Reporting.json
|
||||
|
||||
getExposed :: Details.Details -> Task (NE.List ModuleName.Raw)
|
||||
getExposed (Details.Details _ validOutline _ _ _ _) =
|
||||
case validOutline of
|
||||
Details.ValidApp _ _ ->
|
||||
Task.throw Exit.MakeAppNeedsFileNames
|
||||
Details.ValidPkg _ _ exposed ->
|
||||
case exposed of
|
||||
[] -> Task.throw Exit.MakePkgNeedsExposing
|
||||
m : ms -> return (NE.List m ms)
|
||||
|
||||
-- BUILD PROJECTS
|
||||
|
||||
buildExposed :: Reporting.Style -> FilePath -> Details.Details -> Build.DocsGoal a -> NE.List ModuleName.Raw -> Task a
|
||||
buildExposed style root details docsGoal exposed =
|
||||
Task.eio Exit.MakeCannotBuild $
|
||||
Build.fromExposed style root details docsGoal exposed
|
||||
|
||||
-- PARSERS
|
||||
|
||||
reportType :: Parser ReportType
|
||||
reportType =
|
||||
Parser
|
||||
{ _singular = "report type",
|
||||
_plural = "report types",
|
||||
_parser = \string -> if string == "json" then Just Json else Nothing,
|
||||
_suggest = \_ -> return ["json"],
|
||||
_examples = \_ -> return ["json"]
|
||||
}
|
||||
|
||||
output :: Parser Output
|
||||
output =
|
||||
Parser
|
||||
{ _singular = "output file",
|
||||
_plural = "output files",
|
||||
_parser = parseOutput,
|
||||
_suggest = \_ -> return [],
|
||||
_examples = \_ -> return ["gren.js", "index.html", "/dev/null", "/dev/stdout"]
|
||||
}
|
||||
|
||||
parseOutput :: String -> Maybe Output
|
||||
parseOutput name
|
||||
| name == "/dev/stdout" = Just DevStdOut
|
||||
| isDevNull name = Just DevNull
|
||||
| hasExt ".json" name = Just (JSON name)
|
||||
| otherwise = Nothing
|
||||
|
||||
docsFile :: Parser FilePath
|
||||
docsFile =
|
||||
Parser
|
||||
{ _singular = "json file",
|
||||
_plural = "json files",
|
||||
_parser = \name -> if hasExt ".json" name then Just name else Nothing,
|
||||
_suggest = \_ -> return [],
|
||||
_examples = \_ -> return ["docs.json", "documentation.json"]
|
||||
}
|
||||
|
||||
hasExt :: String -> String -> Bool
|
||||
hasExt ext path =
|
||||
FP.takeExtension path == ext && length path > length ext
|
||||
|
||||
isDevNull :: String -> Bool
|
||||
isDevNull name =
|
||||
name == "/dev/null" || name == "NUL" || name == "$null"
|
@ -8,6 +8,7 @@ where
|
||||
import Bump qualified
|
||||
import Data.List qualified as List
|
||||
import Diff qualified
|
||||
import Docs qualified
|
||||
import Format qualified
|
||||
import Gren.Platform qualified as Platform
|
||||
import Gren.Version qualified as V
|
||||
@ -31,6 +32,7 @@ main =
|
||||
[ repl,
|
||||
init,
|
||||
make,
|
||||
docs,
|
||||
install,
|
||||
format,
|
||||
bump,
|
||||
@ -155,9 +157,31 @@ make =
|
||||
|-- onOff "optimize" "Turn on optimizations to make code smaller and faster. For example, the compiler renames record fields to be as short as possible and unboxes values to reduce allocation."
|
||||
|-- flag "output" Make.output "Specify the name of the resulting JS file. For example --output=assets/gren.js to generate the JS at assets/gren.js. You can also use --output=/dev/stdout to output the JS to the terminal, or --output=/dev/null to generate no output at all!"
|
||||
|-- flag "report" Make.reportType "You can say --report=json to get error messages as JSON. This is only really useful if you are an editor plugin. Humans should avoid it!"
|
||||
|-- flag "docs" Make.docsFile "Generate a JSON file of documentation for a package."
|
||||
in Terminal.Command "make" Uncommon details example (zeroOrMore grenFile) makeFlags Make.run
|
||||
|
||||
-- DOCS
|
||||
|
||||
docs :: Terminal.Command
|
||||
docs =
|
||||
let details =
|
||||
"The `docs` command collects all documentation for a package in a JSON file:"
|
||||
|
||||
example =
|
||||
stack
|
||||
[ reflow
|
||||
"For example:",
|
||||
P.indent 4 $ P.green "gren docs",
|
||||
reflow
|
||||
"This collects all documentation for the current package and writes it to a\
|
||||
\ docs.json file, if possible"
|
||||
]
|
||||
|
||||
docsFlags =
|
||||
flags Docs.Flags
|
||||
|-- flag "output" Docs.output "Specify the name of the resulting JSON file. For example --output=assets/docs.json to generate the JSON at assets/docs.json. You can also use --output=/dev/stdout to output the JSON to the terminal, or --output=/dev/null to verify that generating the documentation would work."
|
||||
|-- flag "report" Docs.reportType "You can say --report=json to get error messages as JSON. This is only really useful if you are an editor plugin. Humans should avoid it!"
|
||||
in Terminal.Command "docs" Uncommon details example noArgs docsFlags Docs.run
|
||||
|
||||
-- INSTALL
|
||||
|
||||
install :: Terminal.Command
|
||||
@ -284,8 +308,8 @@ format =
|
||||
-- HELPERS
|
||||
|
||||
stack :: [P.Doc] -> P.Doc
|
||||
stack docs =
|
||||
P.vcat $ List.intersperse "" docs
|
||||
stack docList =
|
||||
P.vcat $ List.intersperse "" docList
|
||||
|
||||
reflow :: String -> P.Doc
|
||||
reflow string =
|
||||
|
@ -7,7 +7,6 @@ module Make
|
||||
run,
|
||||
reportType,
|
||||
output,
|
||||
docsFile,
|
||||
)
|
||||
where
|
||||
|
||||
@ -39,8 +38,7 @@ data Flags = Flags
|
||||
{ _debug :: Bool,
|
||||
_optimize :: Bool,
|
||||
_output :: Maybe Output,
|
||||
_report :: Maybe ReportType,
|
||||
_docs :: Maybe FilePath
|
||||
_report :: Maybe ReportType
|
||||
}
|
||||
|
||||
data Output
|
||||
@ -58,7 +56,7 @@ data ReportType
|
||||
type Task a = Task.Task Exit.Make a
|
||||
|
||||
run :: [FilePath] -> Flags -> IO ()
|
||||
run paths flags@(Flags _ _ _ report _) =
|
||||
run paths flags@(Flags _ _ _ report) =
|
||||
do
|
||||
style <- getStyle report
|
||||
maybeRoot <- Dirs.findRoot
|
||||
@ -68,7 +66,7 @@ run paths flags@(Flags _ _ _ report _) =
|
||||
Nothing -> return $ Left $ Exit.MakeNoOutline
|
||||
|
||||
runHelp :: FilePath -> [FilePath] -> Reporting.Style -> Flags -> IO (Either Exit.Make ())
|
||||
runHelp root paths style (Flags debug optimize maybeOutput _ maybeDocs) =
|
||||
runHelp root paths style (Flags debug optimize maybeOutput _) =
|
||||
BW.withScope $ \scope ->
|
||||
Dirs.withRootLock root $
|
||||
Task.run $
|
||||
@ -80,7 +78,7 @@ runHelp root paths style (Flags debug optimize maybeOutput _ maybeDocs) =
|
||||
[] ->
|
||||
do
|
||||
exposed <- getExposed details
|
||||
buildExposed style root details maybeDocs exposed
|
||||
buildExposed style root details exposed
|
||||
p : ps ->
|
||||
do
|
||||
artifacts <- buildPaths style root details (NE.List p ps)
|
||||
@ -171,11 +169,10 @@ getPlatform (Details.Details _ validOutline _ _ _ _) = do
|
||||
|
||||
-- BUILD PROJECTS
|
||||
|
||||
buildExposed :: Reporting.Style -> FilePath -> Details.Details -> Maybe FilePath -> NE.List ModuleName.Raw -> Task ()
|
||||
buildExposed style root details maybeDocs exposed =
|
||||
let docsGoal = maybe Build.IgnoreDocs Build.WriteDocs maybeDocs
|
||||
in Task.eio Exit.MakeCannotBuild $
|
||||
Build.fromExposed style root details docsGoal exposed
|
||||
buildExposed :: Reporting.Style -> FilePath -> Details.Details -> NE.List ModuleName.Raw -> Task ()
|
||||
buildExposed style root details exposed =
|
||||
Task.eio Exit.MakeCannotBuild $
|
||||
Build.fromExposed style root details Build.IgnoreDocs exposed
|
||||
|
||||
buildPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> Task Build.Artifacts
|
||||
buildPaths style root details paths =
|
||||
@ -287,16 +284,6 @@ parseOutput name
|
||||
| noExt name = Just (Exe name)
|
||||
| otherwise = Nothing
|
||||
|
||||
docsFile :: Parser FilePath
|
||||
docsFile =
|
||||
Parser
|
||||
{ _singular = "json file",
|
||||
_plural = "json files",
|
||||
_parser = \name -> if hasExt ".json" name then Just name else Nothing,
|
||||
_suggest = \_ -> return [],
|
||||
_examples = \_ -> return ["docs.json", "documentation.json"]
|
||||
}
|
||||
|
||||
hasExt :: String -> String -> Bool
|
||||
hasExt ext path =
|
||||
FP.takeExtension path == ext && length path > length ext
|
||||
|
Loading…
Reference in New Issue
Block a user