@ -0,0 +1,74 @@ | |||
--- | |||
kind: pipeline | |||
type: docker | |||
name: default | |||
steps: | |||
- name: configure | |||
image: utdemir/ghc-musl:v4-integer-simple-ghc881 | |||
environment: | |||
CABAL_DIR: /cabal | |||
volumes: | |||
- name: cabal-cache | |||
path: /cabal | |||
commands: | |||
- cabal v2-update | |||
- cabal v2-configure --jobs \$ncpus --enable-tests --flags +fatal-warnings | |||
- &default-steps | |||
name: ghc 8.8.1 | |||
image: utdemir/ghc-musl:v4-integer-simple-ghc881 | |||
depends_on: [configure] | |||
environment: | |||
CABAL_DIR: /cabal | |||
volumes: | |||
- name: cabal-cache | |||
path: /cabal | |||
commands: | |||
- cabal v2-build | |||
- cabal v2-test | |||
- <<: *default-steps | |||
name: ghc 8.6.5 | |||
image: utdemir/ghc-musl:v4-integer-simple-ghc865 | |||
- name: docs | |||
image: utdemir/ghc-musl:v4-integer-simple-ghc881 | |||
depends_on: | |||
- ghc 8.8.1 | |||
environment: | |||
CABAL_DIR: /cabal | |||
volumes: | |||
- name: cabal-cache | |||
path: /cabal | |||
commands: | |||
- ./scripts/documentation-coverage | |||
- name: release | |||
image: registry.in.fldcr.com/cabal-publish:latest | |||
depends_on: | |||
- ghc 8.8.1 | |||
- ghc 8.6.5 | |||
- docs | |||
environment: | |||
CABAL_DIR: /cabal | |||
HACKAGE_USER: {"from_secret": "hackage-user"} | |||
HACKAGE_PASSWORD: {"from_secret": "hackage-password"} | |||
volumes: | |||
- name: cabal-cache | |||
path: /cabal | |||
commands: | |||
- ./scripts/release | |||
when: | |||
event: | |||
- tag | |||
volumes: | |||
- name: cabal-cache | |||
host: | |||
path: /var/cache/cabal | |||
--- | |||
kind: signature | |||
hmac: 4182c9a06e0671846733a1cd1617ad52119e1a96be312770004503c6be80b553 | |||
... |
@ -0,0 +1,5 @@ | |||
.stack-work/ | |||
dist/ | |||
dist-newstyle/ | |||
/cabal.project.local | |||
*~ |
@ -0,0 +1,19 @@ | |||
# HLint configuration file | |||
# https://github.com/ndmitchell/hlint | |||
########################## | |||
# This file contains a template configuration file, which is typically | |||
# placed as .hlint.yaml in the root of your project | |||
# Specify additional command line arguments | |||
# | |||
# - arguments: [--color, --cpp-simple, -XQuasiQuotes] | |||
- arguments: | |||
- --git | |||
- -XNoCPP | |||
- '--extension=hs' | |||
- ignore: {name: 'Redundant $'} | |||
- ignore: {name: 'Redundant do'} | |||
- ignore: {name: 'Use <$>'} |
@ -0,0 +1,17 @@ | |||
{ | |||
"files.exclude": { | |||
"dist/**": true, | |||
"dist-newstyle/**": true, | |||
".ghc.environment.*": true, | |||
".gitattributes": true, | |||
".env/**": true | |||
}, | |||
"files.watcherExclude": { | |||
"**/.out/**": true, | |||
"**/.git/objects/**": true, | |||
"**/.git/subtree-cache/**": true, | |||
"**/.env/**": true, | |||
"**/dist/**": true, | |||
"**/dist-newstyle/**": true | |||
} | |||
} |
@ -0,0 +1,2 @@ | |||
# v0.1.0.0 _(2020-03-03)_ | |||
- Initial version |
@ -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. |
@ -0,0 +1,9 @@ | |||
title: prosidyc | |||
--- | |||
#lit{prosidyc} is a Haskell library for compiling | |||
#link[uri='https://prosidy.org']{Prosidy} documents into other formats | |||
with less of the ceremony of explicit #lit{case ... of} clauses. | |||
This library is in a #i{very early} state. Don't use it unless you enjoy | |||
everything breaking. |
@ -0,0 +1,46 @@ | |||
conf_debug: | |||
dconf_roundtrip_exactprint_only: false | |||
dconf_dump_bridoc_simpl_par: false | |||
dconf_dump_ast_unknown: false | |||
dconf_dump_bridoc_simpl_floating: false | |||
dconf_dump_config: false | |||
dconf_dump_bridoc_raw: false | |||
dconf_dump_bridoc_final: false | |||
dconf_dump_bridoc_simpl_alt: false | |||
dconf_dump_bridoc_simpl_indent: false | |||
dconf_dump_annotations: false | |||
dconf_dump_bridoc_simpl_columns: false | |||
dconf_dump_ast_full: false | |||
conf_forward: | |||
options_ghc: [] | |||
conf_errorHandling: | |||
econf_ExactPrintFallback: ExactPrintFallbackModeInline | |||
econf_Werror: true | |||
econf_omit_output_valid_check: false | |||
econf_produceOutputOnErrors: false | |||
conf_preprocessor: | |||
ppconf_CPPMode: CPPModeAbort | |||
ppconf_hackAroundIncludes: false | |||
conf_obfuscate: false | |||
conf_roundtrip_exactprint_only: false | |||
conf_version: 1 | |||
conf_layout: | |||
lconfig_reformatModulePreamble: true | |||
lconfig_altChooser: | |||
tag: AltChooserBoundedSearch | |||
contents: 3 | |||
lconfig_allowSingleLineExportList: true | |||
lconfig_importColumn: 50 | |||
lconfig_hangingTypeSignature: false | |||
lconfig_importAsColumn: 50 | |||
lconfig_alignmentLimit: 30 | |||
lconfig_allowHangingQuasiQuotes: true | |||
lconfig_indentListSpecial: true | |||
lconfig_indentAmount: 4 | |||
lconfig_alignmentBreakOnMultiline: true | |||
lconfig_cols: 80 | |||
lconfig_indentPolicy: IndentPolicyFree | |||
lconfig_indentWhereSpecial: true | |||
lconfig_columnAlignMode: | |||
tag: ColumnAlignModeMajority | |||
contents: 0.7 |
@ -0,0 +1,4 @@ | |||
packages: prosidyc.cabal | |||
optimization: True | |||
split-sections: True | |||
test-show-details: direct |
@ -0,0 +1,4 @@ | |||
cradle: | |||
cabal: | |||
- path: '.' | |||
component: 'lib:prosidyc' |
@ -0,0 +1,120 @@ | |||
cabal-version: 2.4 | |||
name: prosidyc | |||
version: 0.1.0.0 | |||
synopsis: A DSL for processing Prosidy 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 | |||
extra-source-files: CHANGELOG, README.pro | |||
tested-with: | |||
GHC == 8.6.5 | |||
, GHC == 8.8.1 | |||
description: | |||
A small, Haskell EDSL which builds a specification and compiler for | |||
Prosidy dialects. | |||
source-repository head | |||
type: git | |||
location: https://git.fldcr.com/prosidy/prosidyc | |||
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.Compile | |||
, Prosidy.Compile.Core | |||
, Prosidy.Compile.Error | |||
, Prosidy.Compile.Match | |||
other-modules: | |||
Prosidy.Compile.Run | |||
build-depends: | |||
base >= 4.11 && < 5 | |||
, prosidy >= 1.6 && < 1.7 | |||
, mtl | |||
, microlens | |||
, microlens-mtl | |||
, text | |||
, bytestring | |||
, containers | |||
, unordered-containers | |||
, free | |||
, hashable | |||
, profunctors | |||
, transformers | |||
-- , 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 |
@ -0,0 +1,12 @@ | |||
#!/bin/bash | |||
# code: language=sh | |||
set -e | |||
tmpfile="$(mktemp)" | |||
trap "rm -f $tmpfile" EXIT | |||
cabal v2-haddock --haddock-for-hackage --enable-documentation 2>&1 | tee "$tmpfile" | |||
if grep --quiet --fixed-strings 'Missing documentation for:' "$tmpfile" | |||
then | |||
printf -- '-----\nERROR: Not all public exports have documentation.' >&2 | |||
exit 1 | |||
fi |
@ -0,0 +1,15 @@ | |||
#!/bin/bash | |||
set -euo pipefail | |||
cd "$(git rev-parse --show-toplevel)" | |||
version="$(grep '^version:' prosidyc.cabal | sed 's|^version: *||')" | |||
echo "Publishing v${version}" >&2 | |||
do-upload () | |||
{ | |||
cabal upload --username="${HACKAGE_USER}" --password="${HACKAGE_PASSWORD}" "$@" | |||
} | |||
cabal sdist | |||
do-upload "dist-newstyle/sdist/prosidyc-${version}.tar.gz" | |||
do-upload --documentation "dist-newstyle/prosidyc-${version}-docs.tar.gz" |
@ -0,0 +1,85 @@ | |||
{-| | |||
Module : Prosidy.Compile | |||
Description : Compile Prosidy documents into other shapes | |||
Copyright : ©2020 James Alexander Feldman-Crough | |||
License : MPL-2.0 | |||
Maintainer : alex@fldcr.com | |||
-} | |||
{-# LANGUAGE TypeFamilies #-} | |||
{-# LANGUAGE FlexibleContexts #-} | |||
{-# LANGUAGE ApplicativeDo #-} | |||
{-# LANGUAGE DerivingVia #-} | |||
{-# LANGUAGE LambdaCase #-} | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module Prosidy.Compile | |||
( -- * Accessors | |||
escapeHatch | |||
, getContent | |||
, matchContent | |||
, optParse | |||
, prop | |||
, reqParse | |||
, traversing | |||
, self | |||
-- * Reëxports | |||
, RuleT | |||
, Rule | |||
, CanMatch | |||
, Error(..) | |||
, ErrorSet | |||
, module Prosidy.Compile.Match | |||
, module Prosidy.Compile.Run | |||
) | |||
where | |||
import Prelude hiding ( break ) | |||
import Prosidy.Compile.Core | |||
import Prosidy.Compile.Error | |||
import Prosidy.Compile.Match | |||
import Prosidy.Compile.Run | |||
import Data.Text ( Text ) | |||
import qualified Prosidy as P | |||
------------------------------------------------------------------------------- | |||
-- | Access the inner 'Prosidy.Types.Content' of a node. | |||
getContent :: P.HasContent i => RuleT (P.Content i) e f a -> RuleT i e f a | |||
getContent = rule . GetContent | |||
-- | Traverse over each item in a node's 'P.Content' via fallible matches. | |||
matchContent | |||
:: (Traversable t, P.HasContent i, t x ~ P.Content i, CanMatch x) | |||
=> Match x e f a | |||
-> RuleT i e f (t a) | |||
matchContent = getContent . traversing . match | |||
-- | Parse an optional setting from a node with attached 'P.Metadata'. | |||
optParse | |||
:: P.HasMetadata i | |||
=> P.Key | |||
-> (Text -> Either String a) | |||
-> RuleT i e f (Maybe a) | |||
optParse key = rule . GetSetting id key | |||
-- | Check if a property is set on a node with attached 'P.Metadata'. | |||
prop :: P.HasMetadata i => P.Key -> RuleT i e f Bool | |||
prop = rule . GetProperty id | |||
-- | Parse an required setting from a node with attached 'P.Metadata'. | |||
reqParse | |||
:: P.HasMetadata i => P.Key -> (Text -> Either String a) -> RuleT i e f a | |||
reqParse key = rule . GetRequiredSetting key | |||
-- | Lift a 'RuleT' so that it operates on a traversable structure. | |||
traversing :: Traversable t => RuleT i e f a -> RuleT (t i) e f (t a) | |||
traversing = rule . Traverse id id | |||
-- | Access the contents of a node. | |||
self :: RuleT i e f i | |||
self = rule $ GetSelf id | |||
-- | Do anything you want with a node. This should be used sparingly! The | |||
-- actions you perform inside of this function are invisible to inspection. | |||
escapeHatch :: (i -> f (Either (Error e) a)) -> RuleT i e f a | |||
escapeHatch = rule . Lift |
@ -0,0 +1,291 @@ | |||
{-| | |||
Module : Prosidy.Compile.Core | |||
Description : Primitive type definitions and functions. | |||
Copyright : ©2020 James Alexander Feldman-Crough | |||
License : MPL-2.0 | |||
Maintainer : alex@fldcr.com | |||
-} | |||
{-# LANGUAGE DeriveFunctor #-} | |||
{-# LANGUAGE FlexibleContexts #-} | |||
{-# LANGUAGE TypeFamilies #-} | |||
{-# LANGUAGE KindSignatures #-} | |||
{-# LANGUAGE DerivingVia #-} | |||
{-# LANGUAGE QuantifiedConstraints #-} | |||
{-# LANGUAGE GeneralisedNewtypeDeriving #-} | |||
{-# LANGUAGE GADTs #-} | |||
{-# LANGUAGE RankNTypes #-} | |||
{-# LANGUAGE LambdaCase #-} | |||
module Prosidy.Compile.Core | |||
( RuleF(..) | |||
, RuleT | |||
, Rule | |||
, CanMatch(evalPattern, noMatchError) | |||
, Pattern(..) | |||
, Interpret | |||
, BlockRegion | |||
, InlineRegion | |||
, LiteralRegion | |||
, interpretWith | |||
, evalPatterns | |||
, rule | |||
) | |||
where | |||
import Lens.Micro | |||
import Prosidy.Compile.Error | |||
import Prosidy ( Key | |||
, HasLocation | |||
, HasMetadata | |||
, HasContent(Content) | |||
) | |||
import Data.Text ( Text ) | |||
import Data.Bifunctor ( Bifunctor(..) ) | |||
import Data.List.NonEmpty ( NonEmpty(..) ) | |||
import Control.Monad.Except ( runExceptT ) | |||
import Control.Monad.Trans.Class ( MonadTrans(..) ) | |||
import Data.Functor.Identity ( Identity ) | |||
import qualified Prosidy | |||
import qualified Control.Applicative.Free.Final | |||
as Ap | |||
-- | A single compilation rule. Parameterized by the following types: | |||
-- | |||
-- * @input@: The type of the Prosidy node that is currently accessible. | |||
-- | |||
-- * @error@: Allows users to specify a custom error type to be used for | |||
-- throwing errors. 'Data.Void.Void' can be used to rely solely on | |||
-- the errors built into this library. | |||
-- | |||
-- * @context@: A 'Monad' for performing contextual computation beyond what | |||
-- is provided by this library. If additional contextual computation is not | |||
-- desired, use 'Data.Functor.Identity.Identity' as the type. | |||
-- | |||
-- * @output@: The resulting output type. | |||
newtype RuleT input error context output = RuleT | |||
(Ap.Ap (RuleF input error context) output) | |||
deriving (Functor, Applicative) | |||
instance MonadTrans (RuleT input error) where | |||
lift = rule . Lift . const . fmap Right | |||
-- | 'RuleT' without a contextual environment. | |||
type Rule input error = RuleT input error Identity | |||
-- | Lifts a 'RuleF' into a 'RuleT'. | |||
rule :: RuleF i e f o -> RuleT i e f o | |||
rule = RuleT . Ap.liftAp | |||
-- | The control functor for compiling Prosidy elements. Each action | |||
-- corresponds to an action to perform on the @input@ variable. | |||
-- | |||
-- See 'RuleT' and 'Rule' for use of this type. | |||
data RuleF input error context output where | |||
-- | Throw an error. | |||
Fail | |||
::Error error | |||
-> RuleF input error context output | |||
-- | Embed a raw action as a rule. Note: Please avoid using this if | |||
-- possible: it breaks static introspection! | |||
Lift | |||
::(input -> context (Either (Error error) output)) | |||
-> RuleF input error context output | |||
-- | Given a non-empty list of potential cases, construct a Rule that | |||
-- processes any items matching at least one of those cases. | |||
TestMatch | |||
::(CanMatch input) | |||
=> NonEmpty (Pattern input error context output) | |||
-> RuleF input error context output | |||
Traverse | |||
::Traversable t | |||
=> (input -> t i) | |||
-> (t o -> output) | |||
-> RuleT i error context o | |||
-> RuleF input error context output | |||
-- | When @input@ is a value wrapping some 'Content', enable access to that | |||
-- 'Content' by wrapping a 'RuleT'. | |||
GetContent | |||
::HasContent input | |||
=> RuleT (Content input) error context output | |||
-> RuleF input error context output | |||
-- | Fetch a property from items with metadata. | |||
GetProperty | |||
::HasMetadata input | |||
=> (Bool -> a) | |||
-> Key | |||
-> RuleF input error context a | |||
-- | Fetch an /optional/ setting from items with metadata. | |||
GetSetting | |||
::HasMetadata input | |||
=> (Maybe x -> output) | |||
-> Key | |||
-> (Text -> Either String x) | |||
-> RuleF input error context output | |||
-- | Fetch a /required/ setting from items with metadata. | |||
GetRequiredSetting | |||
::HasMetadata input | |||
=> Key | |||
-> (Text -> Either String output) | |||
-> RuleF input error context output | |||
-- | Get the raw text from a 'Text' node. | |||
GetSelf | |||
::(input -> output) | |||
-> RuleF input error context output | |||
instance Functor context => Functor (RuleF input error context) where | |||
fmap fn = \case | |||
Fail error -> Fail error | |||
Lift lift -> Lift $ fmap (fmap fn) . lift | |||
TestMatch matches -> TestMatch $ fmap (fmap fn) matches | |||
Traverse f g rule -> Traverse f (fn . g) rule | |||
GetContent rule -> GetContent $ fmap fn rule | |||
GetProperty k key -> GetProperty (fn . k) key | |||
GetSetting k key parse -> GetSetting (fn . k) key parse | |||
GetRequiredSetting key parse -> | |||
GetRequiredSetting key (fmap fn . parse) | |||
GetSelf k -> GetSelf (fn . k) | |||
------------------------------------------------------------------------------- | |||
-- | A (lawless) typeclass for enabling fallible matching on nodes. | |||
-- | |||
-- Implementing new instances of this class in library code is *unneccessary* | |||
-- and *unsupported*. | |||
class (forall i e. Functor (Pattern t i e), HasLocation t) => CanMatch t where | |||
-- | A data type representing allowable fallible patterns for @t@. | |||
data family Pattern t :: * -> (* -> *) -> * -> * | |||
-- | Information about why a @Pattern@ failed to match. | |||
data family NoMatch t :: * | |||
-- | Attempt to match a pattern against a value. | |||
evalPattern :: | |||
Applicative g | |||
=> Pattern t error context output | |||
-- ^ The @Pattern@ to match against | |||
-> Interpret error context g | |||
-- ^ An interpreter for evaluating the match. | |||
-> t | |||
-- ^ The value to attempt to match against | |||
-> Either (NoMatch t) (g output) | |||
-- | Lift a @NoMatch@ error into the 'Error' type. | |||
noMatchError :: NoMatch t -> Error e | |||
instance CanMatch Prosidy.Block where | |||
data Pattern Prosidy.Block error context output = | |||
BlockTagP Key (RuleT BlockRegion error context output) | |||
| LitTagP Key (RuleT LiteralRegion error context output) | |||
| ParagraphP (RuleT (Prosidy.SeriesNE Prosidy.Inline) error context output) | |||
deriving Functor | |||
data NoMatch Prosidy.Block = | |||
NoMatchBlockTag Key | |||
| NoMatchLitTag Key | |||
| NoMatchParagraph | |||
evalPattern (BlockTagP key rule) = evalPatternWith | |||
(Prosidy._BlockTag . Prosidy.tagged key) | |||
(NoMatchBlockTag key) | |||
rule | |||
evalPattern (LitTagP key rule) = evalPatternWith | |||
(Prosidy._BlockLiteral . Prosidy.tagged key) | |||
(NoMatchLitTag key) | |||
rule | |||
evalPattern (ParagraphP rule) = evalPatternWith | |||
(Prosidy._BlockParagraph . Prosidy.content) | |||
NoMatchParagraph | |||
rule | |||
noMatchError (NoMatchBlockTag key) = ExpectedTag BlockKind key | |||
noMatchError (NoMatchLitTag key) = ExpectedTag LiteralKind key | |||
noMatchError NoMatchParagraph = ExpectedParagraph | |||
instance CanMatch Prosidy.Inline where | |||
data Pattern Prosidy.Inline error context output = | |||
InlineTagP Key (RuleT InlineRegion error context output) | |||
| BreakP (RuleT () error context output) | |||
| TextP (RuleT Text error context output) | |||
deriving Functor | |||
data NoMatch Prosidy.Inline = | |||
NoMatchInlineTag Key | |||
| NoMatchBreak | |||
| NoMatchText | |||
evalPattern (InlineTagP key rule) = evalPatternWith | |||
(Prosidy._InlineTag . Prosidy.tagged key) | |||
(NoMatchInlineTag key) | |||
rule | |||
evalPattern (TextP rule) = | |||
evalPatternWith (Prosidy._Text . Prosidy.fragment) NoMatchText rule | |||
evalPattern (BreakP rule) = | |||
evalPatternWith Prosidy._Break NoMatchBreak rule | |||
noMatchError (NoMatchInlineTag key) = ExpectedTag InlineKind key | |||
noMatchError NoMatchText = ExpectedText | |||
noMatchError NoMatchBreak = ExpectedBreak | |||
-- | Match one or more patterns, in sequence, against a value. The result from | |||
-- the first successful pattern will be returned. Subsequent matches will not | |||
-- be tried. | |||
evalPatterns | |||
:: (CanMatch i, IsError e, MonadErrors e g) | |||
=> NonEmpty (Pattern i e f o) | |||
-> Interpret e f g | |||
-> i | |||
-> g o | |||
evalPatterns (x :| xs) interpret input = | |||
runExceptT folded >>= either throwError pure | |||
where | |||
folded = foldr (\pat acc -> doEval pat `orElse` acc) (doEval x) xs | |||
doEval pat = either (throwError1 . noMatchError) lift | |||
$ evalPattern pat interpret input | |||
orElse lhsM rhsM = do | |||
lhs <- lift $ runExceptT lhsM | |||
case lhs of | |||
Right ok -> pure ok | |||
Left err -> rhsM `catchError` \err' -> throwError $ err <> err' | |||
evalPatternWith | |||
:: Applicative g | |||
=> Traversal' i j | |||
-> e | |||
-> RuleT j e' f o | |||
-> Interpret e' f g | |||
-> i | |||
-> Either e (g o) | |||
evalPatternWith sel error rule interpret input = | |||
second (interpretWith rule interpret) | |||
. maybe (Left error) Right | |||
$ input | |||
^? sel | |||
------------------------------------------------------------------------------- | |||
-- | Build an interpreter into a functor @g@. | |||
interpretWith :: Applicative g => RuleT i e f a -> Interpret e f g -> i -> g a | |||
interpretWith (RuleT ap) int i = Ap.runAp (int i) ap | |||
------------------------------------------------------------------------------- | |||
-- | Runs a single 'RuleF' into an applicative @g@. Passing this value to | |||
-- 'interpretWith' will fully evaluate a 'RuleT' into the same functor. | |||
type Interpret e f g = forall i a . i -> RuleF i e f a -> g a | |||
------------------------------------------------------------------------------- | |||
-- | A 'Prosidy.Types.BlockTag' with the tag name removed. | |||
type BlockRegion = Prosidy.Region (Prosidy.Series Prosidy.Block) | |||
-- | An 'Prosidy.Types.InlineTag' with the tag name removed. | |||
type InlineRegion = Prosidy.Region (Prosidy.Series Prosidy.Inline) | |||
-- | A 'Prosidy.Types.LiteralTag' with the tag name removed. | |||
type LiteralRegion = Prosidy.Region Text |
@ -0,0 +1,175 @@ | |||
{-| | |||
Module : Prosidy.Compile.Error | |||
Description : Error definitions and utility functions. | |||
Copyright : ©2020 James Alexander Feldman-Crough | |||
License : MPL-2.0 | |||
Maintainer : alex@fldcr.com | |||
-} | |||
{-# LANGUAGE ConstraintKinds #-} | |||
{-# LANGUAGE FlexibleContexts #-} | |||
{-# LANGUAGE LambdaCase #-} | |||
{-# LANGUAGE DeriveAnyClass #-} | |||
{-# LANGUAGE DeriveGeneric #-} | |||
{-# LANGUAGE DerivingStrategies #-} | |||
{-# LANGUAGE GeneralisedNewtypeDeriving #-} | |||
module Prosidy.Compile.Error | |||
( Error(..) | |||
, TagKind(..) | |||
, ErrorSet | |||
, Error' | |||
, ErrorSet' | |||
, IsError | |||
, MonadErrors | |||
, singleError | |||
, customError | |||
, throwError1 | |||
, allErrors | |||
, attachLocation | |||
, MonadError(..) | |||
) | |||
where | |||
import Lens.Micro | |||
import Control.Exception ( Exception(..) ) | |||
import Prosidy.Types.Key ( Key ) | |||
import Prosidy.Source ( Line(..) | |||
, Column(..) | |||
, Location | |||
) | |||
import Prosidy.Optics.Source ( HasLocation(..) | |||
, line | |||
, column | |||
) | |||
import Data.HashSet ( HashSet | |||
, singleton | |||
) | |||
import Control.Monad.Except ( MonadError(..) | |||
, throwError | |||
) | |||
import GHC.Generics ( Generic ) | |||
import Data.Hashable ( Hashable ) | |||
import Data.Typeable ( Typeable ) | |||
import Data.Void ( Void ) | |||
import Data.Foldable ( toList ) | |||
import Data.List.NonEmpty ( NonEmpty(..) | |||
, nonEmpty | |||
) | |||
-- | A contraint alias for types returning at least one error. | |||
type MonadErrors e = MonadError (ErrorSet e) | |||
-- | A constraint alias for errors throwable in a context admitting a | |||
-- 'MonadErrors' instance. | |||
type IsError e = (Exception e, Hashable e, Eq e) | |||
-- | A non-empty set of errors. | |||
newtype ErrorSet e = | |||
ErrorSet (HashSet (Error e)) | |||
deriving stock (Show, Generic, Eq) | |||
deriving anyclass (Hashable) | |||
instance IsError e => Semigroup (ErrorSet e) where | |||
ErrorSet lhs <> ErrorSet rhs = ErrorSet $! lhs <> rhs | |||
-- | A type alias for 'ErrorSet's which never contain empty errors. | |||
type ErrorSet' = ErrorSet Void | |||
-- | Enumerates the errors thrown when | |||
data Error a = | |||
Custom a | |||
-- ^ A custom error, allowing extensibility. | |||
| ParseError Key String | |||
-- ^ Thrown when parsing a setting fails. | |||
| Required Key | |||
-- ^ Thrown when a setting was required to be set, but wasn't provided. | |||
| ExpectedTag TagKind Key | |||
-- ^ Thrown when matching against a 'Prosidy.Tag', and another node was | |||
-- found, or the input tag's 'Key' didn't match the specified key. | |||
| ExpectedParagraph | |||
-- ^ Thrown when matching against paragraph and an unexpected node was | |||
-- encountered. | |||
| ExpectedText | |||
-- ^ Thrown when matching against text and an unexpected node was | |||
-- encountered. | |||
| ExpectedBreak | |||
-- ^ Thrown when matching against an explicit break and an unexpected node | |||
-- was encountered. | |||
| EmptyMatch | |||
-- ^ Thrown when a match has no cases to check against. | |||
| Group (Maybe Location) (ErrorSet a) | |||
-- ^ Used to group a set of errors thrown at the same point in a tree. | |||
-- If a location is available, we attach it for debugging. | |||
deriving (Eq, Show, Generic, Hashable) | |||
instance (Typeable a, Exception a) => Exception (Error a) where | |||
displayException (Custom a ) = displayException a | |||
displayException (ParseError k msg) = mconcat | |||
[ showString "failed to parse the setting " | |||
, shows k | |||
, showString ": " | |||
, showString msg | |||
] | |||
"" | |||
displayException EmptyMatch = "Match provided with no possible cases." | |||
displayException (Required k) = "missing required setting " <> show k | |||
displayException (ExpectedTag kind k) = | |||
"expected a " <> show kind <> " tag with key " <> show k | |||
displayException ExpectedParagraph = "expected a paragrapgh" | |||
displayException ExpectedText = "expected plain text" | |||
displayException ExpectedBreak = "expected a break" | |||
displayException (Group (Just loc) x) = mconcat | |||
[ showString "error(s) encountered at line " | |||
, shows (loc ^?! line . to (\(Line n) -> succ n)) | |||
, showString " column " | |||
, shows (loc ^?! column . to (\(Column n) -> succ n)) | |||
, showString ":\n" | |||
, foldMap | |||
(\exn -> showString (displayException exn) <> showChar '\n') | |||
(allErrors x) | |||
] | |||
"" | |||
displayException (Group Nothing x) = foldMap | |||
(\exn -> showString (displayException exn) <> showChar '\n') | |||
(allErrors x) | |||
"" | |||
-- | A type alias for 'Error's that never throw a custom error. | |||
type Error' = Error Void | |||
-- | A marker class for marking which type of tag 'ExpectedTag' was expecting. | |||
data TagKind = BlockKind | InlineKind | LiteralKind | |||
deriving (Show, Eq, Generic, Hashable) | |||
-- | Group errors together, attaching a location if one is available. | |||
attachLocation :: (IsError e, MonadErrors e m, HasLocation l) => l -> m a -> m a | |||
attachLocation item = flip catchError $ throwError1 . Group (item ^? location) | |||
-- | Lift a single 'Error' into an 'ErrorSet'. | |||
singleError :: Hashable e => Error e -> ErrorSet e | |||
singleError = ErrorSet . singleton | |||
{-# INLINE singleError #-} | |||
-- | Lift a custom error into an 'ErrorSet'. | |||
customError :: Hashable e => e -> ErrorSet e | |||
customError = singleError . Custom | |||
{-# INLINE customError #-} | |||
-- | Throw a single error. | |||
throwError1 :: Hashable e => MonadErrors e m => Error e -> m a | |||
throwError1 = throwError . singleError | |||
{-# INLINE throwError1 #-} | |||
-- | Return the set of errors in an 'ErrorSet' as a non-empty list. | |||
allErrors :: ErrorSet e -> NonEmpty (Error e) | |||
allErrors (ErrorSet hs) = | |||
maybe (error "unexpected empty ErrorSet") id . nonEmpty $ toList hs |
@ -0,0 +1,91 @@ | |||
{-| | |||
Module : Prosidy.Compile.Match | |||
Description : Fallible pattern rules. | |||
Copyright : ©2020 James Alexander Feldman-Crough | |||
License : MPL-2.0 | |||
Maintainer : alex@fldcr.com | |||
-} | |||
{-# LANGUAGE DerivingVia #-} | |||
module Prosidy.Compile.Match | |||
( -- * DSL for matching cases | |||
Match | |||
, MatchM | |||
, match | |||
-- ** Specific matchers | |||
, break | |||
, breakWith | |||
, blocktag | |||
, inlinetag | |||
, literaltag | |||
, paragraph | |||
, text | |||
) | |||
where | |||
import Prelude hiding ( break ) | |||
import Prosidy.Compile.Core | |||
import Prosidy.Compile.Error | |||
import Control.Monad.State ( StateT(..) | |||
, State | |||
, modify' | |||
, execState | |||
) | |||
import Data.Monoid ( Endo(..) ) | |||
import Data.Text ( Text ) | |||
import Data.List.NonEmpty ( NonEmpty(..) ) | |||
import qualified Prosidy as P | |||
-- | The type of fallible pattern specifications. | |||
type Match i e f a = MatchM i e a f () | |||
-- | A monadic interface for defining fallible patterns. In practice, @r@ will | |||
-- always be instantiated to @()@— 'Match' can be more clear. | |||
newtype MatchM i e a f r = MatchM (State (Endo [Pattern i e f a]) r) | |||
deriving (Functor, Applicative, Monad) | |||
via State (Endo [Pattern i e f a]) | |||
-- | Finalize a 'Match' into a rule. This is often used to offset a match | |||
-- block: | |||
-- | |||
-- @ | |||
-- blocktags :: Match Block Void Identity String | |||
-- blocktags = match $ do | |||
-- ... | |||
-- @ | |||
match :: CanMatch i => Match i e f a -> RuleT i e f a | |||
match (MatchM s) = case appEndo (execState s mempty) [] of | |||
x : xs -> rule . TestMatch $ x :| xs | |||
[] -> rule $ Fail EmptyMatch | |||
-- | Match against a 'Prosidy.Typs.Break'. | |||
break :: RuleT () e f a -> Match P.Inline e f a | |||
break = put . BreakP | |||
-- | Replace all 'Prosidy.Types.Break's with the provided value. | |||
breakWith :: a -> Match P.Inline e f a | |||
breakWith = put . BreakP . pure | |||
-- | Match a 'Prosidy.Types.BlockTag' with the given 'P.Key'. | |||
blocktag :: P.Key -> RuleT BlockRegion e f a -> Match P.Block e f a | |||
blocktag key = put . BlockTagP key | |||
-- | Match an 'Prosidy.Types.InlineTag' with the given 'P.Key'. | |||
inlinetag :: P.Key -> RuleT InlineRegion e f a -> Match P.Inline e f a | |||
inlinetag key = put . InlineTagP key | |||
-- | Match an 'Prosidy.Types.LiteralTag' with the given 'P.Key'. | |||
literaltag :: P.Key -> RuleT LiteralRegion e f a -> Match P.Block e f a | |||
literaltag key = put . LitTagP key | |||
-- | Match 'Prosidy.Types.Paragraph's in a block context. | |||
paragraph :: RuleT (P.SeriesNE P.Inline) e f a -> Match P.Block e f a | |||
paragraph = put . ParagraphP | |||
-- | Match plain 'Text' in an inline context. | |||
text :: RuleT Text e f a -> Match P.Inline e f a | |||
text = put . TextP | |||
put :: Pattern i e f a -> Match i e f a | |||
put x = MatchM $ modify' (<> Endo (x :)) |
@ -0,0 +1,73 @@ | |||
{-| | |||
Module : Prosidy.Compile.Run | |||
Description : Interpretation of compilation rules. | |||
Copyright : ©2020 James Alexander Feldman-Crough | |||
License : MPL-2.0 | |||
Maintainer : alex@fldcr.com | |||
-} | |||
{-# LANGUAGE DerivingVia #-} | |||
{-# LANGUAGE LambdaCase #-} | |||
module Prosidy.Compile.Run (run, runM) where | |||
import Lens.Micro | |||
import Prosidy.Compile.Core | |||
import Prosidy.Compile.Error | |||
import Control.Monad.Trans ( MonadIO(..) | |||
, MonadTrans(..) | |||
) | |||
import Control.Monad.Except ( ExceptT(..) ) | |||
import Data.Functor.Identity ( Identity(..) ) | |||
import qualified Prosidy as P | |||
------------------------------------------------------------------------------- | |||
-- | Run a 'Rule' against an input, returning a parse result. | |||
run :: IsError e => RuleT i e Identity a -> i -> Either (ErrorSet e) a | |||
run rule = runIdentity . runM rule | |||
-- | Run a 'RuleT' against an input, returning a contextual parse result. | |||
runM | |||
:: (Monad context, IsError e) | |||
=> RuleT i e context a | |||
-> i | |||
-> context (Either (ErrorSet e) a) | |||
runM rule = (\(Run x) -> x) . runRun rule | |||
------------------------------------------------------------------------------- | |||
newtype Run error context output = Run | |||
(context (Either (ErrorSet error) output)) | |||
deriving (Functor, Applicative, Monad, MonadError (ErrorSet error)) | |||
via (ExceptT (ErrorSet error) context) | |||
instance MonadIO context => MonadIO (Run error context) where | |||
liftIO = lift . liftIO | |||
instance MonadTrans (Run error) where | |||
lift = Run . fmap Right | |||
runRun | |||
:: (Monad context, IsError e) => RuleT i e context a -> i -> Run e context a | |||
runRun rule = interpretWith rule interpret | |||
interpret | |||
:: (Monad context, IsError error) | |||
=> Interpret error context (Run error context) | |||
interpret input = \case | |||
Fail e -> throwError1 e | |||
Lift lifted -> lift (lifted input) >>= either throwError1 pure | |||
TestMatch matches -> | |||
attachLocation input $ evalPatterns matches interpret input | |||
Traverse f g rule -> do | |||
fmap g . traverse (runRun rule) $ f input | |||
GetContent rule -> runRun rule $ input ^. P.content | |||
GetProperty k key -> input ^. P.hasProperty key & pure . k | |||
GetSetting k key parse -> | |||
input ^. P.atSetting key & traverse parse & either | |||
(throwError1 . ParseError key) | |||
(pure . k) | |||
GetRequiredSetting key parse -> do | |||
raw <- | |||
input ^. P.atSetting key & maybe (throwError1 $ Required key) pure | |||
either (throwError1 . ParseError key) pure $ parse raw | |||
GetSelf k -> pure $ k input |