prosidy (empty) → 1.5.0.1
raw patch · 33 files changed
+4542/−0 lines, 33 filesdep +aesondep +aeson-diffdep +aeson-pretty
Dependencies added: aeson, aeson-diff, aeson-pretty, base, binary, bytestring, containers, contravariant, deepseq, directory, filepath, hashable, megaparsec, profunctors, prosidy, tagged, tasty, tasty-ant-xml, tasty-golden, tasty-hunit, tasty-quickcheck, text, transformers, unordered-containers, vector
Files
- CHANGELOG +8/−0
- LICENSE +373/−0
- README.pro +33/−0
- data/golden/comment/input.pro +127/−0
- data/golden/comment/output.json +312/−0
- data/golden/empty-document/input.pro +1/−0
- data/golden/empty-document/output.json +7/−0
- data/golden/gamut/input.pro +164/−0
- data/golden/gamut/output.json +1108/−0
- data/golden/invalid-utf8/input.pro +6/−0
- data/golden/invalid-utf8/output.json +52/−0
- data/golden/line-break/input.pro +7/−0
- data/golden/line-break/output.json +37/−0
- data/golden/shebang/input.pro +5/−0
- data/golden/shebang/output.json +24/−0
- prosidy.cabal +117/−0
- src/Prosidy.hs +19/−0
- src/Prosidy/Compat.hs +8/−0
- src/Prosidy/Optics.hs +11/−0
- src/Prosidy/Optics/Internal.hs +116/−0
- src/Prosidy/Optics/Source.hs +84/−0
- src/Prosidy/Optics/Types.hs +233/−0
- src/Prosidy/Parse.hs +451/−0
- src/Prosidy/Source.hs +268/−0
- src/Prosidy/Types.hs +311/−0
- src/Prosidy/Types/Assoc.hs +54/−0
- src/Prosidy/Types/Key.hs +155/−0
- src/Prosidy/Types/Series.hs +109/−0
- src/Prosidy/Types/Set.hs +59/−0
- test/Prosidy/Test.hs +21/−0
- test/Prosidy/Test/Parse.hs +64/−0
- test/Prosidy/Test/Source.hs +120/−0
- test/Prosidy/Test/Types.hs +78/−0
+ CHANGELOG view
@@ -0,0 +1,8 @@+# v1.5.0.1 _(2020-02-24)_+- Added `CHANGELOG` to its own file.+- Included `CHANGELOG` and `README.pro` in the source distribution.+- Added an optic for fetching the name of a `Tag`.++# v1.5.0.0 _(2020-02-23)_+- Added tests for GHC 8.4.4 through 8.6.1.+- Initial stable release.
+ LICENSE view
@@ -0,0 +1,373 @@+Mozilla Public License Version 2.0+==================================++1. Definitions+--------------++1.1. "Contributor"+ means each individual or legal entity that creates, contributes to+ the creation of, or owns Covered Software.++1.2. "Contributor Version"+ means the combination of the Contributions of others (if any) used+ by a Contributor and that particular Contributor's Contribution.++1.3. "Contribution"+ means Covered Software of a particular Contributor.++1.4. "Covered Software"+ means Source Code Form to which the initial Contributor has attached+ the notice in Exhibit A, the Executable Form of such Source Code+ Form, and Modifications of such Source Code Form, in each case+ including portions thereof.++1.5. "Incompatible With Secondary Licenses"+ means++ (a) that the initial Contributor has attached the notice described+ in Exhibit B to the Covered Software; or++ (b) that the Covered Software was made available under the terms of+ version 1.1 or earlier of the License, but not also under the+ terms of a Secondary License.++1.6. "Executable Form"+ means any form of the work other than Source Code Form.++1.7. "Larger Work"+ means a work that combines Covered Software with other material, in+ a separate file or files, that is not Covered Software.++1.8. "License"+ means this document.++1.9. "Licensable"+ means having the right to grant, to the maximum extent possible,+ whether at the time of the initial grant or subsequently, any and+ all of the rights conveyed by this License.++1.10. "Modifications"+ means any of the following:++ (a) any file in Source Code Form that results from an addition to,+ deletion from, or modification of the contents of Covered+ Software; or++ (b) any new file in Source Code Form that contains any Covered+ Software.++1.11. "Patent Claims" of a Contributor+ means any patent claim(s), including without limitation, method,+ process, and apparatus claims, in any patent Licensable by such+ Contributor that would be infringed, but for the grant of the+ License, by the making, using, selling, offering for sale, having+ made, import, or transfer of either its Contributions or its+ Contributor Version.++1.12. "Secondary License"+ means either the GNU General Public License, Version 2.0, the GNU+ Lesser General Public License, Version 2.1, the GNU Affero General+ Public License, Version 3.0, or any later versions of those+ licenses.++1.13. "Source Code Form"+ means the form of the work preferred for making modifications.++1.14. "You" (or "Your")+ means an individual or a legal entity exercising rights under this+ License. For legal entities, "You" includes any entity that+ controls, is controlled by, or is under common control with You. For+ purposes of this definition, "control" means (a) the power, direct+ or indirect, to cause the direction or management of such entity,+ whether by contract or otherwise, or (b) ownership of more than+ fifty percent (50%) of the outstanding shares or beneficial+ ownership of such entity.++2. License Grants and Conditions+--------------------------------++2.1. Grants++Each Contributor hereby grants You a world-wide, royalty-free,+non-exclusive license:++(a) under intellectual property rights (other than patent or trademark)+ Licensable by such Contributor to use, reproduce, make available,+ modify, display, perform, distribute, and otherwise exploit its+ Contributions, either on an unmodified basis, with Modifications, or+ as part of a Larger Work; and++(b) under Patent Claims of such Contributor to make, use, sell, offer+ for sale, have made, import, and otherwise transfer either its+ Contributions or its Contributor Version.++2.2. Effective Date++The licenses granted in Section 2.1 with respect to any Contribution+become effective for each Contribution on the date the Contributor first+distributes such Contribution.++2.3. Limitations on Grant Scope++The licenses granted in this Section 2 are the only rights granted under+this License. No additional rights or licenses will be implied from the+distribution or licensing of Covered Software under this License.+Notwithstanding Section 2.1(b) above, no patent license is granted by a+Contributor:++(a) for any code that a Contributor has removed from Covered Software;+ or++(b) for infringements caused by: (i) Your and any other third party's+ modifications of Covered Software, or (ii) the combination of its+ Contributions with other software (except as part of its Contributor+ Version); or++(c) under Patent Claims infringed by Covered Software in the absence of+ its Contributions.++This License does not grant any rights in the trademarks, service marks,+or logos of any Contributor (except as may be necessary to comply with+the notice requirements in Section 3.4).++2.4. Subsequent Licenses++No Contributor makes additional grants as a result of Your choice to+distribute the Covered Software under a subsequent version of this+License (see Section 10.2) or under the terms of a Secondary License (if+permitted under the terms of Section 3.3).++2.5. Representation++Each Contributor represents that the Contributor believes its+Contributions are its original creation(s) or it has sufficient rights+to grant the rights to its Contributions conveyed by this License.++2.6. Fair Use++This License is not intended to limit any rights You have under+applicable copyright doctrines of fair use, fair dealing, or other+equivalents.++2.7. Conditions++Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted+in Section 2.1.++3. Responsibilities+-------------------++3.1. Distribution of Source Form++All distribution of Covered Software in Source Code Form, including any+Modifications that You create or to which You contribute, must be under+the terms of this License. You must inform recipients that the Source+Code Form of the Covered Software is governed by the terms of this+License, and how they can obtain a copy of this License. You may not+attempt to alter or restrict the recipients' rights in the Source Code+Form.++3.2. Distribution of Executable Form++If You distribute Covered Software in Executable Form then:++(a) such Covered Software must also be made available in Source Code+ Form, as described in Section 3.1, and You must inform recipients of+ the Executable Form how they can obtain a copy of such Source Code+ Form by reasonable means in a timely manner, at a charge no more+ than the cost of distribution to the recipient; and++(b) You may distribute such Executable Form under the terms of this+ License, or sublicense it under different terms, provided that the+ license for the Executable Form does not attempt to limit or alter+ the recipients' rights in the Source Code Form under this License.++3.3. Distribution of a Larger Work++You may create and distribute a Larger Work under terms of Your choice,+provided that You also comply with the requirements of this License for+the Covered Software. If the Larger Work is a combination of Covered+Software with a work governed by one or more Secondary Licenses, and the+Covered Software is not Incompatible With Secondary Licenses, this+License permits You to additionally distribute such Covered Software+under the terms of such Secondary License(s), so that the recipient of+the Larger Work may, at their option, further distribute the Covered+Software under the terms of either this License or such Secondary+License(s).++3.4. Notices++You may not remove or alter the substance of any license notices+(including copyright notices, patent notices, disclaimers of warranty,+or limitations of liability) contained within the Source Code Form of+the Covered Software, except that You may alter any license notices to+the extent required to remedy known factual inaccuracies.++3.5. Application of Additional Terms++You may choose to offer, and to charge a fee for, warranty, support,+indemnity or liability obligations to one or more recipients of Covered+Software. However, You may do so only on Your own behalf, and not on+behalf of any Contributor. You must make it absolutely clear that any+such warranty, support, indemnity, or liability obligation is offered by+You alone, and You hereby agree to indemnify every Contributor for any+liability incurred by such Contributor as a result of warranty, support,+indemnity or liability terms You offer. You may include additional+disclaimers of warranty and limitations of liability specific to any+jurisdiction.++4. Inability to Comply Due to Statute or Regulation+---------------------------------------------------++If it is impossible for You to comply with any of the terms of this+License with respect to some or all of the Covered Software due to+statute, judicial order, or regulation then You must: (a) comply with+the terms of this License to the maximum extent possible; and (b)+describe the limitations and the code they affect. Such description must+be placed in a text file included with all distributions of the Covered+Software under this License. Except to the extent prohibited by statute+or regulation, such description must be sufficiently detailed for a+recipient of ordinary skill to be able to understand it.++5. Termination+--------------++5.1. The rights granted under this License will terminate automatically+if You fail to comply with any of its terms. However, if You become+compliant, then the rights granted under this License from a particular+Contributor are reinstated (a) provisionally, unless and until such+Contributor explicitly and finally terminates Your grants, and (b) on an+ongoing basis, if such Contributor fails to notify You of the+non-compliance by some reasonable means prior to 60 days after You have+come back into compliance. Moreover, Your grants from a particular+Contributor are reinstated on an ongoing basis if such Contributor+notifies You of the non-compliance by some reasonable means, this is the+first time You have received notice of non-compliance with this License+from such Contributor, and You become compliant prior to 30 days after+Your receipt of the notice.++5.2. If You initiate litigation against any entity by asserting a patent+infringement claim (excluding declaratory judgment actions,+counter-claims, and cross-claims) alleging that a Contributor Version+directly or indirectly infringes any patent, then the rights granted to+You by any and all Contributors for the Covered Software under Section+2.1 of this License shall terminate.++5.3. In the event of termination under Sections 5.1 or 5.2 above, all+end user license agreements (excluding distributors and resellers) which+have been validly granted by You or Your distributors under this License+prior to termination shall survive termination.++************************************************************************+* *+* 6. Disclaimer of Warranty *+* ------------------------- *+* *+* Covered Software is provided under this License on an "as is" *+* basis, without warranty of any kind, either expressed, implied, or *+* statutory, including, without limitation, warranties that the *+* Covered Software is free of defects, merchantable, fit for a *+* particular purpose or non-infringing. The entire risk as to the *+* quality and performance of the Covered Software is with You. *+* Should any Covered Software prove defective in any respect, You *+* (not any Contributor) assume the cost of any necessary servicing, *+* repair, or correction. This disclaimer of warranty constitutes an *+* essential part of this License. No use of any Covered Software is *+* authorized under this License except under this disclaimer. *+* *+************************************************************************++************************************************************************+* *+* 7. Limitation of Liability *+* -------------------------- *+* *+* Under no circumstances and under no legal theory, whether tort *+* (including negligence), contract, or otherwise, shall any *+* Contributor, or anyone who distributes Covered Software as *+* permitted above, be liable to You for any direct, indirect, *+* special, incidental, or consequential damages of any character *+* including, without limitation, damages for lost profits, loss of *+* goodwill, work stoppage, computer failure or malfunction, or any *+* and all other commercial damages or losses, even if such party *+* shall have been informed of the possibility of such damages. This *+* limitation of liability shall not apply to liability for death or *+* personal injury resulting from such party's negligence to the *+* extent applicable law prohibits such limitation. Some *+* jurisdictions do not allow the exclusion or limitation of *+* incidental or consequential damages, so this exclusion and *+* limitation may not apply to You. *+* *+************************************************************************++8. Litigation+-------------++Any litigation relating to this License may be brought only in the+courts of a jurisdiction where the defendant maintains its principal+place of business and such litigation shall be governed by laws of that+jurisdiction, without reference to its conflict-of-law provisions.+Nothing in this Section shall prevent a party's ability to bring+cross-claims or counter-claims.++9. Miscellaneous+----------------++This License represents the complete agreement concerning the subject+matter hereof. If any provision of this License is held to be+unenforceable, such provision shall be reformed only to the extent+necessary to make it enforceable. Any law or regulation which provides+that the language of a contract shall be construed against the drafter+shall not be used to construe this License against a Contributor.++10. Versions of the License+---------------------------++10.1. New Versions++Mozilla Foundation is the license steward. Except as provided in Section+10.3, no one other than the license steward has the right to modify or+publish new versions of this License. Each version will be given a+distinguishing version number.++10.2. Effect of New Versions++You may distribute the Covered Software under the terms of the version+of the License under which You originally received the Covered Software,+or under the terms of any subsequent version published by the license+steward.++10.3. Modified Versions++If you create software not governed by this License, and you want to+create a new license for such software, you may create and use a+modified version of this License if you rename the license and remove+any references to the name of the license steward (except to note that+such modified license differs from this License).++10.4. Distributing Source Code Form that is Incompatible With Secondary+Licenses++If You choose to distribute Source Code Form that is Incompatible With+Secondary Licenses under the terms of this version of the License, the+notice described in Exhibit B of this License must be attached.++Exhibit A - Source Code Form License Notice+-------------------------------------------++ 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/.++If it is not possible or desirable to put the notice in a particular+file, then You may include the notice in a location (such as a LICENSE+file in a relevant directory) where a recipient would be likely to look+for such a notice.++You may add additional accurate notices of copyright ownership.++Exhibit B - "Incompatible With Secondary Licenses" Notice+---------------------------------------------------------++ This Source Code Form is "Incompatible With Secondary Licenses", as+ defined by the Mozilla Public License, v. 2.0.
+ README.pro view
@@ -0,0 +1,33 @@+title: Prosidy README+---++Prosidy is a small language for writing documents.++Like #link[url='https://daringfireball.net/projects/markdown/']{Markdown},+Prosidy's syntax is lightweight; it doesn't get in the way of your text.++Like #link[url='https://www.w3.org/XML/']{XML},+Prosidy is extensible: it doesn't make any assumptions about your content.+You'll never have to fight to make your data fit a structure that wasn't designed for it.++#=src[lang='prosidy']:end+recipe: A simple roux+---+In a #ware{medium saucepan},+heat #ingredient[amount='25', unit='g']{oil}+until dropping a pinch of flour into the oil causes it to bubble.++#ware{Whisk} #ingredient[amount='25', unit='g']{flour}+into the oil until the roux is the desired color.+#:end++All of the code here is under #b{heavy} development;+be careful before using it for anything critical!++That said, feedback is more than welcome!+Reach me at #link[url='mailto:alex@fldcr.com']{alex@fldcr.com}.++#-h{Developing Prosidy}+This project sets up an environment using direnv and Nix.+We'd recommend you have both installed before building,+although it may work without both.
+ data/golden/comment/input.pro view
@@ -0,0 +1,127 @@+case: Comments++## Empty line in header+ ## Empty line after spaces in header++prop ## After a property+empty = ## After an empty setting+nonempty = yes ## After a non-empty setting++---++## Empty line in the body+ ## Empty line after spaces in the body+++#-tag ## Immediately after an empty block-tag++## On the line preceeding an empty block tag+#-tag++#-tag+## On the line proceeding an empty block tag+++#-tag[prop, setting=''] ## Immediately after an empty block-tag with metadata++## On the line preceeding an empty block tag with metadata+#-tag[prop, setting='']++#-tag[prop, setting='']+## On the line proceeding an empty block tag with metadata++#-tag[ ## After the metadata open bracket+prop ## After a property in the metadata+, ## After a metadata separator+setting ## After a setting key in the metadata+= ## After the association operator+"foo" ## After a quoted value+] ## After a metadata close bracket++#-tag[ ## After the metadata open bracket+prop ## After a property in the metadata+, ## After a metadata separator+setting ## After a setting key in the metadata+= ## After the association operator+"foo" ## After a quoted value+]: ## After the block open colon+ ## Within a block+ Inner contents++ Another paragraph+ ## Within a block+#: ## After a named block close++#-tag[ ## After the metadata open bracket+prop ## After a property in the metadata+, ## After a metadata separator+setting ## After a setting key in the metadata+= ## After the association operator+"foo" ## After a quoted value+]:end ## After the block open colon+ ## Within a block+ Inner contents++ Another paragraph+ ## Within a block+#:end ## After a named block close++#-tag[ ## After the metadata open bracket+prop ## After a property in the metadata+, ## After a metadata separator+setting ## After a setting key in the metadata+= ## After the association operator+"foo" ## After a quoted value+]{ ## After the inline brace++## Within the brace++Inner contents++## Within the brace++} ## After the inline brace++## Before a paragraph+Blah blah ## After a line in a paragraph+blah blah. ## After a line in a paragraph+#inline[ ## After a dangling inline meta open+prop ## After a property in the metadata+, ## After a metadata separator+setting ## After a setting key in the metadata+= ## After the association operator+"foo" ## After a quoted value+] ## After the inline meta close+#inline[ ## After a dangling inline meta open+prop ## After a property in the metadata+, ## After a metadata separator+setting ## After a setting key in the metadata+= ## After the association operator+"foo" ## After a quoted value+]{ ## Within the brace+ ## Within the brace+look ma ## After a paragraph in a brace+ ## Within the brace+ ## Within the brace+} ## After a brace closes+#inline[ ## After a dangling inline meta open+prop ## After a property in the metadata+, ## After a metadata separator+setting ## After a setting key in the metadata+= ## After the association operator+"foo" ## After a quoted value+]{ ## Within the brace+ ## Within the brace+no hands ## After a paragraph in a brace+ ## Within the brace+ ## Within the brace+} content ## After a brace closes with trailing content+## After a paragraph+++#=src:end ## After a literal tag's opening line+ ## This is _not_ a comment; it's part of the tag around it+#:end ## After a literal tag's closing line++## As the last line of a document, without a trailing newline+## This is a direct remediation of a bug I found
+ data/golden/comment/output.json view
@@ -0,0 +1,312 @@+{+ "content": [+ {+ "value": {+ "content": [],+ "name": "tag",+ "metadata": {+ "settings": {},+ "properties": {}+ }+ },+ "subtype": "block",+ "type": "tag"+ },+ {+ "value": {+ "content": [],+ "name": "tag",+ "metadata": {+ "settings": {},+ "properties": {}+ }+ },+ "subtype": "block",+ "type": "tag"+ },+ {+ "value": {+ "content": [],+ "name": "tag",+ "metadata": {+ "settings": {},+ "properties": {}+ }+ },+ "subtype": "block",+ "type": "tag"+ },+ {+ "value": {+ "content": [],+ "name": "tag",+ "metadata": {+ "settings": {+ "setting": ""+ },+ "properties": {+ "prop": true+ }+ }+ },+ "subtype": "block",+ "type": "tag"+ },+ {+ "value": {+ "content": [],+ "name": "tag",+ "metadata": {+ "settings": {+ "setting": ""+ },+ "properties": {+ "prop": true+ }+ }+ },+ "subtype": "block",+ "type": "tag"+ },+ {+ "value": {+ "content": [],+ "name": "tag",+ "metadata": {+ "settings": {+ "setting": ""+ },+ "properties": {+ "prop": true+ }+ }+ },+ "subtype": "block",+ "type": "tag"+ },+ {+ "value": {+ "content": [],+ "name": "tag",+ "metadata": {+ "settings": {+ "setting": "foo"+ },+ "properties": {+ "prop": true+ }+ }+ },+ "subtype": "block",+ "type": "tag"+ },+ {+ "value": {+ "content": [+ {+ "value": [+ {+ "value": "Inner contents",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": "Another paragraph",+ "type": "text"+ }+ ],+ "type": "paragraph"+ }+ ],+ "name": "tag",+ "metadata": {+ "settings": {+ "setting": "foo"+ },+ "properties": {+ "prop": true+ }+ }+ },+ "subtype": "block",+ "type": "tag"+ },+ {+ "value": {+ "content": [+ {+ "value": [+ {+ "value": "Inner contents",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": "Another paragraph",+ "type": "text"+ }+ ],+ "type": "paragraph"+ }+ ],+ "name": "tag",+ "metadata": {+ "settings": {+ "setting": "foo"+ },+ "properties": {+ "prop": true+ }+ }+ },+ "subtype": "block",+ "type": "tag"+ },+ {+ "value": {+ "content": [+ {+ "value": [+ {+ "value": "Inner contents",+ "type": "text"+ }+ ],+ "type": "paragraph"+ }+ ],+ "name": "tag",+ "metadata": {+ "settings": {+ "setting": "foo"+ },+ "properties": {+ "prop": true+ }+ }+ },+ "subtype": "block",+ "type": "tag"+ },+ {+ "value": [+ {+ "value": "Blah blah",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "blah blah.",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "content": [],+ "name": "inline",+ "metadata": {+ "settings": {+ "setting": "foo"+ },+ "properties": {+ "prop": true+ }+ }+ },+ "subtype": "inline",+ "type": "tag"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "content": [+ {+ "value": "look ma",+ "type": "text"+ }+ ],+ "name": "inline",+ "metadata": {+ "settings": {+ "setting": "foo"+ },+ "properties": {+ "prop": true+ }+ }+ },+ "subtype": "inline",+ "type": "tag"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "content": [+ {+ "value": "no hands",+ "type": "text"+ }+ ],+ "name": "inline",+ "metadata": {+ "settings": {+ "setting": "foo"+ },+ "properties": {+ "prop": true+ }+ }+ },+ "subtype": "inline",+ "type": "tag"+ },+ {+ "type": "break"+ },+ {+ "value": "content",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": {+ "content": " ## This is _not_ a comment; it's part of the tag around it",+ "name": "src",+ "metadata": {+ "settings": {},+ "properties": {}+ }+ },+ "subtype": "literal",+ "type": "tag"+ }+ ],+ "metadata": {+ "settings": {+ "empty": "",+ "case": "Comments",+ "nonempty": "yes"+ },+ "properties": {+ "prop": true+ }+ }+}
+ data/golden/empty-document/input.pro view
@@ -0,0 +1,1 @@+---
+ data/golden/empty-document/output.json view
@@ -0,0 +1,7 @@+{+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+}
+ data/golden/gamut/input.pro view
@@ -0,0 +1,164 @@+## This is an example document which enumerates many valid syntaxes. It is+## probably not exhaustive, but should serve as a good document to implement+## against.++## Properties+prop+prop-with-comment ## this has a trailing comment+ prop-with-leading-spaces ## arbitrary leading spaces are permitted++## Settings+set-a1:42+set-a2=42+set-a3: 42+set-a4= 42+set-a5 :42+set-a6 =42+set-a7 = 42+set-a8 : 42++ set-a9 = 42 ## arbitrary leading spaces are permitted++## Settings with trailing comments+set-b1:42 ## this has a trailing comment+set-b2=42 ## this has a trailing comment+set-b3: 42 ## this has a trailing comment+set-b4= 42 ## this has a trailing comment+set-b5 :42 ## this has a trailing comment+set-b6 =42 ## this has a trailing comment+set-b7 = 42 ## this has a trailing comment+set-b8 : 42 ## this has a trailing comment++## Settings with escaped values+set-c1 = foo \# bar+set-c2 = \#\# not a comment ## is a comment++## Settings with null values+set-d1 =+set-d2 :+set-d3 = ## Just a comment, not a value+set-d4 : ## Just a comment, not a value+---++Paragraph with only one line.++Paragraph trailed by comment. ## This is the comment++Paragraph split+over multiple lines.++ Paragraph split ## with an indent!+over multiple lines ## Another sneaky comment+with a comment trailing some.++#tag{This} paragraph starts with a simple tag.++This paragraph ends with a simple #tag{tag.}++This #tag{paragraph} has a few #tag{tags}.++#a{}b#c{}#d{}++This paragraph has a number of inline tag styles.+#tag ## no meta, no children+#tag[] ## no meta, no children+#tag[]{} ## no meta, no children+#tag[prop] ## 1 prop, no children+#tag[prop1,prop2] ## 2 props, no children+#tag[set = '42'] ## 1 setting (equal, single quote), no children+#tag[set = "42"] ## 1 setting (equal, double quote), no children+#tag[set: '42'] ## 1 setting (colon, single quote), no children+#tag[set: "42"] ## 1 setting (colon, double quote), no children+#tag[prop, foo: 'bar', baz = "quz"] ## complicated, no children+#tag{content} ## no meta, children+#tag[]{content} ## no meta, children+#tag{#tag{ok}} ## no meta, children containing tags+#tag[prop, foo: 'bar', baz = "quz"]{#tag{ok}} ## ok wow+#tag[+] ## Meta blocks can span multiple lines+#tag[ ## Comments can go here+ ## Because items in the metadata block are relatively structured+ ## compared to the rest of the document, you can go wild with+ ## how properties are laid out++ prop1, prop2 ## Comments can go here+, set ## Comments can go here+= '42', prop3 ## Comments can go here+]{This one is pathological}++This paragraph has some tags that are awfuly close to one another.+#tag{}text#tag{}text#tag#tag{}.++#tag{This is a paragraph in an #kind{inline} tag.}++#tag{This is a paragraph in an #kind{inline} tag.+ It spans many lines.+ Content may follow.} This follows!++#tag{This is a paragraph in an #kind{inline} tag. ## Comments can go here+ It spans many lines . ## Comments can go here+ Content may follow.} This follows! ## Comments can go here++#-tag{This is a paragraph in a #kind{block} tag. ## Comments can go here+ Content may not follow.} ## Comments can go here++#-block: ## Comments can go here+ This is the other kind of block tag.+ It can have #italic{nested} block children.++ #-block: ## Empty blocks are fine too+ #:++ #-block[prop]:label ## Comments can go here+ Block starts/ends can have aribtrary labels attached.+ #:label ## Comments can go here++ #-block[set='42']:label ## Comments can go here+ Block starts/ends can have aribtrary labels attached.+ #:label ## Comments can go here++ #-block[prop1, set: '42', prop2]:label ## Comments can go here+ Block starts/ends can have aribtrary labels attached.+ #:label ## Comments can go here+#: ## Comments can go here++#-block[ ## Comments can go here+ ## Because items in the metadata block are relatively structured+ ## compared to the rest of the document, you can go wild with+ ## how properties are laid out++ prop1, prop2 ## Comments can go here+, set ## Comments can go here+= '42', prop3 ## Comments can go here+]:end ## Comments can go here+ This is another pathological tag, just a block this time.+ #:end++## This is a literal tag+## The label is once again optional like block tags,+## but a label is _very_ helpful for quoting prosidy+#=lit:eof ## Comments can go here, but not on the next line+#-block: ## this is treated literally!+ This is the other kind of block tag.+ It can have #italic{nested} block children.++ #-block: ## this is treated literally!+ #:++ #-block[prop]:label ## this is treated literally!+ Block starts/ends can have aribtrary labels attached.+ #:label ## this is treated literally!++ #-block[set='42']:label ## this is treated literally!+ Block starts/ends can have aribtrary labels attached.+ #:label ## this is treated literally!++ #-block[prop1, set: '42', prop2]:label ## this is treated literally!+ Block starts/ends can have aribtrary labels attached.+ #:label ## this is treated literally!+#: ## this is treated literally!+#:eof ## Comments can go here again++Some unicode escapes:+ "\u1F638" is a smiling cat face,+ and "\uB" is a vertical tab.
+ data/golden/gamut/output.json view
@@ -0,0 +1,1108 @@+{+ "metadata": {+ "properties": {+ "prop": true,+ "prop-with-comment": true,+ "prop-with-leading-spaces": true+ },+ "settings": {+ "set-a1": "42",+ "set-a2": "42",+ "set-a3": "42",+ "set-a4": "42",+ "set-a5": "42",+ "set-a6": "42",+ "set-a7": "42",+ "set-a8": "42",+ "set-a9": "42",+ "set-b1": "42",+ "set-b2": "42",+ "set-b3": "42",+ "set-b4": "42",+ "set-b5": "42",+ "set-b6": "42",+ "set-b7": "42",+ "set-b8": "42",+ "set-c1": "foo # bar",+ "set-c2": "## not a comment",+ "set-d1": "",+ "set-d2": "",+ "set-d3": "",+ "set-d4": ""+ }+ },+ "content": [+ {+ "value": [+ {+ "value": "Paragraph with only one line.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": "Paragraph trailed by comment.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": "Paragraph split",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "over multiple lines.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": "Paragraph split",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "over multiple lines",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "with a comment trailing some.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "This",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": "paragraph starts with a simple tag.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": "This paragraph ends with a simple",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "tag.",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": "This",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "paragraph",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": "has a few",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "tags",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "value": ".",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": {+ "name": "a",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "value": "b",+ "type": "text"+ },+ {+ "value": {+ "name": "c",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "value": {+ "name": "d",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": "This paragraph has a number of inline tag styles.",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {+ "prop": true+ },+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {+ "prop1": true,+ "prop2": true+ },+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {+ "set": "42"+ }+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {+ "set": "42"+ }+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {+ "set": "42"+ }+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {+ "set": "42"+ }+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {+ "prop": true+ },+ "settings": {+ "baz": "quz",+ "foo": "bar"+ }+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "content",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "content",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "ok",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {+ "prop": true+ },+ "settings": {+ "baz": "quz",+ "foo": "bar"+ }+ },+ "content": [+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "ok",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {+ "prop1": true,+ "prop2": true,+ "prop3": true+ },+ "settings": {+ "set": "42"+ }+ },+ "content": [+ {+ "value": "This one is pathological",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": "This paragraph has some tags that are awfuly close to one another.",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "value": "text",+ "type": "text"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "value": "text",+ "type": "text"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "value": ".",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "This is a paragraph in an",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "kind",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "inline",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": "tag.",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "This is a paragraph in an",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "kind",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "inline",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": "tag.",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "It spans many lines.",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "Content may follow.",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": "This follows!",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "This is a paragraph in an",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "kind",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "inline",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": "tag.",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "It spans many lines .",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "Content may follow.",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": "This follows!",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": {+ "name": "tag",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": [+ {+ "value": "This is a paragraph in a",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "kind",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "block",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": "tag.",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "Content may not follow.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ }+ ]+ },+ "type": "tag",+ "subtype": "block"+ },+ {+ "value": {+ "name": "block",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": [+ {+ "value": "This is the other kind of block tag.",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "It can have",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "name": "italic",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": [+ {+ "value": "nested",+ "type": "text"+ }+ ]+ },+ "type": "tag",+ "subtype": "inline"+ },+ {+ "type": "break"+ },+ {+ "value": "block children.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": {+ "name": "block",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": []+ },+ "type": "tag",+ "subtype": "block"+ },+ {+ "value": {+ "name": "block",+ "metadata": {+ "properties": {+ "prop": true+ },+ "settings": {}+ },+ "content": [+ {+ "value": [+ {+ "value": "Block starts/ends can have aribtrary labels attached.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ }+ ]+ },+ "type": "tag",+ "subtype": "block"+ },+ {+ "value": {+ "name": "block",+ "metadata": {+ "properties": {},+ "settings": {+ "set": "42"+ }+ },+ "content": [+ {+ "value": [+ {+ "value": "Block starts/ends can have aribtrary labels attached.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ }+ ]+ },+ "type": "tag",+ "subtype": "block"+ },+ {+ "value": {+ "name": "block",+ "metadata": {+ "properties": {+ "prop1": true,+ "prop2": true+ },+ "settings": {+ "set": "42"+ }+ },+ "content": [+ {+ "value": [+ {+ "value": "Block starts/ends can have aribtrary labels attached.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ }+ ]+ },+ "type": "tag",+ "subtype": "block"+ }+ ]+ },+ "type": "tag",+ "subtype": "block"+ },+ {+ "value": {+ "name": "block",+ "metadata": {+ "properties": {+ "prop1": true,+ "prop2": true,+ "prop3": true+ },+ "settings": {+ "set": "42"+ }+ },+ "content": [+ {+ "value": [+ {+ "value": "This is another pathological tag, just a block this time.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ }+ ]+ },+ "type": "tag",+ "subtype": "block"+ },+ {+ "value": {+ "name": "lit",+ "metadata": {+ "properties": {},+ "settings": {}+ },+ "content": "#-block: ## this is treated literally!\n This is the other kind of block tag.\n It can have #italic{nested} block children.\n\n #-block: ## this is treated literally!\n #:\n\n #-block[prop]:label ## this is treated literally!\n Block starts/ends can have aribtrary labels attached.\n #:label ## this is treated literally!\n\n #-block[set='42']:label ## this is treated literally!\n Block starts/ends can have aribtrary labels attached.\n #:label ## this is treated literally!\n\n #-block[prop1, set: '42', prop2]:label ## this is treated literally!\n Block starts/ends can have aribtrary labels attached.\n #:label ## this is treated literally!\n#: ## this is treated literally!"+ },+ "type": "tag",+ "subtype": "literal"+ },+ {+ "value": [+ {+ "value": "Some unicode escapes:",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "\"😸\" is a smiling cat face,",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "and \"\u000b\" is a vertical tab.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ }+ ]+}
+ data/golden/invalid-utf8/input.pro view
@@ -0,0 +1,6 @@+case: Invalid Utf-8+---++The next paragraph contains the character #lit{0xC0}, which is not valid UTF-8.++Invalid:À
+ data/golden/invalid-utf8/output.json view
@@ -0,0 +1,52 @@+{+ "content": [+ {+ "value": [+ {+ "value": "The next paragraph contains the character",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": {+ "content": [+ {+ "value": "0xC0",+ "type": "text"+ }+ ],+ "name": "lit",+ "metadata": {+ "settings": {},+ "properties": {}+ }+ },+ "subtype": "inline",+ "type": "tag"+ },+ {+ "value": ", which is not valid UTF-8.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": "Invalid:�",+ "type": "text"+ }+ ],+ "type": "paragraph"+ }+ ],+ "metadata": {+ "settings": {+ "case": "Invalid Utf-8"+ },+ "properties": {}+ }+}
+ data/golden/line-break/input.pro view
@@ -0,0 +1,7 @@+case: Line breaks+---+This is a paragraph ending in a Unix break.++This is a paragraph ending in a Windows break. + +This is a paragraph ending in a classic Mac OS break.
+ data/golden/line-break/output.json view
@@ -0,0 +1,37 @@+{+ "content": [+ {+ "value": [+ {+ "value": "This is a paragraph ending in a Unix break.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": "This is a paragraph ending in a Windows break.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ },+ {+ "value": [+ {+ "value": "This is a paragraph ending in a classic Mac OS break.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ }+ ],+ "metadata": {+ "settings": {+ "case": "Line breaks"+ },+ "properties": {}+ }+}
+ data/golden/shebang/input.pro view
@@ -0,0 +1,5 @@+#!psh+---++This document has a shebang at the start.+Make sure we can parse it.
+ data/golden/shebang/output.json view
@@ -0,0 +1,24 @@+{+ "content": [+ {+ "value": [+ {+ "value": "This document has a shebang at the start.",+ "type": "text"+ },+ {+ "type": "break"+ },+ {+ "value": "Make sure we can parse it.",+ "type": "text"+ }+ ],+ "type": "paragraph"+ }+ ],+ "metadata": {+ "settings": {},+ "properties": {}+ }+}
+ prosidy.cabal view
@@ -0,0 +1,117 @@+cabal-version: 2.4+name: prosidy+version: 1.5.0.1+synopsis: A simple language for writing documents.+license: MPL-2.0+license-file: LICENSE+author: James Alexander Feldman-Crough+maintainer: alex@fldcr.com+copyright: ©2020 to James Alexander Feldman-Crough+category: Language+data-dir: data+data-files: golden/**/*.pro, golden/**/*.json+extra-source-files: CHANGELOG, README.pro++tested-with:+ GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.1++description:+ Prosidy is a small language for writing documents.+ More details are on its site at https://prosidy.org.++source-repository head+ type: git+ location: https://git.fldcr.com/prosidy/prosidy++flag fatal-warnings+ description: Turns all warnings into errors. Used in CI.+ default: False+ manual: True++-------------------------------------------------------------------------------+library+ default-language: Haskell2010+ hs-source-dirs: src++ ghc-options:+ -Wall+ -Wno-name-shadowing++ if flag(fatal-warnings)+ ghc-options:+ -Werror++ exposed-modules:+ Prosidy+ , Prosidy.Optics+ , Prosidy.Optics.Source+ , Prosidy.Optics.Types+ , Prosidy.Parse+ , Prosidy.Source+ , Prosidy.Types+ , Prosidy.Types.Assoc+ , Prosidy.Types.Key+ , Prosidy.Types.Set+ , Prosidy.Types.Series++ other-modules:+ Prosidy.Optics.Internal+ , Prosidy.Compat++ build-depends:+ base >= 4.11 && < 5+ , aeson >= 1.4 && < 1.5+ , bytestring >= 0.10 && < 0.11+ , binary >= 0.8 && < 0.9+ , containers >= 0.6 && < 0.7+ , contravariant >= 1.5 && < 1.6+ , deepseq >= 1.4 && < 1.5+ , hashable >= 1.2 && < 1.4+ , megaparsec >= 7.0 && < 8.1+ , profunctors >= 5.3 && < 5.6+ , tagged >= 0.8 && < 0.9+ , text >= 1.2 && < 1.3+ , transformers >= 0.5 && < 0.6+ , vector >= 0.12 && < 0.13+ , unordered-containers >= 0.2 && < 0.3++-------------------------------------------------------------------------------+test-suite prosidy-test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test++ ghc-options:+ -Wall+ -Wno-name-shadowing++ main-is:+ Prosidy/Test.hs++ other-modules:+ Prosidy.Test.Source+ , Prosidy.Test.Types+ , Prosidy.Test.Parse+ , Paths_prosidy++ autogen-modules:+ Paths_prosidy++ build-depends:+ base+ , prosidy+ , aeson >= 1.4 && < 1.5+ , aeson-pretty >= 0.8 && < 0.9+ , aeson-diff >= 1.1 && < 1.2+ , bytestring >= 0.10 && < 0.11+ , containers >= 0.6 && < 0.7+ , directory >= 1.3 && < 1.4+ , filepath >= 1.4 && < 1.5+ , tasty >= 1.2 && < 1.3+ , tasty-ant-xml >= 1.1 && < 1.2+ , tasty-golden >= 2.3 && < 2.4+ , tasty-hunit >= 0.10 && < 1.11+ , tasty-quickcheck >= 0.10 && < 0.11+ , text >= 1.2 && < 1.3
+ src/Prosidy.hs view
@@ -0,0 +1,19 @@+{-|+Module : Prosidy+Description : Top-level module exporting types, parsing functions, and optics.+Copyright : ©2020 James Alexander Feldman-Crough+License : MPL-2.0+Maintainer : alex@fldcr.com+-}+module Prosidy (module X) where++import Prosidy.Source as X+ ( Source+ , Location+ , Line+ , Column+ , Offset+ )+import Prosidy.Optics as X+import Prosidy.Parse as X+import Prosidy.Types as X
+ src/Prosidy/Compat.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE CPP #-}+module Prosidy.Compat + ( MonadFail(..) + ) where++#if __GLASGOW_HASKELL__ < 808+import Control.Monad.Fail (MonadFail(..))+#endif
+ src/Prosidy/Optics.hs view
@@ -0,0 +1,11 @@+{-|+Module : Prosidy.Optics+Description : A convenience module which reëxports optics definitions. +Copyright : ©2020 James Alexander Feldman-Crough+License : MPL-2.0+Maintainer : alex@fldcr.com+-}+module Prosidy.Optics (module X) where++import Prosidy.Optics.Source as X+import Prosidy.Optics.Types as X
+ src/Prosidy/Optics/Internal.hs view
@@ -0,0 +1,116 @@+{-|+Module : Prosidy.Optics.Internal+Description : Internal implementations of common Optics functions, removing a dependency on lens.+Copyright : ©2020 James Alexander Feldman-Crough+License : MPL-2.0+Maintainer : alex@fldcr.com+-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+module Prosidy.Optics.Internal+ ( module Prosidy.Optics.Internal+ , Profunctor(..)+ , Choice(..)+ , Strong(..)+ , Contravariant(..)+ )+where++import Data.Profunctor ( Profunctor(..)+ , Choice(..)+ , Strong(..)+ )+import Data.Functor.Const ( Const(..) )+import Data.Monoid ( First(..)+ , Endo(..)+ )+import Data.Functor.Identity ( Identity(..) )+import Data.Tagged ( Tagged(..) )+import Data.Functor.Contravariant ( Contravariant(..) )++type Optic p f s t a b = p a (f b) -> p s (f t)+type Iso s t a b = forall p f . (Profunctor p, Functor f) => Optic p f s t a b+type Lens s t a b = forall p f . (Strong p, Functor f) => Optic p f s t a b+type Prism s t a b+ = forall p f . (Choice p, Applicative f) => Optic p f s t a b+type Affine s t a b+ = forall p f . (Choice p, Strong p, Applicative f) => Optic p f s t a b+type Traversal s t a b = forall f . (Applicative f) => Optic (->) f s t a b++type Optic' p f s a = Optic p f s s a a+type Iso' s a = Iso s s a a+type Lens' s a = Lens s s a a+type Prism' s a = Prism s s a a+type Affine' s a = Affine s s a a+type Traversal' s a = Traversal s s a a++type Getter s a = forall f . (Functor f, Contravariant f) => Optic' (->) f s a++iso :: (s -> a) -> (b -> t) -> Iso s t a b+iso get set = dimap get (fmap set)+{-# INLINE iso #-}++lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b+lens get set = dimap into outof . second'+ where+ into x = (x, get x)+ outof (x, f) = fmap (set x) f+{-# INLINE lens #-}++prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b+prism set get = dimap get rhs . right' where rhs = either pure (fmap set)+{-# INLINE prism #-}++prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b+prism' set get = dimap lhs rhs . right'+ where+ lhs x = maybe (Left x) Right (get x)+ rhs = either pure (fmap set)+{-# INLINE prism' #-}++affine :: (s -> Either t a) -> (s -> b -> t) -> Affine s t a b+affine get set = dimap lhs rhs . right' . second'+ where+ lhs x = fmap (x, ) $ get x+ rhs = either pure (\(x, f) -> set x <$> f)+{-# INLINE affine #-}++affine' :: (s -> Maybe a) -> (s -> b -> s) -> Affine s s a b+affine' get set = dimap lhs rhs . right' . second'+ where+ lhs x = maybe (Left x) (Right . (x, )) $ get x+ rhs (Left x ) = pure x+ rhs (Right (x, f)) = set x <$> f+{-# INLINE affine' #-}++nullAffine :: Affine s s a b+nullAffine = affine' (const Nothing) const+{-# INLINE nullAffine #-}++to :: (s -> a) -> Getter s a+to k = dimap k (contramap k)+{-# INLINE to #-}++view :: Lens s t a b -> s -> a+view f = getConst . f Const+{-# INLINE view #-}++views :: Traversal s t a b -> s -> [a]+views f = flip appEndo [] . getConst . f (Const . Endo . (:))+{-# INLINE views #-}++preview :: Optic (->) (Const (First a)) s t a b -> s -> Maybe a+preview f = getFirst . getConst . f (Const . First . Just)+{-# INLINE preview #-}++over :: Optic (->) Identity s t a b -> (a -> b) -> s -> t+over t f = runIdentity . t (Identity . f)+{-# INLINE over #-}++assign :: Optic' (->) Identity s a -> a -> s -> s+assign t = over t . const+{-# INLINE assign #-}++review :: Prism' s a -> a -> s+review p = runIdentity . unTagged . p . Tagged . Identity+{-# INLINE review #-}
+ src/Prosidy/Optics/Source.hs view
@@ -0,0 +1,84 @@+{-|+Module : Prosidy.Optics.Source+Description : Profunctor optics over Prosidy types.+Copyright : ©2020 James Alexander Feldman-Crough+License : MPL-2.0+Maintainer : alex@fldcr.com+-}+module Prosidy.Optics.Source+ ( -- * Classy optics; implementable on all types with a location+ HasLocation(..)+ , offset+ -- ** Read-only optics.+ , column+ , line+ , source++ -- * Conversion utilities+ , sparse+ )+where++import Prosidy.Types+import Prosidy.Source+import Prosidy.Optics.Internal++-- | A classy optic for selecting the 'Location' from a value. Note that+-- 'location' is affine: a 'Location' can't be attached to a value which does +-- not -- already have one, and not all values with an instance of +-- 'HasLocation' have a location.+class HasLocation t where+ location :: Affine' t Location++instance HasLocation Location where+ location = id+ {-# INLINE location #-}++instance HasLocation (Tag a) where+ location = affine' tagLocation (\d l -> d { tagLocation = Just l })+ {-# INLINE location #-}++instance HasLocation (Region a) where+ location = affine' regionLocation (\d l -> d { regionLocation = Just l })+ {-# INLINE location #-}++instance HasLocation Paragraph where+ location =+ affine' paragraphLocation (\d l -> d { paragraphLocation = Just l })+ {-# INLINE location #-}++-- | Focus on the 'Offset' from a value parsed from a source file. If the +-- 'Offset' is modified, note that the resulting 'column' and 'line' will /also/ be+-- modified as they are denormalizations of this value.+offset :: HasLocation l => Affine' l Offset+offset = location . sparse . lens+ sparseLocationOffset+ (\sl x -> sl { sparseLocationOffset = x })+{-# INLINE offset #-}++-- | Fetch the 'Column' from a value parsed from a source file. Modifications+-- are not allowed as the 'offset' and 'line' may become inconsistent.+column+ :: (HasLocation l, Contravariant f, Applicative f) => Optic' (->) f l Column+column = location . to locationColumn+{-# INLINE column #-}++-- | Fetch the 'Line' from a value parsed from a source file. Modifications+-- are not allowed as the 'offset' and 'column' may become inconsistent.+line :: (HasLocation l, Contravariant f, Applicative f) => Optic' (->) f l Line+line = location . to locationLine+{-# INLINE line #-}++-- | Fetch the 'Source' a value was parsed from. Modifications are not allowed +-- as the 'line', 'offset', and 'column' may become inconsistent.+source+ :: (HasLocation l, Contravariant f, Applicative f) => Optic' (->) f l Source+source = location . to locationSource+{-# INLINE source #-}++-- | An isomorphism between 'Location' and 'SparseLocation'. This is allowed+-- because although a 'Location' has strictly more data than a 'SparseLocation',+-- those values are denormalizations of values within 'SparseLocation'.+sparse :: Iso' Location SparseLocation+sparse = iso stripLocation enrichLocation+{-# INLINE sparse #-}
+ src/Prosidy/Optics/Types.hs view
@@ -0,0 +1,233 @@+{-|+Module : Prosidy.Optics.Types+Description : Optics for definitions in 'Prosidy.Types'.+Copyright : ©2020 James Alexander Feldman-Crough+License : MPL-2.0+Maintainer : alex@fldcr.com+-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+module Prosidy.Optics.Types+ ( -- * Classy optics+ -- ** Items with 'Metadata' + HasMetadata(..)+ , properties+ , settings+ , hasProperty+ , atSetting+ -- ** Items wrapping content+ , HasContent(..)+ -- * Accessors for fields not otherwise covered+ , tag+ -- * Conversion between 'Tag's and 'Region's.+ , tagged+ -- * Prisms on 'Block' contexts+ , _BlockTag+ , _BlockLiteral+ , _BlockParagraph+ -- * Prisms on 'Inline' contexts+ , _InlineTag+ , _Text+ , _Break+ -- * Optics on common types + , key+ , _Assoc+ , _NonEmpty+ , _Series+ , _SeriesNE+ , _Set+ )+where++import Prosidy.Types+import Prosidy.Types.Assoc ( toHashMap+ , fromHashMap+ )+import Prosidy.Types.Series ( toSeq+ , fromSeq+ , toSeqNE+ , fromSeqNE+ )+import Prosidy.Types.Set ( toHashSet+ , fromHashSet+ )+import Prosidy.Optics.Internal++import Data.Text ( Text )+import Data.Sequence ( Seq )+import Data.HashMap.Strict ( HashMap )+import Data.HashSet ( HashSet )++import qualified Data.HashMap.Strict as HM+import qualified Data.HashSet as HS++-------------------------------------------------------------------------------+-- | A classy optic for focusing on items with 'Metadata', including 'Tag's,+-- 'Region's, and 'Document's.+class HasMetadata t where+ metadata :: Lens' t Metadata++instance HasMetadata Document where+ metadata = lens documentMetadata (\d m -> d { documentMetadata = m })+ {-# INLINE metadata #-}++instance HasMetadata (Tag a) where+ metadata = lens tagMetadata (\d m -> d { tagMetadata = m })+ {-# INLINE metadata #-}++instance HasMetadata (Region a) where+ metadata = lens regionMetadata (\d m -> d { regionMetadata = m })+ {-# INLINE metadata #-}++instance HasMetadata Metadata where+ metadata = id+ {-# INLINE metadata #-}++-- | Fetch all properties from items which contain metadata.+properties :: HasMetadata m => Lens' m (Set Key)+properties =+ metadata . lens metadataProperties (\m p -> m { metadataProperties = p })+{-# INLINABLE properties #-}+{-# SPECIALIZE INLINE properties :: Lens' Metadata (Set Key) #-}+{-# SPECIALIZE INLINE properties :: Lens' Document (Set Key) #-}+{-# SPECIALIZE INLINE properties :: Lens' (Tag a) (Set Key) #-}+{-# SPECIALIZE INLINE properties :: Lens' (Region a) (Set Key) #-}++-- | Fetch all settings defined on items which contain metadata.+settings :: HasMetadata m => Lens' m (Assoc Key Text)+settings =+ metadata . lens metadataSettings (\m s -> m { metadataSettings = s })+{-# INLINABLE settings #-}+{-# SPECIALIZE INLINE settings :: Lens' Metadata (Assoc Key Text) #-}+{-# SPECIALIZE INLINE settings :: Lens' Document (Assoc Key Text) #-}+{-# SPECIALIZE INLINE settings :: Lens' (Tag a) (Assoc Key Text) #-}+{-# SPECIALIZE INLINE settings :: Lens' (Region a) (Assoc Key Text) #-}++-- | Check if a property is attached to an item with metadata. Using this+-- optic as a setter will add a property if set to 'True' and remove the+-- property when set to 'False'.+hasProperty :: HasMetadata m => Key -> Lens' m Bool+hasProperty k = properties . _Set . lens+ (HS.member k)+ (\hs b -> (if b then HS.insert else HS.delete) k hs)+{-# INLINE hasProperty #-}++-- | Select a setting from an item attached to metadata. Returns 'Nothing' if+-- no value is set.+atSetting :: HasMetadata m => Key -> Lens' m (Maybe Text)+atSetting k = settings . _Assoc . lens+ (HM.lookup k)+ (\hm x -> maybe (HM.delete k) (HM.insert k) x hm)+{-# INLINE atSetting #-}++-------------------------------------------------------------------------------+-- | An optic for selecting children of an item in a recursive structure.+class HasContent t where+ -- | The type of /all/ of the children collectively. For instance,+ -- @type Content Document = Series Block@, as 'Document' has zero or more+ -- contained 'Block's.+ type Content t+ content :: Lens' t (Content t)++instance HasContent Document where+ type Content Document = Series Block+ content = lens documentContent (\d c -> d { documentContent = c })+ {-# INLINE content #-}++instance HasContent (Tag a) where+ type Content (Tag a) = a+ content = lens tagContent (\t c -> t { tagContent = c })+ {-# INLINE content #-}++instance HasContent (Region a) where+ type Content (Region a) = a+ content = lens regionContent (\t c -> t { regionContent = c })+ {-# INLINE content #-}++instance HasContent Paragraph where+ type Content Paragraph = SeriesNE Inline+ content = lens paragraphContent (\t c -> t { paragraphContent = c })+ {-# INLINE content #-}++-------------------------------------------------------------------------------+-- | Focus on the name of a 'Tag'.+tag :: Lens' (Tag a) Key+tag = lens tagName (\t n -> t { tagName = n })+{-# INLINE tag #-}++-------------------------------------------------------------------------------+-- | Focus on the inner 'Region' of 'Tag's with a name. This can be used to+-- filter 'Tag's to a specific subset for manipulation.+tagged :: Key -> Prism' (Tag a) (Region a)+tagged k = prism' (regionToTag k)+ $ \tag -> if tagName tag == k then Just $ tagToRegion tag else Nothing+{-# INLINE tagged #-}++-------------------------------------------------------------------------------+-- | Focus only on block tags.+_BlockTag :: Prism' Block BlockTag+_BlockTag = prism' BlockTag $ \case+ BlockTag t -> Just t+ _ -> Nothing++-- | Focus only on paragraphs'+_BlockParagraph :: Prism' Block Paragraph+_BlockParagraph = prism' BlockParagraph $ \case+ BlockParagraph p -> Just p+ _ -> Nothing++-- | Focus only on literal tags.+_BlockLiteral :: Prism' Block LiteralTag+_BlockLiteral = prism' BlockLiteral $ \case+ BlockLiteral t -> Just t+ _ -> Nothing++-- | Focus only on inline tags.+_InlineTag :: Prism' Inline InlineTag+_InlineTag = prism' InlineTag $ \case+ InlineTag t -> Just t+ _ -> Nothing++-- | Focus only on text nodes.+_Text :: Prism' Inline Text+_Text = prism' InlineText $ \case+ InlineText t -> Just t+ _ -> Nothing++-- | Focus only on breaks.+_Break :: Prism' Inline ()+_Break = prism' (const Break) $ \case+ Break -> Just ()+ _ -> Nothing++-------------------------------------------------------------------------------+-- | A Prism from 'Text' into a valid 'Key'. +key :: Prism' Text Key+key = prism' rawKey (either (const Nothing) Just . makeKey)+{-# INLINE key #-}++-- | An isomorphism between Prosidy's 'Assoc' wrapper and 'HashMap'.+_Assoc :: Iso (Assoc k v) (Assoc k' v') (HashMap k v) (HashMap k' v')+_Assoc = iso toHashMap fromHashMap+{-# INLINE _Assoc #-}++-- | A prism between possibly-empty and non-empty containers.+_NonEmpty :: Prism' (Series a) (SeriesNE a)+_NonEmpty = prism' (fromSeq . toSeqNE) (fromSeqNE . toSeq)+{-# INLINE _NonEmpty #-}++-- | An isomorpism between Prosidy's 'Series' wrapper and 'Seq'.+_Series :: Iso (Series a) (Series b) (Seq a) (Seq b)+_Series = iso toSeq fromSeq+{-# INLINE _Series #-}++-- | A prism from a non-empty 'Seq' into a 'SeriesNE'.+_SeriesNE :: Prism' (Seq a) (SeriesNE a)+_SeriesNE = prism' toSeqNE fromSeqNE+{-# INLINE _SeriesNE #-}++-- | An isomorphism between Prosidy's 'Set' wrapper and 'HashSet'.+_Set :: Iso (Set a) (Set b) (HashSet a) (HashSet b)+_Set = iso toHashSet fromHashSet+{-# INLINE _Set #-}
+ src/Prosidy/Parse.hs view
@@ -0,0 +1,451 @@+{- |+Module : Prosidy.Parse+Description : Parse raw text into Prosidy documents+Copyright : (c) James Alexander Feldman-Crough, 2019+License : MPL-2.0+Maintainer : alex@fldcr.com+-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE OverloadedStrings #-}++module Prosidy.Parse+ ( -- * Parsing Prosidy types from 'Data.Text.Text'+ parseDocument+ , parseDocumentMetadata+ -- * Reading & parsing Prosidy files+ , readDocument+ , readDocumentMetadata+ -- * Errors+ , Failure(..)+ , prettyFailure+ )+where++import Prosidy.Compat+import Prelude hiding ( fail )++import Prosidy.Types+import Prosidy.Source+import Prosidy.Types.Key ( isValidKeyHead+ , isValidKeyTail+ , unsafeMakeKey+ )+import Prosidy.Types.Series ( fromSeqNE+ , toSeqNE+ , fromSeq+ )++import Text.Megaparsec hiding ( token+ , sourceName+ )+import Text.Megaparsec.Char ( char+ , string+ )++import qualified Data.Char as Char+import qualified Data.Text.Lazy as Text.Lazy+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Sequence as Seq+import qualified Data.List as List+import qualified Data.HashSet as HashSet+import qualified Data.Text.Encoding as Text.Encoding+import qualified Text.Megaparsec.Char as Megaparsec+import qualified Data.ByteString as ByteString++import Control.Applicative ( Alternative )+import Data.Bifunctor ( first )+import Text.Megaparsec.Char.Lexer ( hexadecimal )+import Data.Functor ( ($>) )+import Data.Foldable ( fold+ , traverse_+ )+import Control.Monad ( MonadPlus+ , void+ )+import Data.Text ( Text )+import Data.Void ( Void )+import Control.Exception ( Exception+ , throwIO+ )+import Control.Monad.Trans.Reader ( ReaderT(..) )++{-+ If you run into errors, use the following combinator to get Megaparsec to + print out its state.++ > import qualified Text.Megaparsec.Debug+ > + > dbg :: Show a => String -> P a -> P a+ > dbg txt (P (ReaderT r)) = P . ReaderT $ \src ->+ > Text.Megaparsec.Debug.dbg txt $ r src+-}++-------------------------------------------------------------------------------+-- | Parses a Prosidy 'Document' from its source.+--+-- The 'FilePath' parameter is only used for error reporting.+parseDocument :: FilePath -> Text -> Either Failure Document+parseDocument path = runP doc . makeSource path++-- | Reads a Prosidy 'Document' from the given 'FilePath'.+--+-- Errors will be thrown as exceptions. Use 'parseDocument' for a pure+-- implementation.+readDocument :: FilePath -> IO Document+readDocument filepath = do+ bytes <- ByteString.readFile filepath+ either throwIO pure . parseDocument filepath $ Text.Encoding.decodeUtf8With+ (\_ _ -> Just '\65533')+ bytes++-------------------------------------------------------------------------------+-- | Parses a Prosidy document's header 'Metadata' from source, stopping when the+-- header ends.+--+-- The 'FilePath' parameter is only used for error reporting.+parseDocumentMetadata :: FilePath -> Text -> Either Failure Metadata+parseDocumentMetadata path = runP docMetadata . makeSource path++-- | Reads a Prosidy document's 'Metadata' header from the given 'FilePath'.+--+-- Errors will be thrown as exceptions. Use 'parseDocumentMetadata' for a pure+-- implementation.+readDocumentMetadata :: FilePath -> IO Metadata+readDocumentMetadata filepath = do+ bytes <- ByteString.readFile filepath+ either throwIO pure+ . parseDocumentMetadata filepath+ $ Text.Encoding.decodeUtf8 bytes++-------------------------------------------------------------------------------+-- | A parsing error.+--+newtype Failure = Failure (ParseErrorBundle Text Void)+ deriving newtype (Exception, Show)++-- | Pretty-print a 'Failure' into a message acceptable for displaying to+-- users.+prettyFailure :: Failure -> String+prettyFailure (Failure e) = errorBundlePretty e++-------------------------------------------------------------------------------+newtype P a = P (ReaderT Source (Parsec Void Text) a)+ deriving newtype (Functor, Applicative, Alternative, Monad, MonadFail, MonadPlus, MonadParsec Void Text)++type MetadataItem = (Key, Maybe Text)++runP :: P a -> Source -> Either Failure a+runP (P (ReaderT r)) src =+ first Failure $ parse (r src) (sourceName src) (sourceText src)++-------------------------------------------------------------------------------+doc :: P Document+doc = do+ header <- docMetadata+ body <- Series . Seq.fromList <$> many block+ eof+ pure $ Document header body++-------------------------------------------------------------------------------+docMetadata :: P Metadata+docMetadata = do+ -- try to read a shebang as the _very_ first line of a document.+ optional_ $ string "#!" *> skipManyTill anySingle (void newlineOrEOF)+ -- skip past any blank lines at the start of the document+ skipSpaces *> skipMany endOfLine+ -- read each metadata item as a line-wide token+ items <- many docMetadataItem+ -- stop when we hit three dashes, alone, on a line+ docMetadataEnd+ pure $ foldMap itemToMetadata items++docMetadataEnd :: P ()+docMetadataEnd = do+ void $ string "---"+ try $ do+ skipSpaces+ newlineOrEOF+ skipSpaces+ skipMany endOfLine++docMetadataItem :: P MetadataItem+docMetadataItem = do+ itemKey <- key+ itemVal <- optional $ do+ metaItemSep+ option "" text <* skipSpaces+ endOfLines+ pure (itemKey, itemVal)++-------------------------------------------------------------------------------+block :: P Block+block = choice+ [ BlockTag <$> blockTag+ , BlockLiteral <$> literalTag+ , BlockParagraph <$> paragraph+ ]++blockTag :: P BlockTag+blockTag = do+ t <- genericTag (void $ string "#-") blockTagContents+ emptyLines+ pure t++blockTagContents :: P (Series Block)+blockTagContents = choice [ifBraces, ifBlock, ifNothing]+ where+ ifBraces = annotateSource $ fmap+ (foldMap $ \x src ->+ Series . Seq.singleton . BlockParagraph $ Paragraph x src+ )+ (token tagParagraph)+ ifBlock = Series . Seq.fromList <$> withBlockDelimiters+ (emptyLines *> many block)+ ifNothing = skipSpaces *> endOfLine $> mempty++literalTag :: P LiteralTag+literalTag = genericTag (void $ string "#=") $ do+ close <- blockTagDelim (void $ optional_ comment *> newlineOrEOF)+ literalBody close++literalBody :: P () -> P Text+literalBody end = do+ literalLines <- manyTill literalLine (try $ skipSpaces *> end)+ emptyLines+ pure $ Text.Lazy.toStrict . Text.Lazy.intercalate "\n" $ literalLines++literalLine :: P Text.Lazy.Text+literalLine = do+ line <- takeWhileP (Just "literal text") $ \ch -> ch /= '\r' && ch /= '\n'+ newlineOrEOF+ pure $ Text.Lazy.fromStrict line++blockTagDelim :: P () -> P (P ())+blockTagDelim slurp = do+ char ':'+ maybeLabel <- optional keyLike+ skipSpaces <* slurp+ pure $ do+ string "#:"+ traverse_ string maybeLabel+ skipSpaces++withBlockDelimiters :: P a -> P a+withBlockDelimiters parser = do+ close <- blockTagDelim endOfLine+ parser <* close++-------------------------------------------------------------------------------+inline :: P Inline+inline = choice [InlineTag <$> inlineTag, InlineText <$> fragment]++inlineTag :: P InlineTag+inlineTag = genericTag sigil . option mempty $ orEmpty tagParagraph+ where+ orEmpty = fmap $ maybe mempty (fromSeq . toSeqNE)+ sigil = try $ do+ void $ char '#'+ void . lookAhead $ satisfy isValidKeyHead++-------------------------------------------------------------------------------+paragraph :: P Paragraph+paragraph = annotateSource $ paragraphLike >>= maybe+ (fail "empty paragraph encountered")+ (pure . Paragraph)++paragraphLike :: P (Maybe (SeriesNE Inline))+paragraphLike = do+ ppLines <- paragraphLine `sepEndBy1` endOfLine+ emptyLines+ pure . fromSeqNE . Seq.fromList $ List.intercalate [Break] ppLines++paragraphLine :: P [Inline]+paragraphLine = do+ headItem <- inline+ tailItem <- many paragraphInline+ skipSpaces+ pure $ headItem : tailItem++paragraphInline :: P Inline+paragraphInline = (paragraphSpacer $> Break) <|> inline++paragraphSpacer :: P ()+paragraphSpacer = try $ do+ skipSpaces1+ notFollowedBy $ void (string "##") <|> newlineOrEOF++tagParagraph :: P (Maybe (SeriesNE Inline))+tagParagraph = between start end $ option Nothing paragraphLike+ where+ start = char '{' *> skipSpaces *> emptyLines+ end = skipSpaces *> emptyLines *> char '}'++-------------------------------------------------------------------------------+genericTag :: P () -> P a -> P (Tag a)+genericTag sigilParser bodyParser = annotateSource $ do+ sigilParser+ thisName <- unsafeMakeKey <$> keyLike+ thisMetadata <- meta+ thisContent <- bodyParser+ pure $ Tag thisName thisMetadata thisContent++meta :: P Metadata+meta =+ option mempty+ $ between start end+ $ foldMap itemToMetadata+ <$> metaItem+ `sepEndBy` metaSep+ where+ start = do+ char '['+ skipSpaces+ skipMany endOfLine+ end = char ']'++metaItem :: P MetadataItem+metaItem = do+ itemKey <- key <* emptyLines+ itemVal <- optional $ do+ metaItemSep <* emptyLines+ option "" quotedText+ skipSpaces <* emptyLines+ pure (itemKey, itemVal)++metaSep :: P ()+metaSep = do+ void $ char ','+ skipSpaces+ emptyLines++-------------------------------------------------------------------------------+escape :: P Char+escape = label "escape sequence" $ do+ void $ char '\\'+ choice+ [ oneOf @[] "#{}[]:='\"\\"+ , char 'n' $> '\n'+ , char 't' $> '\t'+ , char 'r' $> '\r'+ , char 'u' *> unicodeEscape+ ]++unicodeEscape :: P Char+unicodeEscape = Char.chr <$> hexadecimal++keyLike :: P Text+keyLike = do+ void . lookAhead $ satisfy isValidKeyHead+ takeWhile1P (Just "key") isValidKeyTail++key :: P Key+key = token $ unsafeMakeKey <$> keyLike++metaItemSep :: P ()+metaItemSep = token . void $ char ':' <|> char '='++quotedText :: P Text+quotedText = do+ delim <- char '\'' <|> char '"'+ parts <- many $ choice+ [ Text.Lazy.singleton <$> escape+ , Text.Lazy.fromStrict <$> takeWhile1P+ (Just "quoted text")+ (\ch -> ch /= delim && ch /= '\\')+ ]+ void $ char delim+ skipSpaces+ pure . Text.Lazy.toStrict . fold $ parts++fragment :: P Text+fragment = text++text :: P Text+text = do+ parts <- word `sepBy1` textSpace+ pure . Text.Lazy.toStrict . Text.Lazy.intercalate " " $ parts++textSpace :: P ()+textSpace = try $ do+ skipSpaces1+ notFollowedBy $ void (char '#') <|> newlineOrEOF++word :: P Text.Lazy.Text+word = fmap fold . some $ choice+ [ Text.Lazy.singleton <$> escape+ , Text.Lazy.fromStrict <$> takeWhile1P+ (Just "plain text")+ (\ch -> not $ HashSet.member ch reserved || Char.isSpace ch)+ ]+ where reserved = HashSet.fromList "#{}\\"++-------------------------------------------------------------------------------+comment :: P ()+comment = label "comment" $ do+ void $ string "##"+ void $ skipManyTill anySingle (lookAhead newlineOrEOF)++endOfLine :: P ()+endOfLine =+ -- This rule is a bit hairy! Specifically, there was a bug at the end of + -- a file that ended with a comment and no trailing newline.+ --+ -- Because we use `endOfLine` in repeat productions (many, some),+ -- endOfLine _has_ to consume input to prevent looping forever.+ -- In order to satisfy this:+ -- + -- 1. If its the end of a file, then we _must_ consume a comment.+ -- 2. If it's not the end of a file, then we _must_ consume at least + -- one newline.+ commentThenNewline <|> commentThenEOF+ where+ commentThenEOF = comment <* eof+ commentThenNewline = try $ do+ optional_ comment+ void Megaparsec.newline+ skipSpaces++endOfLines :: P ()+endOfLines = skipSome endOfLine++emptyLines :: P ()+emptyLines = skipMany endOfLine++spaceChar :: P ()+spaceChar = do+ notFollowedBy newlineOrEOF+ void Megaparsec.spaceChar++skipSpaces :: P ()+skipSpaces = skipMany spaceChar++skipSpaces1 :: P ()+skipSpaces1 = skipSome spaceChar++token :: P a -> P a+token = (<* skipSpaces)++newlineOrEOF :: P ()+newlineOrEOF = void Megaparsec.newline <|> eof++-------------------------------------------------------------------------------+optional_ :: P a -> P ()+optional_ = option () . void++-------------------------------------------------------------------------------+itemToMetadata :: MetadataItem -> Metadata+itemToMetadata (k, Just v ) = Metadata mempty (Assoc $ HashMap.singleton k v)+itemToMetadata (k, Nothing) = Metadata (Set $ HashSet.singleton k) mempty++annotateSource :: P (Maybe Location -> a) -> P a+annotateSource (P (ReaderT r)) = P . ReaderT $ \src -> do+ offset <- Offset . fromIntegral <$> getOffset+ result <- r src+ sourceLoc <- maybe (fail sourceLocationError) pure $ getLocation offset src+ pure . result $ Just sourceLoc++sourceLocationError :: String+sourceLocationError = "UNEXPECTED: Failed to create a source location."
+ src/Prosidy/Source.hs view
@@ -0,0 +1,268 @@+{-|+Module : Prosidy.Source+Description : Utilities for tracking source locaitons.+Copyright : ©2020 James Alexander Feldman-Crough+License : MPL-2.0+Maintainer : alex@fldcr.com+-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+module Prosidy.Source+ ( Source(..)+ , Location+ , SparseLocation(..)+ , LineMap+ , Offset(..)+ , Line(..)+ , Column(..)+ , locationSource+ , locationColumn+ , locationLine+ , locationOffset+ , makeSource+ , getSourceLine+ , getLocation+ , enrichLocation+ , stripLocation+ , lineOffsets+ , lineToOffset+ , offsetToLine+ )+where++import Data.Hashable ( Hashable(..) )+import Data.Vector.Unboxed ( Vector+ , MVector+ , Unbox+ )+import Data.Text ( Text )+import GHC.Generics ( Generic )+import Control.DeepSeq ( NFData )+import Data.Binary ( Binary(..) )+import Data.Aeson ( ToJSON(..)+ , FromJSON(..)+ )+import Control.Monad ( guard )++import qualified Data.Text as T+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Generic.Mutable as VGM++-- | Information about Prosidy source file.+--+-- The 'Show' instance for ths class does not include the 'LineMap' or 'Text'+-- fields, as those are rather noisy.+data Source = Source+ { sourceName :: String+ -- ^ The reported file-name of the 'Source'.+ --+ -- When read from file handles, a non-filepath description such as+ -- @"\<stdin\>"@ is typically chosen.+ -- This field doesn't have semantic meaning, and should only be used to+ -- enrich the output displayed to users.+ , sourceText :: Text+ -- ^ The full source, as 'Text'.+ , sourceLineMap :: LineMap+ -- ^ A mapping of the start position of each line in the 'Source'.+ }+ deriving stock (Eq, Generic)+ deriving anyclass (Hashable, NFData, Binary)++instance Show Source where+ show (Source fp _ _) = "Source " <> show fp++-- | Create a 'Source' from a descriptive name and a body. The source name is+-- typically a 'FilePath', but this is not guarenteed. For instance, when read +-- from standard-input, Prosidy chooses to name the source @\<stdin\>@.+makeSource :: String -> Text -> Source+makeSource name body = Source name body lineMap+ where+ lineMap = case T.foldl' lineMapFold (1, '\0', []) $ body of+ (_, _, acc) -> LineMap . V.fromList . reverse $ acc+ lineMapFold (ix, prev, acc) ch+ | ch == '\n' && prev == '\r' = (succ ix, ch, Offset ix : drop 1 acc)+ | ch == '\n' || ch == '\r' = (succ ix, ch, Offset ix : acc)+ | otherwise = (succ ix, ch, acc)++-- | Convert an 'Offset' into a 'Location'.+getLocation :: Offset -> Source -> Maybe Location+getLocation offset src = do+ guard $ T.length (sourceText src) > fromEnum offset+ Just . enrichLocation $ SparseLocation src offset++-- | Fetch a single line from a source.+getSourceLine :: Line -> Source -> Maybe Text+getSourceLine line source = do+ start <- fromEnum <$> lineToOffset line lineMap+ let end = fromEnum <$> lineToOffset (succ line) lineMap+ Just . maybe id (T.take . (flip (-) start)) end . T.drop start $ sourceText+ source+ where lineMap = sourceLineMap source++-- | A location in a 'Source'. The line and column numbers of this type are not+-- attached to this type; convert to a 'Location' to access those values.+data SparseLocation = SparseLocation+ { sparseLocationSource :: Source+ -- ^ The 'Source' this location references.+ , sparseLocationOffset :: Offset+ -- ^ The position in the 'Source', counted by Unicode codepoints.+ }+ deriving stock (Show, Generic, Eq)+ deriving anyclass (NFData, Binary, Hashable)++-- | A location in a 'Source', with the line and column number computed lazily.+data Location = Location+ { locationSource :: Source+ -- ^ The 'Source' this location references.+ , locationOffset :: Offset+ -- ^ The position in the 'Source', counted by Unicode codepoints.+ , locationLine :: ~Line+ -- ^ The line number in the 'Source'.+ , locationColumn :: ~Column+ -- ^ The column number in the 'Source'.+ }+ deriving stock (Show, Generic, Eq)+ deriving anyclass (NFData, Binary, Hashable)++-- | Add lazily computed line and column number information to a +-- 'SparseLocation'.+enrichLocation :: SparseLocation -> Location+enrichLocation sl = Location { locationSource = source+ , locationOffset = offset+ , locationLine = line+ , locationColumn = column+ }+ where+ source = sparseLocationSource sl+ lineMap = sourceLineMap source+ offset@(~(Offset offsetN)) = sparseLocationOffset sl+ line = offsetToLine offset lineMap+ column = case lineToOffset line lineMap of+ Just (Offset n) -> Column (offsetN - n)+ Nothing -> Column 0++-- | Remove line and column number information from a 'Location'.+stripLocation :: Location -> SparseLocation+stripLocation l = SparseLocation { sparseLocationSource = locationSource l+ , sparseLocationOffset = locationOffset l+ }++-- | A dense vector containing offsets poiting to the start of each line. That+-- is, the starting position of the third line of a file can be found at+-- position 2.+newtype LineMap = LineMap (Vector Offset)+ deriving stock (Eq, Generic)+ deriving newtype (Show, NFData)++instance Binary LineMap where+ get = fmap (LineMap . V.fromList) get+ put (LineMap v) = put (V.toList v)++instance Hashable LineMap where+ hashWithSalt salt (LineMap v) = V.foldl' hashWithSalt salt v++-- | Convert a 'LineMap' into a list of 'Offset's, corresponding to the first+-- character of a line. Note that the initial offset is omitted-- the offset at+-- index 0 will be the offset of the /second/ line.+lineOffsets :: LineMap -> [Offset]+lineOffsets (LineMap v) = V.toList v++-- | Fetch the 'Offset' for the given 'Line'. Evaluates to 'Nothing' if the+-- given 'Line' does not appear in the LineMap+lineToOffset :: Line -> LineMap -> Maybe Offset+lineToOffset (Line 0 ) _ = Just $ Offset 0+lineToOffset (Line nth) (LineMap xs) = xs V.!? fromIntegral (pred nth)++-- | Fetch the 'Line' number for a given 'Offset'. Newlines will be attributed+-- the line that they terminate, rather than the line started immediately +-- afterwards.+offsetToLine :: Offset -> LineMap -> Line+offsetToLine offset (LineMap xs) = Line . fromIntegral $ go Nothing+ 0+ (V.length xs)+ where+ go result min max+ | min >= max+ = maybe 0 succ result+ | otherwise+ = let nthIndex = ((max - min) `div` 2) + min+ nthOffset = xs V.! nthIndex+ in case nthOffset `compare` offset of+ EQ -> succ nthIndex+ LT -> go (Just nthIndex) (nthIndex + 1) max+ GT -> go result min nthIndex++-- | A line number.+--+-- The 'Show' instance for 'Line' counts from one, while the internal+-- implementation counts from zero.+newtype Line = Line Word+ deriving stock (Eq, Ord, Generic, Show)+ deriving newtype (ToJSON, FromJSON, Enum)+ deriving anyclass (Hashable, NFData, Binary)++-- | A column number.+newtype Column = Column Word+ deriving stock (Eq, Ord, Generic, Show)+ deriving newtype (ToJSON, FromJSON, Enum)+ deriving anyclass (Hashable, NFData, Binary)++-- | An offset into a 'Source', counted by UTF-8 codepoint.+newtype Offset = Offset Word+ deriving stock (Eq, Show, Ord, Generic)+ deriving newtype (ToJSON, FromJSON, Enum)+ deriving anyclass (Hashable, NFData, Binary)++newtype instance MVector s Offset = MV_Offset (MVector s Word)++instance VGM.MVector MVector Offset where+ basicLength (MV_Offset m) = VGM.basicLength m+ {-# INLINE basicLength #-}++ basicUnsafeSlice ix len (MV_Offset m) =+ MV_Offset $ VGM.basicUnsafeSlice ix len m+ {-# INLINE basicUnsafeSlice #-}++ basicOverlaps (MV_Offset x) (MV_Offset y) = VGM.basicOverlaps x y+ {-# INLINE basicOverlaps #-}++ basicUnsafeNew len = MV_Offset <$> VGM.basicUnsafeNew len+ {-# INLINE basicUnsafeNew #-}++ basicInitialize (MV_Offset v) = VGM.basicInitialize v+ {-# INLINE basicInitialize #-}++ basicUnsafeRead (MV_Offset v) = fmap Offset <$> VGM.basicUnsafeRead v+ {-# INLINE basicUnsafeRead #-}++ basicUnsafeWrite (MV_Offset v) ix (Offset w) = VGM.basicUnsafeWrite v ix w+ {-# INLINE basicUnsafeWrite #-}++newtype instance Vector Offset = V_Offset (Vector Word)++instance VG.Vector Vector Offset where+ basicUnsafeFreeze (MV_Offset v) = V_Offset <$> VG.basicUnsafeFreeze v+ {-# INLINE basicUnsafeFreeze #-}++ basicUnsafeThaw (V_Offset v) = MV_Offset <$> VG.basicUnsafeThaw v+ {-# INLINE basicUnsafeThaw #-}++ basicLength (V_Offset v) = VG.basicLength v+ {-# INLINE basicLength #-}++ basicUnsafeSlice ix len (V_Offset v) =+ V_Offset $ VG.basicUnsafeSlice ix len v+ {-# INLINE basicUnsafeSlice #-}++ basicUnsafeIndexM (V_Offset v) ix = Offset <$> VG.basicUnsafeIndexM v ix+ {-# INLINE basicUnsafeIndexM #-}++instance Unbox Offset where
+ src/Prosidy/Types.hs view
@@ -0,0 +1,311 @@+{-|+Module : Prosidy.Types+Description : A convenience module which reëxports type definitions & helpers. +Copyright : ©2020 James Alexander Feldman-Crough+License : MPL-2.0+Maintainer : alex@fldcr.com+-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+module Prosidy.Types+ ( -- * Documents+ Document(..)+ , documentToRegion+ , regionToDocument+ -- * Tags+ , Tag(..)+ , BlockTag+ , InlineTag+ , LiteralTag+ , tagToRegion+ , regionToTag+ -- * Contextual enumerations+ , Block(..)+ , Inline(..)+ -- * Paragraphs+ , Paragraph(..)+ -- * Common structures+ , Metadata(..)+ , Region(..)+ -- * Utility wrappers+ , module X+ )+where++import Prosidy.Types.Assoc as X+ ( Assoc(..) )+import Prosidy.Types.Key as X+ ( Key+ , KeyError(..)+ , InvalidCharacter+ , makeKey+ , rawKey+ )+import Prosidy.Types.Series as X+ ( Series(..)+ , SeriesNE+ )+import Prosidy.Types.Set as X+ ( Set(..) )+import Prosidy.Source ( Location )++import Data.Text ( Text )+import GHC.Generics ( Generic )+import Control.DeepSeq ( NFData )+import Data.Binary ( Binary )+import Data.Hashable ( Hashable )+import Data.Aeson ( ToJSON(..)+ , FromJSON(..)+ , withObject+ , (.:)+ , (.=)+ , object+ , pairs+ )++import qualified Data.Aeson as Aeson++-------------------------------------------------------------------------------+-- | A sum type enumerating allowed types inside of a block context.+data Block =+ BlockLiteral LiteralTag+ | BlockParagraph Paragraph+ | BlockTag BlockTag+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable, Binary, NFData)++instance FromJSON Block where+ parseJSON = withObject "block" $ \o -> do+ ty <- o .: "type"+ case ty :: Text of+ "tag" -> do+ subtype <- o .: "subtype"+ case subtype :: Text of+ "block" -> BlockTag <$> o .: "value"+ "literal" -> BlockLiteral <$> o .: "value"+ _ -> fail $ "unknown tag subtype: " <> show subtype+ "paragraph" -> BlockParagraph <$> o .: "value"+ _ -> fail $ "unknown block type: " <> show ty++instance ToJSON Block where+ toEncoding b = pairs . mconcat $ case b of+ BlockLiteral t ->+ [ "type" .= ("tag" :: Text)+ , "subtype" .= ("literal" :: Text)+ , "value" .= t+ ]+ BlockParagraph p -> ["type" .= ("paragraph" :: Text), "value" .= p]+ BlockTag t ->+ [ "type" .= ("tag" :: Text)+ , "subtype" .= ("block" :: Text)+ , "value" .= t+ ]++ toJSON b = object $ case b of+ BlockLiteral t ->+ [ "type" .= ("tag" :: Text)+ , "subtype" .= ("literal" :: Text)+ , "value" .= t+ ]+ BlockParagraph p -> ["type" .= ("paragraph" :: Text), "value" .= p]+ BlockTag t ->+ [ "type" .= ("tag" :: Text)+ , "subtype" .= ("block" :: Text)+ , "value" .= t+ ]++-------------------------------------------------------------------------------+-- | A full Prosidy document.+data Document = Document+ { documentMetadata :: Metadata+ , documentContent :: Series Block+ }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable, NFData, Binary)++instance FromJSON Document where+ parseJSON = withObject "Document"+ $ \o -> Document <$> o .: "metadata" <*> o .: "content"++instance ToJSON Document where+ toEncoding (Document md ct) =+ pairs $ mconcat ["metadata" .= md, "content" .= ct]++ toJSON (Document md ct) = object ["metadata" .= md, "content" .= ct]++-- | Convert a 'Document' to a 'Region'. The resulting 'Region' will never have+-- a 'Location' attached. +documentToRegion :: Document -> Region (Series Block)+documentToRegion (Document md ct) = Region md ct Nothing++-- | Convert a 'Region' to a 'Document'. Any 'Location' on the 'Region' will be+-- discarded.+regionToDocument :: Region (Series Block) -> Document+regionToDocument (Region md ct _) = Document md ct++-------------------------------------------------------------------------------+-- | A sum type enumerating allowed types inside of an inline context.+data Inline =+ Break+ -- ^ Spacing recorded between lines or on either side of an 'Inline' 'Tag'.+ -- Although we could represent this as 'Text', Prosidy defines a special+ -- node for this case so that authors in CJK languages (or other languages+ -- without explicit spaces between words) may simply ignore these spaces+ -- in their output.+ | InlineTag InlineTag+ -- ^ A 'Tag' which contains only 'Inline' items. These tags begin with the+ -- @#@ sigil in source.+ | InlineText Text+ -- ^ A fragment of plain text.+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable, Binary, NFData)++instance FromJSON Inline where+ parseJSON = withObject "Inline" $ \o -> do+ ty <- o .: "type"+ case ty :: Text of+ "break" -> pure Break+ "tag" -> InlineTag <$> o .: "value"+ "text" -> InlineText <$> o .: "value"+ _ -> fail $ "unknown inline type: " <> show ty++instance ToJSON Inline where+ toEncoding i = pairs . mconcat $ case i of+ Break -> ["type" .= ("break" :: Text), "value" .= Aeson.Null]+ InlineTag t ->+ [ "type" .= ("tag" :: Text)+ , "subtype" .= ("inline" :: Text)+ , "value" .= t+ ]+ InlineText t -> ["type" .= ("text" :: Text), "value" .= t]++ toJSON i = object $ case i of+ Break -> ["type" .= ("break" :: Text)]+ InlineTag t ->+ [ "type" .= ("tag" :: Text)+ , "subtype" .= ("inline" :: Text)+ , "value" .= t+ ]+ InlineText t -> ["type" .= ("text" :: Text), "value" .= t]++-------------------------------------------------------------------------------+-- | A set of properties and settings, associated with a 'Region'. +--+-- The namespaces of properties and settings are distinct; a property can share+-- a name with a setting without conflict.+data Metadata = Metadata+ { metadataProperties :: Set Key+ -- ^ Properties are a set of 'Key's with no associated value.+ , metadataSettings :: Assoc Key Text+ -- ^ Settings are 'Key's with an attached value.+ }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (NFData, Binary, Hashable)++instance Monoid Metadata where+ mempty = Metadata mempty mempty++instance Semigroup Metadata where+ Metadata p1 s1 <> Metadata p2 s2 = Metadata (p1 <> p2) (s1 <> s2)++instance FromJSON Metadata where+ parseJSON = withObject "Metadata"+ $ \o -> Metadata <$> o .: "properties" <*> o .: "settings"++instance ToJSON Metadata where+ toEncoding (Metadata ps ss) =+ pairs $ mconcat ["properties" .= ps, "settings" .= ss]++ toJSON (Metadata ps ss) = object ["properties" .= ps, "settings" .= ss]++-------------------------------------------------------------------------------+-- | A non-empty collection of 'Inline' items. A 'Paragraph' represents the+-- border between block and inline contexts. All ancestors of a paragraph are+-- block items or a document, and all children are inline items.+data Paragraph = Paragraph+ { paragraphContent :: SeriesNE Inline+ , paragraphLocation :: Maybe Location+ }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable, NFData, Binary)++instance FromJSON Paragraph where+ parseJSON = fmap (flip Paragraph Nothing) . parseJSON++instance ToJSON Paragraph where+ toEncoding (Paragraph s _) = toEncoding s+ toJSON (Paragraph s _) = toJSON s++-------------------------------------------------------------------------------+-- | An untagged structural grouping of items with type @a@. Regions do not+-- occur in parsing.+data Region a = Region+ { regionMetadata :: Metadata+ , regionContent :: a+ , regionLocation :: Maybe Location+ }+ deriving stock (Eq, Foldable, Functor, Show, Traversable, Generic)+ deriving anyclass (Hashable, NFData, Binary)++instance ToJSON a => ToJSON (Region a) where+ toJSON (Region md ct _) = Aeson.object ["metadata" .= md, "content" .= ct]++-------------------------------------------------------------------------------+-- | A 'Region', annotated with a tag name.+data Tag a = Tag+ { tagName :: Key+ , tagMetadata :: Metadata+ , tagContent :: a+ , tagLocation :: Maybe Location+ }+ deriving stock (Eq, Foldable, Functor, Show, Traversable, Generic)+ deriving anyclass (Hashable, NFData, Binary)++instance FromJSON a => FromJSON (Tag a) where+ parseJSON = withObject "Tag" $ \o ->+ Tag+ <$> o+ .: "name"+ <*> o+ .: "metadata"+ <*> o+ .: "content"+ <*> pure Nothing++instance ToJSON a => ToJSON (Tag a) where+ toEncoding (Tag nm md ct _) =+ pairs $ mconcat ["name" .= nm, "metadata" .= md, "content" .= ct]++ toJSON (Tag nm md ct _) =+ object ["name" .= nm, "metadata" .= md, "content" .= ct]++-- | A 'Tag' containing zero or more 'Block' items. +-- Specified in Prosidy source with the @#-@ sigil.+type BlockTag = Tag (Series Block)++-- | A 'Tag' containing zero or more 'Inline' items.+-- Specified in Prosidy source with the @#@ sigil.+type InlineTag = Tag (Series Inline)++-- | A 'Tag' containing a single plain-text item.+-- Specified in Prosidy source with the @#=@ sigil.+type LiteralTag = Tag Text++-- | Convert a 'Tag' to a 'Region' by discarding the tag's name.+tagToRegion :: Tag a -> Region a+tagToRegion (Tag _ md ct loc) = Region md ct loc++-- | Convert a 'Region' to a 'Tag' by providing a tag name.+regionToTag :: Key -> Region a -> Tag a+regionToTag name (Region md ct loc) = Tag name md ct loc
+ src/Prosidy/Types/Assoc.hs view
@@ -0,0 +1,54 @@+{-|+Module : Prosidy.Types.Assoc+Description : An associative mapping of keys to values.+Copyright : ©2020 James Alexander Feldman-Crough+License : MPL-2.0+Maintainer : alex@fldcr.com+-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Prosidy.Types.Assoc (Assoc(..), asHashMap, fromHashMap, toHashMap) where++import Data.HashMap.Strict ( HashMap )+import GHC.Generics ( Generic )+import Data.Aeson ( ToJSON(..)+ , FromJSON(..)+ )+import Control.DeepSeq ( NFData )+import Data.Binary ( Binary(..) )+import Data.Hashable ( Hashable(..) )++import qualified Data.HashMap.Strict as HM++-- | An associative mapping of keys to values.+--+-- Currently implemented as a 'HashMap', this newtype wrapper allows us to:+--+-- 1) Add non-orphan instances to the underlying structure.+-- 2) Change the underlying type if needed.+newtype Assoc k v = Assoc (HashMap k v)+ deriving stock (Generic)+ deriving newtype (Eq, Foldable, Functor, Show, ToJSON, FromJSON, NFData, Semigroup, Monoid, Hashable)++instance (Eq k, Hashable k, Binary k, Binary v) => Binary (Assoc k v) where+ get = Assoc . HM.fromList <$> get++ put (Assoc hm) = put $ HM.toList hm++-- | Given a function which operates on a 'HashMap', return a function which+-- performs an equivalent transfromation on an 'Assoc'.+asHashMap+ :: Functor f+ => (HashMap k v -> f (HashMap k' v'))+ -> Assoc k v+ -> f (Assoc k' v')+asHashMap f (Assoc a) = Assoc <$> f a++-- | Convert a 'HashMap' to an 'Assoc'.+fromHashMap :: HashMap k v -> Assoc k v+fromHashMap = Assoc++-- | Convert an 'Assoc' to a 'HashMap'.+toHashMap :: Assoc k v -> HashMap k v+toHashMap (Assoc hm) = hm
+ src/Prosidy/Types/Key.hs view
@@ -0,0 +1,155 @@+{-|+Module : Prosidy.Types.Key+Description : Definitions and helpers for 'Key'.+Copyright : ©2020 James Alexander Feldman-Crough+License : MPL-2.0+Maintainer : alex@fldcr.com+-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GADTSyntax #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE QuasiQuotes #-}+module Prosidy.Types.Key+ ( -- * The 'Key' type.+ Key+ -- * Creating 'Key's and unwrapping them+ , makeKey+ , rawKey+ , unsafeMakeKey+ -- * Checking validity of raw text. + , isValidKeyHead+ , isValidKeyTail+ -- * Errors+ , KeyError(..)+ , InvalidCharacter(..)+ )+where++import Data.Text ( Text )+import Data.Aeson ( ToJSON(..)+ , ToJSONKey(..)+ , FromJSON(..)+ , FromJSONKey(..)+ )+import GHC.Generics ( Generic )+import Control.DeepSeq ( NFData )+import Data.Binary ( Binary )+import Data.Hashable ( Hashable )+import Data.String ( IsString(..) )+import Data.Foldable ( for_ )+import Control.Monad ( unless )+import Control.Exception ( Exception(..)+ , throw+ )++import qualified Data.Aeson as Aeson+import qualified Data.Char as Char+import qualified Data.Set as Set+import qualified Data.Text as Text++-- | A 'Key' is an identifier used in tags, properties, and setting names.+newtype Key = Key Text+ deriving stock (Generic)+ deriving newtype (Binary, Eq, Hashable, NFData, Ord, Show, ToJSON, ToJSONKey)++-- | 'Key' exposes an 'IsString' instance, but beware! Invalid strings will+-- throw a pure exception. +instance IsString Key where+ fromString = either throw id . makeKey . Text.pack++instance FromJSON Key where+ parseJSON json = do+ text <- parseJSON json+ either (fail . displayException) pure $ makeKey text++instance FromJSONKey Key where+ fromJSONKey =+ Aeson.FromJSONKeyTextParser+ $ either (fail . displayException) pure+ . makeKey++-- | Create a new 'Key', checking its validity.+makeKey :: Text -> Either KeyError Key+makeKey rawText = case Text.unpack rawText of+ [] -> Left EmptyKeyError+ keyHead : keyTail+ | isValidKeyHead keyHead -> do+ for_ (zip [1 ..] keyTail) $ \(ix, ch) ->+ unless (isValidKeyTail ch)+ $ Left+ . InvalidCharacterError+ $ InvalidCharacter rawText ix ch+ Right $ Key rawText+ | otherwise -> Left . InvalidCharacterError $ InvalidCharacter+ rawText+ 0+ keyHead++-- | Create a new 'Key' /without/ performing any checks.+unsafeMakeKey :: Text -> Key+unsafeMakeKey = Key+{-# INLINE unsafeMakeKey #-}++-- | Convert a 'Key' into its 'Text' representation.+rawKey :: Key -> Text+rawKey (Key key) = key++-- | Check if a character is suitable for use as the first character in a +-- 'Key'.+isValidKeyHead :: Char -> Bool+isValidKeyHead = (||) <$> Char.isAlphaNum <*> (== '_')++-- | Check if a character is suitable for use as any character except the+-- first character in a 'Key'.+isValidKeyTail :: Char -> Bool+isValidKeyTail = not . invalid+ where+ invalid = (||) <$> Char.isSpace <*> (`Set.member` reserved)+ reserved = Set.fromList "\\#{}[]:=,"++-- | Errors returned when creating invalid keys.+data KeyError =+ InvalidCharacterError InvalidCharacter+ -- ^ A character provided as a 'Key'\'s name was invalid.+ | EmptyKeyError+ -- ^ A string of length 0 was provided as a 'Key'\'s name.+ deriving (Show, Eq)++-- | Details for errors thrown when creating 'Key's with one or more invalid+-- characters.+data InvalidCharacter = InvalidCharacter+ { -- | The full string provided as the 'Key's name.+ invalidCharacterText :: Text+ -- | The position of the invalid character.+ , invalidCharacterPosition :: Word+ -- | The exact character that was invalid.+ , invalidCharacterCharacter :: Char+ }+ deriving (Show, Eq)++instance Exception KeyError where+ displayException EmptyKeyError =+ "Cannot create a Key with a length of zero."+ displayException (InvalidCharacterError (InvalidCharacter text nth ch)) =+ unwords+ [ "Cannot create a Key named " <> show text <> ":"+ , "the character"+ , show ch+ , "at index"+ , show nth+ , "is not allowed."+ ]
+ src/Prosidy/Types/Series.hs view
@@ -0,0 +1,109 @@+{-|+Module : Prosidy.Types.Series+Description : A type of items occuring in a sequence.+Copyright : ©2020 James Alexander Feldman-Crough+License : MPL-2.0+Maintainer : alex@fldcr.com+-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Prosidy.Types.Series+ ( -- * Possibly empty collections+ Series(..)+ , asSeq+ , fromSeq+ , toSeq+ -- * Known non-empty collections+ , SeriesNE+ , fromSeqNE+ , toSeqNE+ )+where++import Data.Sequence ( Seq )+import GHC.Generics ( Generic )+import Data.Aeson ( ToJSON(..)+ , FromJSON(..)+ )+import Control.DeepSeq ( NFData )+import Data.Binary ( Binary(..) )+import Data.Hashable ( Hashable(..) )+import Data.Foldable ( toList+ , foldl'+ )+import Control.Monad ( guard )++import qualified Data.Sequence as Seq++-- | A newtype wrapper around a sequential collection.+--+-- Currently, 'Series' is implemented as a 'Seq', but this is not guarenteed to+-- be true.+newtype Series a = Series (Seq a)+ deriving stock (Generic, Show)+ deriving newtype (Eq, Foldable, Functor, Applicative, ToJSON, FromJSON, NFData, Semigroup, Monoid)++instance Binary a => Binary (Series a) where+ get = Series . Seq.fromList <$> get+ {-# INLINE get #-}++ put (Series xs) = put $ toList xs+ {-# INLINE put #-}++instance Hashable a => Hashable (Series a) where+ hashWithSalt salt (Series xs) = foldl' hashWithSalt salt xs++instance Traversable Series where+ traverse f (Series xs) = Series <$> traverse f xs++-- | A non-empty 'Series'. +newtype SeriesNE a = SeriesNE (Seq a)+ deriving stock (Generic, Show)+ deriving newtype (Eq, Foldable, Functor, Applicative, ToJSON, NFData, Semigroup, Monoid)++instance Binary a => Binary (SeriesNE a) where+ get =+ maybe (error "SeriesNE must be non-empty") id+ . fromSeqNE+ . Seq.fromList+ <$> get+ {-# INLINE get #-}++ put (SeriesNE xs) = put $ toList xs+ {-# INLINE put #-}++instance FromJSON a => FromJSON (SeriesNE a) where+ parseJSON value = do+ inner <- parseJSON value+ guard (not $ null inner)+ pure $ SeriesNE inner++instance Hashable a => Hashable (SeriesNE a) where+ hashWithSalt salt (SeriesNE xs) = foldl' hashWithSalt salt xs++instance Traversable SeriesNE where+ traverse f (SeriesNE xs) = SeriesNE <$> traverse f xs++-- | Given a function which operates on a 'Seq', return a function which+-- operates on a 'Series'.+asSeq :: Functor f => (Seq a -> f (Seq b)) -> Series a -> f (Series b)+asSeq f (Series s) = Series <$> f s++-- | Convert a 'Seq' into a 'Series'.+fromSeq :: Seq a -> Series a+fromSeq = Series++-- | Convert a 'Series' into a 'Seq'.+toSeq :: Series a -> Seq a+toSeq (Series s) = s++-- | Convert a non-empty 'Seq' into a 'SeriesNE'.+fromSeqNE :: Seq a -> Maybe (SeriesNE a)+fromSeqNE s | null s = Nothing+fromSeqNE s | otherwise = Just (SeriesNE s)++-- | Convert a 'SeriesNE' into a 'Seq'. The returned 'Seq' is guarenteed to+-- always contain at least one element.+toSeqNE :: SeriesNE a -> Seq a+toSeqNE (SeriesNE a) = a
+ src/Prosidy/Types/Set.hs view
@@ -0,0 +1,59 @@+{-|+Module : Prosidy.Types.Set+Description : An unordered collection of unique items.+Copyright : ©2020 James Alexander Feldman-Crough+License : MPL-2.0+Maintainer : alex@fldcr.com+-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+module Prosidy.Types.Set (Set(..), asHashSet, fromHashSet, toHashSet) where++import Data.HashSet ( HashSet )+import GHC.Generics ( Generic )+import Data.Aeson ( FromJSONKey+ , ToJSONKey+ , ToJSON(..)+ , FromJSON(..)+ )+import Control.DeepSeq ( NFData )+import Data.Binary ( Binary(..) )+import Data.Hashable ( Hashable(..) )+import qualified Data.HashSet as HS+import qualified Data.HashMap.Strict as HM++-- | A newtype wrapper around an unordered collection of unique elements.+--+-- Currently, this is implemented as a wrapper around a 'HashSet'.+newtype Set a = Set (HashSet a)+ deriving stock (Generic)+ deriving newtype (Eq, Foldable, Show, NFData, Semigroup, Monoid, Hashable)++instance (Hashable a, Eq a, ToJSONKey a) => ToJSON (Set a) where+ toJSON (Set hs) = toJSON $ foldMap (flip HM.singleton True) hs+ toEncoding (Set hs) = toEncoding $ foldMap (flip HM.singleton True) hs++instance (Hashable a, Eq a, FromJSONKey a) => FromJSON (Set a) where+ parseJSON json = do+ m <- parseJSON json+ pure . Set . HM.keysSet $ HM.filter id m++instance (Eq a, Hashable a, Binary a) => Binary (Set a) where+ get = Set . HS.fromList <$> get++ put (Set s) = put $ HS.toList s++-- | Given a function which operates on 'HashSet's, return a function which+-- performs the same operation on a 'Set'.+asHashSet :: Functor f => (HashSet a -> f (HashSet b)) -> Set a -> f (Set b)+asHashSet f (Set s) = Set <$> f s++-- | Convert a 'Set' to a 'HashSet'.+toHashSet :: Set a -> HashSet a+toHashSet (Set s) = s++-- | Convert a 'HashSet' to a 'Set'.+fromHashSet :: HashSet a -> Set a+fromHashSet = Set
+ test/Prosidy/Test.hs view
@@ -0,0 +1,21 @@+import Test.Tasty+import Test.Tasty.Runners.AntXML (antXMLRunner)+import qualified Prosidy.Test.Source+import qualified Prosidy.Test.Types+import qualified Prosidy.Test.Parse++main :: IO ()+main = tests >>= defaultMainWithIngredients ingredients+ where+ ingredients = defaultIngredients +++ [ antXMLRunner+ ]++tests :: IO TestTree+tests = do+ parseTests <- Prosidy.Test.Parse.tests+ pure $ testGroup "test"+ [ Prosidy.Test.Source.tests+ , Prosidy.Test.Types.tests+ , parseTests+ ]
+ test/Prosidy/Test/Parse.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Prosidy.Test.Parse (tests) where++import qualified Prosidy++import Test.Tasty+import Test.Tasty.Golden.Advanced (goldenTest)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BS.Lazy+import qualified System.Directory as Dir+import System.FilePath ((</>))+import Control.Exception (handle, displayException)++import qualified Paths_prosidy as Paths+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Diff as Aeson.Diff+import qualified Data.Aeson.Encode.Pretty as Aeson.Pretty++import qualified Data.Text.Lazy as Text.Lazy+import Data.Text.Lazy.Encoding (decodeUtf8With)++tests :: IO TestTree+tests = do+ goldenDir <- (</> "golden") <$> Paths.getDataDir+ goldenTests <- Dir.listDirectory goldenDir+ pure . testGroup "parse" $ makeTest goldenDir <$> goldenTests++makeTest :: FilePath -> String -> TestTree+makeTest goldenDir name =+ goldenTest name + (catchErrors getJSON) + (catchErrors parsePro)+ compareDocs+ writeGolden+ where+ getJSON :: IO Aeson.Value+ getJSON = do+ bytes <- BS.readFile $ goldenDir </> name </> "output.json"+ case Aeson.eitherDecode' . BS.Lazy.fromStrict $ bytes of+ Left e -> fail $ "Failed to parse JSON: " <> e+ Right ok -> pure ok++ parsePro :: IO Aeson.Value+ parsePro = Aeson.toJSON <$>+ Prosidy.readDocument (goldenDir </> name </> "input.pro") ++ compareDocs :: Aeson.Value -> Aeson.Value -> IO (Maybe String)+ compareDocs gold test | gold == test = pure Nothing+ compareDocs gold test = + let+ diff = Aeson.Diff.diff (Aeson.toJSON gold) (Aeson.toJSON test)+ pretty = Aeson.Pretty.encodePretty diff+ in+ pure . Just . Text.Lazy.unpack $ + "Golden test failed. The diff is included below:\n" <>+ decodeUtf8With (\_ _ -> Just '\65533') pretty++ writeGolden :: Aeson.Value -> IO ()+ writeGolden doc = BS.Lazy.writeFile (goldenDir </> name </> "output.json") $+ Aeson.Pretty.encodePretty doc++catchErrors :: IO a -> IO a+catchErrors = handle $ \(e :: Prosidy.Failure) -> fail $ displayException e
+ test/Prosidy/Test/Source.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE OverloadedStrings #-}+module Prosidy.Test.Source (tests) where++import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Data.Foldable (toList, for_)+import Data.IORef+import System.IO.Unsafe+import Control.Exception (evaluate)++import qualified Prosidy.Source as PS+import qualified Data.Text as T++tests :: TestTree+tests = testGroup "source"+ [ testEmptyLineMap+ , testSimpleLineMap+ , testLineDelimiters+ , testLocation+ , testLocationLazy+ , propLineOffset+ ]++testEmptyLineMap :: TestTree+testEmptyLineMap = testCase "empty" $ do+ let source = PS.makeSource "<test>" ""+ assertBool "An empty source generates an empty line map." $+ null (PS.lineOffsets $ PS.sourceLineMap source)++testSimpleLineMap :: TestTree+testSimpleLineMap = testCase "simple" $ do+ let sourceLines =+ [ "This source file contains a few lines."+ , "Some, line the next, are empty."+ , ""+ , "Multiple consecutive empty lines are fine as well." + , ""+ , ""+ , "終わり"+ ]+ source = PS.makeSource "<test>" $ T.unlines sourceLines+ toList (PS.lineOffsets $ PS.sourceLineMap source) @?= + fmap PS.Offset [39, 71, 72, 123, 124, 125, 129]+ for_ (zip [PS.Line 0 ..] sourceLines) $ \(lineNumber, line) ->+ PS.getSourceLine lineNumber source @?= Just (line <> "\n")++testLineDelimiters :: TestTree+testLineDelimiters = testCase "endings" $ do+ let source = PS.makeSource "<test>" "abc\ndef\rghi\r\njkl"+ lines = PS.sourceLineMap source+ PS.getSourceLine (PS.Line 0) source @?= Just "abc\n"+ PS.lineToOffset (PS.Line 0) lines @?= Just (PS.Offset 0)+ PS.getSourceLine (PS.Line 1) source @?= Just "def\r"+ PS.lineToOffset (PS.Line 1) lines @?= Just (PS.Offset 4)+ PS.getSourceLine (PS.Line 2) source @?= Just "ghi\r\n"+ PS.lineToOffset (PS.Line 2) lines @?= Just (PS.Offset 8)+ PS.getSourceLine (PS.Line 3) source @?= Just "jkl"+ PS.lineToOffset (PS.Line 3) lines @?= Just (PS.Offset 13)+ PS.getSourceLine (PS.Line 4) source @?= Nothing++testLocation :: TestTree+testLocation = testCase "location" $ do+ let source = PS.makeSource "<test>" "ab\ncd\nef"+ checkLocation offset line column = do+ let loc = PS.getLocation (PS.Offset offset) source+ fmap PS.locationOffset loc @?= Just (PS.Offset offset)+ fmap PS.locationLine loc @?= Just (PS.Line line)+ fmap PS.locationColumn loc @?= Just (PS.Column column)+ checkLocation 0 0 0+ checkLocation 1 0 1+ checkLocation 2 0 2+ checkLocation 3 1 0+ checkLocation 4 1 1+ checkLocation 5 1 2+ checkLocation 6 2 0+ checkLocation 7 2 1+ PS.getLocation (PS.Offset 8) source @?= Nothing++testLocationLazy :: TestTree+testLocationLazy = testCase "lazy" $ do+ let source = PS.makeSource "<test>" "abc\ndef"+ Just loc = PS.getLocation (PS.Offset 5) source+ (line, checkLine) <- checkEvaluated (PS.locationLine loc)+ (col, checkCol) <- checkEvaluated (PS.locationColumn loc)+ assertBool "line is unevaluated" . not =<< checkLine+ assertBool "col is unevaluated" . not =<< checkCol+ _ <- evaluate line+ assertBool "line is evaluated" =<< checkLine+ assertBool "col is unevaluated" . not =<< checkCol+ _ <- evaluate col+ assertBool "line is evaluated" =<< checkLine+ assertBool "col is evaluated" =<< checkCol++propLineOffset :: TestTree+propLineOffset = testProperty "line-and-offset" $ + forAll gen $ \(source, initialOffset) ->+ let lineMap = PS.sourceLineMap source+ line = PS.offsetToLine initialOffset lineMap+ Just offset = PS.lineToOffset line lineMap+ line' = PS.offsetToLine offset lineMap+ in (initialOffset >= offset) .&&. (line === line')+ where+ gen = do+ text <- T.pack <$> genChar+ initialOffset <- elements [PS.Offset 0 .. toEnum (if T.null text then 0 else T.length text - 1)]+ pure (PS.makeSource "<text>" text, initialOffset)+ genChar = listOf $ frequency+ [ (10, elements ['a' .. 'z'] )+ , (4, pure ' ')+ , (1, pure '\n')+ ]++{-# NOINLINE checkEvaluated #-}+checkEvaluated :: a -> IO (a, IO Bool)+checkEvaluated val = do+ ref <- newIORef False+ pure ( unsafePerformIO (writeIORef ref True) `seq` val+ , readIORef ref+ )
+ test/Prosidy/Test/Types.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}+module Prosidy.Test.Types (tests) where++import Test.Tasty+import Test.Tasty.QuickCheck++import qualified Prosidy.Types.Key as Key+import qualified Prosidy.Types.Series as Series+import qualified Data.Text as Text+import qualified Data.Sequence as Seq++tests :: TestTree+tests = testGroup "types"+ [ testKey+ , testSeriesNE+ ]++testKey :: TestTree+testKey = testGroup "key" + [ testProperty "valid" $ forAll validGen $ \raw ->+ fmap Key.rawKey (Key.makeKey raw) === Right raw+ , testProperty "invalid-head" $ forAll invalidHeadGen $ \raw ->+ case Key.makeKey raw of+ Right _ -> label "key creation should fail" False+ Left Key.EmptyKeyError -> label "key should be nonempty" $ property False+ Left (Key.InvalidCharacterError (Key.InvalidCharacter raw' nth ch)) ->+ conjoin+ [ label "error string matches input" $ raw === raw'+ , label "invalid at index 0" $ nth === 0+ , label "char is invalid" $ not (Key.isValidKeyHead ch)+ ]+ , testProperty "invalid-tail" $ forAll invalidTailGen $ \raw ->+ case Key.makeKey raw of+ Right _ -> label "key creation should fail" False+ Left Key.EmptyKeyError -> label "key should be nonempty" $ property False+ Left (Key.InvalidCharacterError (Key.InvalidCharacter raw' nth ch)) ->+ conjoin+ [ label "error string matches input" $ raw === raw'+ , label "invalid at index > 0" $ nth =/= 0+ , label "char is invalid" $ not (Key.isValidKeyTail ch)+ ]+ , testProperty "empty" $+ case Key.makeKey "" of+ Right _ -> label "key creation should fail" False+ Left Key.EmptyKeyError -> property ()+ Left (Key.InvalidCharacterError _) -> label "input should be empty" False+ ]+ where+ arbHead = arbitraryUnicodeChar `suchThat` Key.isValidKeyHead+ arbTail = listOf $ arbitraryUnicodeChar `suchThat` Key.isValidKeyTail++ validGen = do+ keyHead <- arbHead+ keyTail <- arbTail+ pure . Text.pack $ keyHead : keyTail++ invalidHeadGen = do+ keyHead <- arbitraryUnicodeChar `suchThat` (not . Key.isValidKeyHead)+ keyTail <- arbTail+ pure . Text.pack $ keyHead : keyTail++ invalidTailGen = do+ keyHead <- arbHead+ keyTail0 <- arbTail+ keyTail1 <- elements "\n\t\v\\#{}[]:=, "+ keyTail2 <- arbTail+ pure . Text.pack $ keyHead : keyTail0 ++ keyTail1 : keyTail2++testSeriesNE :: TestTree+testSeriesNE = testGroup "SeriesNE"+ [ testProperty "nonempty" $+ forAll genSeq1 $ \xs ->+ fmap Series.toSeqNE (Series.fromSeqNE xs) === Just xs+ , testProperty "empty" $+ Series.fromSeqNE (mempty :: Seq.Seq Word) === Nothing+ ]+ where+ genSeq1 = fmap Seq.fromList . listOf1 $ (arbitrary :: Gen Word)