aboutsummaryrefslogtreecommitdiff
path: root/luxdoc
diff options
context:
space:
mode:
Diffstat (limited to 'luxdoc')
-rw-r--r--luxdoc/project.clj11
-rw-r--r--luxdoc/source/program.lux601
2 files changed, 0 insertions, 612 deletions
diff --git a/luxdoc/project.clj b/luxdoc/project.clj
deleted file mode 100644
index de51950bb..000000000
--- a/luxdoc/project.clj
+++ /dev/null
@@ -1,11 +0,0 @@
-(defproject luxdoc "0.5.0"
- :description "Documentation generator for the Lux programming language's ."
- :url "https://github.com/LuxLang/luxdoc"
- :license {:name "Lux License v0.1"
- :url "https://github.com/LuxLang/lux/blob/master/license.txt"}
- :plugins [[com.github.luxlang/lein-luxc "0.5.0"]]
- :dependencies []
- :repositories [["snapshots" "https://oss.sonatype.org/content/repositories/snapshots/"]
- ["releases" "https://oss.sonatype.org/service/local/staging/deploy/maven2/"]]
- :source-paths ["source"]
- :lux {:program "program"})
diff --git a/luxdoc/source/program.lux b/luxdoc/source/program.lux
deleted file mode 100644
index 94b5df37f..000000000
--- a/luxdoc/source/program.lux
+++ /dev/null
@@ -1,601 +0,0 @@
-## Copyright (c) Eduardo Julian. All rights reserved.
-## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
-## If a copy of the MPL was not distributed with this file,
-## You can obtain one at http://mozilla.org/MPL/2.0/.
-
-(;module:
- lux
- (lux [cli #+ program:]
- [compiler #+ Monad<Lux>]
- host
- [lexer]
- [macro]
- [math]
- [pipe]
- [random]
- [regex]
- [test]
- [type]
- (codata [cont]
- [env]
- function
- [io #- run]
- [state]
- (struct [stream #+ Stream "Stream/" Functor<Stream>]))
- (concurrency [actor]
- [atom]
- [frp]
- [promise]
- [stm])
- (control [applicative]
- [bounded]
- [codec]
- [comonad]
- [effect]
- [enum]
- [eq]
- [fold]
- [functor]
- [hash]
- monad
- [monoid]
- ["_;" number]
- [ord])
- (data [bit]
- [bool]
- [char]
- [error]
- [ident "Ident/" Codec<Text,Ident>]
- [identity]
- [log]
- maybe
- [number #* "Nat/" Codec<Text,Nat>]
- [product]
- [sum]
- [text "Text/" Monoid<Text> Eq<Text>]
- (error [exception])
- (format [json])
- (struct [array]
- [dict]
- [list #+ "List/" Monoid<List> Functor<List> Fold<List>]
- [queue]
- [set]
- [stack]
- [tree]
- [vector]
- [zipper])
- text/format)
- (macro [ast]
- [poly]
- ["s" syntax]
- (poly ["poly_;" eq]
- ["poly_;" functor]
- ["poly_;" text-encoder])
- (syntax [common]))
- (math [complex]
- [ratio]
- [simple])
- (type [auto]
- [check])
- ))
-
-(def: name-options "abcdefghijklmnopqrstuvwxyz")
-(def: name-options-count (text;size name-options))
-
-(def: (id->name id)
- (-> Nat Text)
- (if (n.> name-options-count id)
- (format (id->name (n./ name-options-count id))
- (id->name (n.% name-options-count id)))
- (char;as-text (default #"?" (text;at id name-options)))))
-
-(def: type-var-names
- (Stream Text)
- (Stream/map id->name (stream;iterate n.inc +0)))
-
-(def: (type-arg? id)
- (-> Nat Bool)
- (n.= +1 (n.% +2 id)))
-
-(def: (arg-id level id)
- (-> Nat Nat Nat)
- (n.- (n./ +2 id) level))
-
-(def: (bound->name [type-fun-name type-fun-args] level id)
- (-> [Text (List Text)] Nat Nat Text)
- (if (type-arg? id)
- (let [_arg-id (arg-id level id)]
- (case (list;at _arg-id type-fun-args)
- (#;Some found)
- found
-
- _
- (|> type-var-names
- (stream;filter (lambda [var-name] (not (list;member? text;Eq<Text> type-fun-args var-name))))
- (stream;at _arg-id))))
- type-fun-name))
-
-(do-template [<name> <base> <tag>]
- [(def: (<base> level type)
- (-> Nat Type [Nat Type])
- (case type
- (<tag> env type')
- (<base> (n.inc level) type')
-
- _
- [level type]))
-
- (def: <name> (<base> +0))]
-
- [unravel-univ unravel-univ' #;UnivQ]
- [unravel-ex unravel-ex' #;ExQ])
-
-(def: (level->args offset level)
- (-> Nat Nat (List Text))
- (if (n.= +0 level)
- (list)
- (|> level
- n.dec
- (list;n.range +0)
- (List/map (|>. (n.+ (n.inc offset)) id->name)))))
-
-(def: (prefix-lines prefix lines)
- (-> Text Text Text)
- (|> lines
- text;split-lines
- (List/map (Text/append prefix))
- ## (list;interpose "\n")
- (text;join-with "")))
-
-(def: (pprint-type-def level type-fun-info tags module sig? type-rec? type)
- (-> Nat [Text (List Text)] (List Ident) Text Bool Bool Type Text)
- (case tags
- (^ (list [_ single-tag]))
- (if sig?
- (format "(: " (pprint-type-def level type-fun-info #;None module sig? type-rec? type) "\n " single-tag ")")
- (format "{#" single-tag " " (pprint-type-def level type-fun-info #;None module sig? type-rec? type) "}"))
-
- _
- (case [type-rec? type]
- [_ (#;HostT name params)]
- (case params
- #;Nil
- (format "(host " name ")")
-
- _
- (format "(host " name " " (|> params (List/map (pprint-type-def level type-fun-info #;None module sig? type-rec?)) (text;join-with " ")) ")"))
-
- [_ #;VoidT]
- "Void"
-
- [_ #;UnitT]
- "Unit"
-
- [_ (#;SumT _)]
- (let [members (type;flatten-variant type)]
- (case tags
- #;Nil
- (format "(| "
- (|> members
- (List/map (pprint-type-def level type-fun-info #;None module sig? type-rec?))
- (text;join-with " "))
- ")")
-
- _
- (|> members
- (list;zip2 tags)
- (List/map (lambda [[[_ t-name] type]]
- (case type
- #;UnitT
- (format "#" t-name)
-
- (#;ProdT _)
- (let [types (type;flatten-tuple type)]
- (format "(#" t-name " "
- (|> types
- (List/map (pprint-type-def level type-fun-info #;None module sig? type-rec?))
- (text;join-with " "))
- ")"))
-
- _
- (format "(#" t-name " " (pprint-type-def level type-fun-info #;None module sig? type-rec? type) ")"))))
- (text;join-with "\n"))))
-
- [_ (#;ProdT _)]
- (let [members (type;flatten-tuple type)]
- (case tags
- #;Nil
- (format "[" (|> members (List/map (pprint-type-def level type-fun-info #;None module sig? type-rec?)) (text;join-with " ")) "]")
-
- _
- (let [member-docs (|> members
- (list;zip2 tags)
- (List/map (lambda [[[_ t-name] type]]
- (if sig?
- (format "(: " (pprint-type-def level type-fun-info #;None module sig? type-rec? type) "\n " t-name ")")
- (format "#" t-name " " (pprint-type-def level type-fun-info #;None module sig? type-rec? type)))))
- (text;join-with "\n "))]
- (if sig?
- member-docs
- (format "{" member-docs "}")))))
-
- [_ (#;LambdaT input output)]
- (let [[ins out] (type;flatten-function type)]
- (format "(-> " (|> ins (List/map (pprint-type-def level type-fun-info #;None module sig? type-rec?)) (text;join-with " "))
- " "
- (pprint-type-def level type-fun-info #;None module sig? type-rec? out)
- ")"))
-
- [_ (#;BoundT idx)]
- (bound->name type-fun-info level idx)
-
- (^template [<tag> <pre> <post>]
- [_ (<tag> id)]
- (format <pre> (Nat/encode id) <post>))
- ([#;VarT "⌈v:" "⌋"]
- [#;ExT "⟨e:" "⟩"])
-
- (^template [<tag> <name> <unravel>]
- [_ (<tag> _)]
- (let [[level' body] (<unravel> type)
- args (level->args level level')
- body-doc (pprint-type-def (n.+ level level') type-fun-info tags module sig? type-rec? body)]
- (format "(" <name> " " "[" (text;join-with " " args) "]"
- (case tags
- #;Nil
- (format " " body-doc)
-
- _
- (format "\n" (prefix-lines " " body-doc)))
- ")")))
- ([#;UnivQ "All" unravel-univ]
- [#;ExQ "Ex" unravel-ex])
-
- [true (#;AppT (#;BoundT +0) (#;BoundT +1))]
- (product;left type-fun-info)
-
- [_ (#;AppT fun param)]
- (let [[type-fun type-args] (type;flatten-application type)]
- (format "(" (pprint-type-def level type-fun-info tags module sig? type-rec? type-fun) " " (|> type-args (List/map (pprint-type-def level type-fun-info #;None module sig? type-rec?)) (text;join-with " ")) ")"))
-
- [_ (#;NamedT [_module _name] type)]
- (if (Text/= module _module)
- _name
- (Ident/encode [_module _name]))
- )))
-
-(def: (pprint-type level type-fun-name module type)
- (-> Nat Text Text Type Text)
- (case type
- (#;HostT name params)
- (case params
- #;Nil
- (format "(host " name ")")
-
- _
- (format "(host " name " " (|> params (List/map (pprint-type level type-fun-name module)) (list;interpose " ") (text;join-with "")) ")"))
-
- #;VoidT
- "Void"
-
- (#;SumT _)
- (let [members (type;flatten-variant type)]
- (format "(| " (|> members (List/map (pprint-type level type-fun-name module)) (list;interpose " ") (text;join-with "")) ")"))
-
- #;UnitT
- "Unit"
-
- (#;ProdT _)
- (let [members (type;flatten-tuple type)]
- (format "[" (|> members (List/map (pprint-type level type-fun-name module)) (list;interpose " ") (text;join-with "")) "]"))
-
- (#;LambdaT input output)
- (let [[ins out] (type;flatten-function type)]
- (format "(-> "
- (|> ins (List/map (pprint-type level type-fun-name module)) (list;interpose " ") (text;join-with ""))
- " "
- (pprint-type level type-fun-name module out)
- ")"))
-
- (#;BoundT idx)
- (bound->name [type-fun-name (list)] level idx)
-
- (^template [<tag> <pre> <post>]
- (<tag> id)
- (format <pre> (Nat/encode id) <post>))
- ([#;VarT "⌈" "⌋"]
- [#;ExT "⟨" "⟩"])
-
- (^template [<tag> <name> <unravel>]
- (<tag> _)
- (let [[level' body] (<unravel> type)
- args (level->args level level')
- body-doc (pprint-type (n.+ level level') type-fun-name module body)]
- (format "(" <name> " " "[" (|> args (list;interpose " ") (text;join-with "")) "]"
- (format " " body-doc)
- ")")))
- ([#;UnivQ "All" unravel-univ]
- [#;ExQ "Ex" unravel-ex])
-
- (#;AppT fun param)
- (let [[type-fun type-args] (type;flatten-application type)]
- (format "(" (pprint-type level type-fun-name module type-fun) " " (|> type-args (List/map (pprint-type level type-fun-name module)) (list;interpose " ") (text;join-with "")) ")"))
-
- (#;NamedT [_module _name] type)
- (if (Text/= module _module)
- _name
- (Ident/encode [_module _name]))
- ))
-
-(type: Markdown
- Text)
-
-(type: DefOrg
- {#types (List [Text Anns Type])
- #macros (List [Text Anns])
- #structs (List [Text Anns Type])
- #values (List [Text Anns Type])})
-
-(def: (lux-module? module-name)
- (-> Text Bool)
- (or (Text/= "lux" module-name)
- (text;starts-with? "lux/" module-name)))
-
-(do-template [<name> <joiner>]
- [(def: (<name> docs)
- (-> (List Markdown) Markdown)
- (text;join-with "\n\n" docs))]
-
- [join-def-docs "\n\n"]
- [join-doc-sections "\n\n"]
- )
-
-(def: (cons h t)
- (All [a] (-> a (List a) (List a)))
- (#;Cons h t))
-
-(def: (add-def [name [def-type def-meta def-value]] org)
- (-> [Text Def] DefOrg DefOrg)
- (cond (compiler;type? def-meta)
- (update@ #types (cons [name def-meta (:coerce Type def-value)]) org)
-
- (compiler;macro? def-meta)
- (update@ #macros (cons [name def-meta]) org)
-
- (compiler;struct? def-meta)
- (update@ #structs (cons [name def-meta def-type]) org)
-
- ## else
- (update@ #values (cons [name def-meta def-type]) org)))
-
-(def: def-sorter
- (All [r] (-> (List [Text r]) (List [Text r])))
- (list;sort (: (All [r] (-> [Text r] [Text r] Bool))
- (lambda [[n1 _] [n2 _]] (:: text;Ord<Text> < n1 n2)))))
-
-(def: (organize-defs defs)
- (-> (List [Text Def]) DefOrg)
- (let [init {#types (list)
- #macros (list)
- #structs (list)
- #values (list)}]
- (|> (List/fold add-def init defs)
- (update@ #types def-sorter)
- (update@ #macros def-sorter)
- (update@ #structs def-sorter)
- (update@ #values def-sorter))))
-
-(def: (unravel-type-func level type)
- (-> Nat Type Type)
- (if (n.> +0 level)
- (case type
- (#;UnivQ _env _type)
- (unravel-type-func (n.dec level) _type)
-
- _
- type)
- type))
-
-(def: (unrecurse-type type)
- (-> Type Type)
- (case type
- (#;AppT (#;UnivQ _env _type) _)
- _type
-
- _
- type))
-
-(def: #export (when! test f x)
- (All [a] (-> Bool (-> a a) a a))
- (if test
- (f x)
- x))
-
-(def: #export (if! test f g x)
- (All [a b] (-> Bool (-> a b) (-> a b) a b))
- (if test
- (f x)
- (g x)))
-
-(def: (doc-type module type def-meta)
- (-> Text Type Anns (Lux Markdown))
- (case type
- (#;NamedT type-name type)
- (do Monad<Lux>
- [tags (compiler;tags-of type-name)
- #let [[_ _name] type-name
- type-rec? (compiler;type-rec? def-meta)
- type-args (compiler;type-args def-meta)
- sig? (compiler;sig? def-meta)
- usage (case type-args
- #;Nil
- _name
-
- _
- (format "(" (text;join-with " " (list& _name type-args)) ")"))
- nesting (list;size type-args)]]
- (wrap (format (if sig? "(signature: " "(type: ") (if type-rec? "#rec " "") usage "\n"
- (|> (pprint-type-def (n.dec nesting)
- [_name type-args]
- tags module sig? type-rec?
- (|> type
- (unravel-type-func nesting)
- (when! type-rec? unrecurse-type)))
- text;split-lines
- (List/map (Text/append " "))
- (text;join-with "\n"))
- ")")))
-
- _
- (compiler;fail (format "A type definition must always be named! - " (type;to-text type)))))
-
-(def: (doc-types module types)
- (-> Text (List [Text Anns Type]) (Lux Markdown))
- (do Monad<Lux>
- [type-docs (mapM @
- (: (-> [Text Anns Type] (Lux Markdown))
- (lambda [[name def-meta type]]
- (do Monad<Lux>
- [#let [?doc (compiler;get-doc def-meta)
- name (|> name
- (text;replace "<" "&lt;")
- (text;replace ">" "&gt;"))]
- type-doc (doc-type module type def-meta)]
- (wrap (format "### " name "\n"
- (case ?doc
- (#;Some doc)
- (format doc "\n")
-
- _
- "")
- "```\n" type-doc "\n```")))))
- types)]
- (|> type-docs
- join-def-docs
- (format "## Types\n")
- wrap)))
-
-(def: (doc-macros module-name names)
- (-> Text (List [Text Anns]) Markdown)
- (|> names
- (List/map (: (-> [Text Anns] Markdown)
- (lambda [[name def-meta]]
- (let [name (|> name
- (text;replace "<" "&lt;")
- (text;replace ">" "&gt;"))]
- (format "### " name "\n"
- (default ""
- (do Monad<Maybe>
- [doc (compiler;get-doc def-meta)]
- (wrap (format "```\n" doc "\n```")))))))))
- join-def-docs
- (format "## Macros\n")))
-
-(do-template [<singular> <plural> <header>]
- [(def: <singular>
- (-> Text Type Markdown)
- (pprint-type (n.dec +0) "?"))
-
- (def: (<plural> module values)
- (-> Text (List [Text Anns Type]) Markdown)
- (|> values
- (List/map (lambda [[name def-meta value-type]]
- (let [?doc (compiler;get-doc def-meta)
- usage (case (compiler;func-args def-meta)
- #;Nil
- name
-
- args
- (format "(" (text;join-with " " (list& name args)) ")"))
- usage (|> usage
- (text;replace "<" "&lt;")
- (text;replace ">" "&gt;"))]
- (format "### " usage "\n"
- (case ?doc
- (#;Some doc)
- (format "```\n" doc "\n```\n")
-
- _
- "")
- "`" (<singular> module value-type) "`"))))
- join-def-docs
- (format <header>)))]
-
- [doc-struct doc-structs "## Structs\n"]
- [doc-value doc-values "## Values\n"]
- )
-
-(def: (enclose-lines pre+post block)
- (-> [Text Text] Text Text)
- (|> block
- text;split-lines
- (List/map (text;enclose pre+post))
- (text;join-with "\n")))
-
-(def: (doc-module [[module-name module] org])
- (-> [[Text Module] DefOrg] (Lux [Text Markdown]))
- (do Monad<Lux>
- [#let [(^slots [#types #macros #structs #values]) org
- anns (|> module (get@ #;module-anns) compiler;get-doc)]
- types-md (if (list;empty? types)
- (wrap "")
- (doc-types module-name types))
- #let [doc-desc (case anns
- #;None
- ""
-
- (#;Some doc)
- (format "\n" (enclose-lines ["> " ""] doc) "\n"))
- doc-body (join-doc-sections (list types-md
- (if (list;empty? macros) "" (doc-macros module-name macros))
- (if (list;empty? structs) "" (doc-structs module-name structs))
- (if (list;empty? values) "" (doc-values module-name values))))]]
- (wrap [module-name
- (format "## " module-name "\n"
- doc-desc "\n"
- doc-body)])))
-
-(jvm-import java.io.File
- (new [java.lang.String]))
-
-(jvm-import java.io.PrintWriter
- (new [java.io.File] #io #try)
- (println [java.lang.String] #io void))
-
-(jvm-import java.io.Writer
- (flush [] #io #try void))
-
-(def: (save-docs! [module-name docs])
- (-> [Text Markdown] (IO Unit))
- (do Monad<IO>
- [?target (|> (format (text;replace "/" "_" module-name) ".md")
- File.new
- PrintWriter.new)]
- (case ?target
- (#;Left _)
- (wrap [])
-
- (#;Right target)
- (do @
- [_ (PrintWriter.println docs target)
- _ (Writer.flush [] target)]
- (wrap [])))))
-
-(macro: (gen-docs! _)
- (do Monad<Lux>
- [all-modules compiler;modules
- #let [lux-modules (|> all-modules
- (list;filter (. lux-module? product;left))
- (list;sort (lambda [[left _] [right _]]
- (:: text;Ord<Text> < left right))))]
- lux-exports (mapM @ (. compiler;exports product;left) lux-modules)
- module-docs (mapM @ doc-module
- (list;zip2 lux-modules
- (List/map organize-defs lux-exports)))
- #let [_ (io;run (mapM Monad<IO> save-docs! module-docs))]]
- (wrap (list))))
-
-(gen-docs!)
-
-(program: args
- (io (log! "Done!")))