Start cleaning up prosidyc a touch

1 year ago · a2441464aa
--- a/.ghc.environment.x86_64-linux-8.6.5
+++ b/.ghc.environment.x86_64-linux-8.6.5
@ -1,169 +0,0 @@
 -- This is a GHC environment file written by cabal. This means you can
 -- run ghc or ghci and get the environment of the project as a whole.
 -- But you still need to use cabal repl $target to get the environment
 -- of specific components (libs, exes, tests etc) because each one can
 -- have its own source dirs, cpp flags etc.
 -- 
 clear-package-db
 global-package-db
 package-db /home/alex/.cabal/store/ghc-8.6.5/package.db
 package-db dist-newstyle/packagedb/ghc-8.6.5
 package-id ansi-terminal-0.10.2-eb5a0374566fbec86fbb30c8199b3548bcc6893e19daf660ba94ef1746fdfc90
 package-id base-4.12.0.0
 package-id ghc-prim-0.5.3
 package-id rts
 package-id integer-gmp-1.0.2.0
 package-id colour-2.3.5-11d8a9d0f1dd817600055ee7992da3be937d74157c6f96d6f36a7d34f9622a2c
 package-id ansi-wl-pprint-0.6.9-7585bb10f507337b515ae28bfa0df7fabd1bac4d786cba3bf91c68a2e5b99181
 package-id fast-logger-3.0.0-83d9c5ec024c66b7d10ffd04dd1a391209bfb18153fb7b0517b246e737707a3b
 package-id array-0.5.3.0
 package-id auto-update-0.1.6-98d10e8ce5e7e536de6a6d8df954db48dad48614f7863699b472384743e5a67e
 package-id bytestring-0.10.8.2
 package-id deepseq-1.4.4.0
 package-id directory-1.3.3.0
 package-id filepath-1.4.2.1
 package-id time-1.8.0.2
 package-id unix-2.7.2.2
 package-id easy-file-0.2.2-92959ba478d985b735ee481b34063b4e8efdd2296cd24868cf663c413bac4e35
 package-id text-1.2.4.0-6a64a71c95fbc671920ed3189029bc8e7a37784468705530c021e47f6c20c191
 package-id binary-0.8.6.0
 package-id containers-0.6.0.1
 package-id template-haskell-2.14.0.0
 package-id ghc-boot-th-8.6.5
 package-id pretty-1.1.3.6
 package-id unix-compat-0.5.2-e8c0930470a3a86997ae9007ace019f1e92a2c46b634fabc805da56a407bfa40
 package-id unix-time-0.4.7-14e71c2afb8f9ed1844ba0233d174ad63fbf20b3551ea6cb3ddc943371523497
 package-id old-time-1.1.0.3-3fbbb271748fe85ec95f6d8873c8c4a7156105e6a65559d42d01837f279fc17b
 package-id old-locale-1.0.0.7-58671cc4ea8d5b273ae350b66f0eaf77474e14edfbf3ee86adbed945f34aaccd
 package-id hakyll-contrib-prosidy-0.0.1.0-inplace
 package-id hakyll-4.13.0.1-006d94c43bf01abf22a230606af4e4f64020afbc1e1b48d4f9f0b43dc160b36e
 package-id blaze-html-0.9.1.2-ad79b70f90accd2586f0666301841cdfbec487acdf10efe19098f403b2d6c94b
 package-id blaze-builder-0.4.1.0-f7bd132eab7dd74c3b53e3f9d01f9200aef9c1b91bd827cf090255d8c746f796
 package-id blaze-markup-0.8.2.3-e2df728971177f9e408c100ae0198d1d892e9a81a715fa827e2f180a32133e29
 package-id cryptohash-0.11.9-9a6602af89d99e4338b83f33c68529c6f369938324b63e6fee296999a207c040
 package-id byteable-0.1.1-6548e4c21697b16f145fac52ca0e5f13a743cc015d726323602efed317a52cec
 package-id cryptonite-0.26-79a12060bfb40c8d445368eab392b5062c96974e58be40bf8b1d5f91b06736ba
 package-id basement-0.0.11-38532f63ac41ee25f79180d0aebc5d51a7f85240f3af4570924ee715119bffbf
 package-id memory-0.15.0-549285929d34c97b7a5c17bb2fd3c145c7ac71ad64e65ed54027efa8e974e327
 package-id data-default-0.7.1.1-ccc6450ed34c0e987777ce21e9835b41580a9dc150c0a4f802ed2f6605c500ae
 package-id data-default-class-0.1.2.0-01d59e93053477e5cb5ca050a336f3368653512a1c2f97404c571bfb92df8b65
 package-id data-default-instances-containers-0.0.1-76921bf40e996a3fea9e44cb467b70a5a93a585ccca9fc015f16c599db0f62e8
 package-id data-default-instances-dlist-0.0.1-896b2116fba54c2a2af378c0f0169cb2a97030a62c54212a1ddac7225a2e2a06
 package-id dlist-0.8.0.7-da03f2ce7442c62f1f5b68ddf986c090639399cb6078c8a1e5f2a16b1622035c
 package-id data-default-instances-old-locale-0.0.1-a48bc854e512f8954f69cceafedfe169a8b37a4587bdc0e64d93ff0d89467945
 package-id file-embed-0.0.11.1-4d4bf2c711a9f6b86b78415058da50ab1ccc21e25bc487528f36b0d6afb8a456
 package-id fsnotify-0.3.0.1-4f6b7a36f4f228ae8c55957ebd4868f1115546bdcc7f7bf85bc7677bfaed3aaa
 package-id async-2.2.2-2b9e19a9330da018ae63bcb6812f19775efaee286c07fe900152bc90ef7cddf6
 package-id hashable-1.2.7.0-21fb2b38319e2d18c888022b0f688a40c224dfb23fadb735d065e59bca28f559
 package-id stm-2.5.0.0-e049910490d4e2ba21e661ca904b81c40b1de7bb9f63251965dcca509de0a39f
 package-id hinotify-0.4-2f062a25ce01166fb608bd9ef2e8e49febbdbe69a0d16e60dd26ac8db4ae7e7c
 package-id shelly-1.9.0-7b36643056ff92013f919d37312362432610987cb6e925eb99e370126a9bf2b2
 package-id enclosed-exceptions-1.0.3-d26b7792cef774ec6feb5b1e7fa342efcf7e07e33ec2fa415ecb8e80a74907f9
 package-id lifted-base-0.2.3.12-3825944fb4403aecc3c2196af285a4e7ac5d527f34a1036febd3d88997b3f811
 package-id monad-control-1.0.2.3-4285a3a6e25327905f1acc5cfce445597c51813a3eef9e04f569adde766e33f5
 package-id transformers-0.5.6.2
 package-id transformers-base-0.4.5.2-e7e33e1c834cbce84b56a49a06a45f9404b89d7651e939617df5cc18fc5be51e
 package-id base-orphans-0.8.1-99dc1c0697d9413d421778aa6eea34823901c0f8c76b5e04ddda8ad1918c36df
 package-id transformers-compat-0.6.5-399db18553cb81c91cd9653bf5f7a848415a4c527c693fdb86c36121c7d98202
 package-id exceptions-0.10.4-9e7e4aa3377e742622a393ae806f6b4209631c9f59ce95f2730d6f14314d8e46
 package-id mtl-2.2.2-69bfbf038a9b16049174c8702d4d3c7d25bc6b377e4134d85103648ca4ef4823
 package-id lifted-async-0.10.0.4-0595d2471f2a9110f4b60cee6b4a35a5cd3c12a1dc090dc06c059fce0ad97461
 package-id constraints-0.11.2-e34e43c6a09cf182cbbe3c4be5d3d1d37563801df30ab0ab40261596be362f0a
 package-id semigroups-0.19.1-56347f200f9be7b7a03a55f212a5043cebf270cd13617b68a03df3d192253afa
 package-id type-equality-1-4c3d65a37b12c32f5eac7a07002b8fddce3573b3fb8bf2442ddda171105eec25
 package-id process-1.6.5.0
 package-id http-conduit-2.3.7.3-ccd049c05ce18943e860f6839f26697222c8105d77af7175a1dcb2876b7c0362
 package-id aeson-1.4.6.0-cf2dcc0e3e6db2331aefb4379f226a1081a2a2ddb733d717ac5da53a5bde3763
 package-id attoparsec-0.13.2.3-a4b8619ef397033935da571305a489f7bf54aa3c5ea0ed2183c210c6a84c36e1
 package-id scientific-0.3.6.2-f656a28d32f0c18391c8a48c1b9f70822bcef217b5621b60297bd09cf64f17bf
 package-id integer-logarithms-1.0.3-d7222ca945adf334fa850ee737a78c4927440073ecb63bb967e413065b3448d4
 package-id primitive-0.7.0.0-e340afa20c7e9a1f3d985b3769a1ffd567535f95b3520f2c4e6c89df59b0cc63
 package-id base-compat-0.11.0-116755de95c7b772c47d8c705e8b92853bc497eb64a3bb6d314ac21b57789b3f
 package-id tagged-0.8.6-2f19f3c6c44e30ab01a22df2c8ea1e0877504211be6c1093389ad03acd021567
 package-id th-abstraction-0.3.1.0-e3ed11a231372a062757e3ff7ba5356b9e56168d1b4b15e38e17a473cf6cf0a1
 package-id time-compat-1.9.2.2-fba5d329eeec079337bb3cf6e669b8238db7782dacd4b43e77fcd02e9a3a5957
 package-id unordered-containers-0.2.10.0-3d412cb9402016c80ece9eabe38397e5cb111c0ca6dbe876d52fc5c7f40593e4
 package-id uuid-types-1.0.3-e408aa2c0edd3779e2bcbf385d0f497067c2679f7ba4b5f79f0b684f2af1f6fa
 package-id random-1.1-63aa7c3c583465efc9380b3e51afd52f388da2d7f7591ed7ed7eff3246a64ce6
 package-id vector-0.12.0.3-cd09c2557f0567a02d9f4aab823c713e340fb052681a0af44c168a4b80c8f1cd
 package-id conduit-1.3.1.2-6a041bed26d91d3fa3656521bf8810ab816ab625c99a3c5636222722d98ef2e4
 package-id mono-traversable-1.0.15.1-468c0b3b4fce2ba6c2c40c6861373f2b34072b3d1c5b767ecc5825cd0d6490b9
 package-id split-0.2.3.3-4e26f9909d36230ea289fb66c3308a8c396dfa2e32972539237e00b5608bb288
 package-id vector-algorithms-0.8.0.3-7300a6ba42ba517a24edaf96a5ebb86693000186dc3145f260b61f3e28ba8be5
 package-id resourcet-1.2.2-eb0d709472fb9dedb70972345ca035d726ac334af932f87535e2032d32637b63
 package-id unliftio-core-0.1.2.0-7a40320c3f2d13531341c25515efb7e13cb69b065f980f0a800c9b22e88f1a7d
 package-id conduit-extra-1.3.4-9941c2e4071887e04e691de4abd1d7abceca173f90ccea2f55667598d4a6f739
 package-id network-3.1.1.1-3d16d7f515edf7f6ba7fafff4b8a26862e69b1be89534fa75786428fa36fdbdd
 package-id streaming-commons-0.2.1.1-969379f83927c229116a949c389593c2e5f4c7c3858d54c307723edf0980e26a
 package-id zlib-0.6.2.1-51eb00754354cdc4220fcebf194ee393f922486aef2f669256e561444d19f779
 package-id typed-process-0.2.6.0-6488f19593cdba4aa375c251c06a1994626121e329caf8be2f5847fb0c0e8972
 package-id http-client-0.6.4-37ee7397a67eea7a6a0341bd2a1bff04342360efb74dde0ffff7c15c9e2a2b00
 package-id case-insensitive-1.2.1.0-c9f7a67fe14ace09ee0fbf304e8c02bbf7da87b21c4b6844191f3893cdc3aeb5
 package-id cookie-0.4.5-fa94fd53b8eb97cabeec74062a05afef0653edc57e6131f4c1a88222920feb4d
 package-id http-types-0.12.3-797a7967e15de068627e7379f7a9737e1d663e49e7228926d04ff1eac91f4c03
 package-id mime-types-0.1.0.9-b770335e4f52450b3871359a6d7f204730eb749b10b0e046ac8dbb1e8ec4b9cd
 package-id network-uri-2.6.1.0-cd11fe27cd8ea544bf9396b809b6cb55b85c023b26a6f5a2dc13a2476ec61eb3
 package-id parsec-3.1.14.0-8f68ee29e81364cfc6d09b124bbd3c73014e7f0a99bb73a6479f939c3594bdd4
 package-id http-client-tls-0.3.5.3-d159cd86681c88d58688acf1a6081673a98f6d58f00ec30cde9cd3c6093f266f
 package-id connection-0.3.1-a82fc9f545e3992b96a8858462ab9c0ee3144572e7eb7d4b89cf6c6e4ee57e24
 package-id socks-0.6.1-74df46af60676e9c0e1bd3bdcb531f7d8d9a189fecc5fef25779f002bac70ea5
 package-id cereal-0.5.8.1-baec3a1fd3cd9d21ad6a81006b3f74d82c1b91008386877a2a9d03e8f026e450
 package-id tls-1.5.2-304b758c2af9520ef0d91bb9025b69e84b93e757314de2697ef84c4c077fff41
 package-id asn1-encoding-0.9.6-b6a6d999252fa73e93129cdc1d073fa7abbe06034cbf21a231356f3c2bb6a920
 package-id asn1-types-0.3.3-595756d7e0f1ff750c588717c3f5e00224d242cc55c71508cc13bc2387b6df99
 package-id hourglass-0.2.12-5c068289284b36d035a50c8e63f0277f63c9d4ded3cab76c0f3e45d83b3ae5ba
 package-id x509-1.7.5-b7e9dc74c2fad4bec063ce6bc5aa3b1f6704464870a606d6027ec8ba0ff35cb0
 package-id asn1-parse-0.9.5-6cd37e26020abc77a580a179d3d8ae2f33c115c548d724b765cd255f518301d8
 package-id pem-0.2.4-ea1f6bc60dd5f8f41d717f0ed3a7fdf01051a2d0e9bdf13be779b14d01ac3569
 package-id x509-store-1.6.7-03c53b8fc24e44019990192a121e87bd5ef2a173625c20d50cd57f4b8aae48c5
 package-id x509-validation-1.6.11-c35e811001935e94fc17b7a354bd4529d87692be7efa124a9accaaebc0ebd06a
 package-id x509-system-1.6.6-97a138d2ca033432f14ae2af39268c0bc7d6edcfc8a04fb9c53d9032ed752d16
 package-id lrucache-1.2.0.1-b7251a2ba8357e17eabe0820f889d3eaf17ae4d3b8b197629b037080cf16a444
 package-id contravariant-1.5.2-53e1daf216d7b2698eeb082a7c178c93ca891317544afabdda915ce3075a033f
 package-id StateVar-1.2-5ba894e6b82d78728f0af00098e4727e22628c5818c0bf43bd2a7cc73377062a
 package-id optparse-applicative-0.14.3.0-180b99805f5801f615fb595777a133886c2b7d0cbf1a8ee8388c6297b53f7098
 package-id regex-tdfa-1.2.3.2-d55f80f8fb2ac9011511fd2974e22be139170f2550b917d329a3ab5ef27f1cf6
 package-id regex-base-0.93.2-8062a6c89bd9abe11f6a96e9ff6d8214995b200da645182af4cbe38d934236a8
 package-id tagsoup-0.14.8-9a1e7ee931023af787b9170cd754266ed7f2ad1af84d6c6b278ec711bf69867c
 package-id time-locale-compat-0.1.1.5-f37a5aac942a41e6780a8abb1517c53c2cc304468c13573920ef621ca3ed03af
 package-id wai-3.2.2.1-99ac886a432d8948478fb079a3e85bb291b6958393ce75bd3520a7571e637bd7
 package-id vault-0.3.1.3-81696e579d6da82a6f8847eacbd9c633dd58a2363008f7ffd64529129bb02806
 package-id wai-app-static-3.1.6.3-8025412fa64868b78b55a48c5205bd56013bb600f3ad6ae52bb28885c23d47e0
 package-id http-date-0.0.8-2cb106bb8c49027aba87ff7809aacff2b8cab0a5590a768c4adfc210bd4b9f26
 package-id wai-extra-3.0.28-de7c772d40f70cb69f52036e833af70ae7b1ca8f146dab2bfb8171a5edc87f51
 package-id base64-bytestring-1.0.0.2-3b54703609d783a48d9dabea878d22eac89870a10e661c7cae20c7db9c322ce0
 package-id http2-1.6.5-d4a4291d020303291f92701b127d7cc38eb1488b275f1ecfa5a7bc5ca255cca2
 package-id network-byte-order-0.1.2.0-c3ae51950c2e277b2bc1652b725cdd9b31f6660f1d9763954db60da2e271413f
 package-id psqueues-0.2.7.2-5577a6f59f5d42284405da8375083029f6e75a87c80c3bb510ca420710ba46d2
 package-id iproute-1.7.8-d342ad618265ab97fc213238852f1fbcbc958f76d2379d255f5504afb12d4b7b
 package-id appar-0.1.8-ebde66dea8ace87cc510ee94f9cd5d1a11b65f07c09adc06da2d04c76f64205b
 package-id byteorder-1.0.4-215e9424aa02a05de726b3cdb3985d5120bebaca0c6682665d29bc0db363e58d
 package-id void-0.7.3-9fff23e9061d34f7a5d304342fd79c9ca6ce8fa3f847129e5d4cf875096104e2
 package-id wai-logger-2.3.6-80a618632f5db5b26e07358096a228ecb0df7dab5980ee0d90a3d2162b73671c
 package-id word8-0.1.3-f26d845bf10077b8aff56014497707e6a6a3be6edfcb80991f070a34d0b4102a
 package-id warp-3.2.28-aa171d2f0905fcf82b27ba12ddc60fd8bed2981db2c97d0acbfe172a62005f9b
 package-id bsb-http-chunked-0.0.0.4-d479e55c1eb8fc4d0b278100762e8e972554dae7fddc2f402eef29462a95748d
 package-id simple-sendfile-0.2.30-e72d79db6c62874ac3e96c8473321f47ce211ce9943eaa9a64f2173ad67358ec
 package-id time-manager-0.0.0-42786a4cf5691c215a0b12049759e9959361ddb7210afa74e1218844643d7be7
 package-id yaml-0.11.2.0-6eb02c7f5592bb917bf7ad9e2e1fdeb5be3760e9c24b9b8a9977e25dbb5f43ac
 package-id libyaml-0.1.1.1-a5cd6ebdb890df2d848b28accfa5498653e6de75e0d1fa225ec6ac6cb8b4b1bf
 package-id prosidy-1.0.0.0-inplace
 package-id megaparsec-8.0.0-3a27d3b1d0e3238bd96df58a33855bdbb8be116f0014a505b77aac2c36cb7ab4
 package-id parser-combinators-1.2.1-bf907f540f14b6d236685da6a1ffa2e32ac243d10cc4ac15f89c8f38b2520057
 package-id prettyprinter-1.5.1-99a68aa88c01e94ba3018a9f543e5ad8f44993e0220f1880625ed21ad35a5652
 package-id profunctors-5.3-4494fca0ca071fc25fe94c7020c5fdd7c7283a36c48c4b40e1cea27fc0421606
 package-id bifunctors-5.5.6-def9e38b481d106ea2978d245e5f0f4dd0b57fd1b2b02ddf3318d58b01b09004
 package-id comonad-5.0.6-7705edea51f583056f6f1d74a42c731d33fd709bbd32403bba674e5b4cc09f61
 package-id distributive-0.6.1-3ccd8e5f33dada2232778caa2080923ca37bd1ec83257434d5f5361b1d4d9ed6
 package-id lens-4.17.1-bb65352b52862d4bfefbab6ac2ef7d36ba6d5604f5607eda7dfc3cfd4665800e
 package-id call-stack-0.2.0-a3afaa8512cdbb9d372b9e53f68b0742a9d9654a0df7ec6fefcb0396efe90440
 package-id free-5.1.3-129fcb7250a4bf05b1e19d6fda5e508d5df6a658c7d8366dde716dd65b622dcc
 package-id semigroupoids-5.3.4-45679b787ec342e8df4787892e1277bce05c3a611bf59bfe61f8cf14e4d380cb
 package-id kan-extensions-5.2-b61e1a6a49b58f166621b4857fee39a36f90b780b064c2c425c3e5ac380b9547
 package-id adjunctions-4.4-9c8816fef394b0490157bc7300e64699712495e5e0b476af01a850d3dbbe8655
 package-id invariant-0.5.3-fac715cfc7e11054d8ec1f01f2e67bc8678c3dd0dcc1ff286d2cd605909da8a6
 package-id parallel-3.2.2.0-d352a01b5245a9ca01a5b46d5ed949f8f3597de47897be96541495d67b5e5e67
 package-id reflection-2.1.5-7d6092ba397f57d8367c6a8a956f769db842ca9b4805e785c824a8515f998e9f
 package-id generic-lens-1.1.0.0-808f2d31e353e4ff02212928c60caf2c6a3b633656a8979b434e6674bafe0bd4
 package-id mmorph-1.1.3-981978dcfca8bd7aa72b62f4b8af45366c2f13899196d86b2773c2534f925407
 package-id prosidyc-0.1.0.0-inplace
--- a/.hlint.yaml
+++ b/.hlint.yaml
@ -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 <$>'}
--- a/src/poetic/Main.hs
+++ b/src/poetic/Main.hs
@ -4,13 +4,14 @@
 {-# LANGUAGE RecordWildCards #-}
 module Main where

 import           Prosidy hiding (NonEmpty, nonEmpty)
 import           Prosidy
 import Data.List.NonEmpty (NonEmpty, nonEmpty)
 import           Control.Lens
 import qualified Data.Text.IO                  as Text.IO
 import qualified Options.Applicative as A
 import qualified Options.Applicative.Builder as AB
 import qualified System.IO as IO
 import Data.Foldable (for_)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Control.Applicative (Alternative(..), optional)
@ -20,13 +21,18 @@ main :: IO ()
 main = do
    options  <- getOptions
    document <- readDocument $ inputPath options
    let lines = document ^.. allBlocks . _BlockLiteral 
                           . filtered (optionsFilter options) 
                           . content . _Literal
    Text.IO.writeFile (outputPath options) . Text.unlines $
        optionsPrefix options lines
    let lits = document ^.. allBlocks . _BlockLiteral . spanning
                           . filtered (optionsFilter options)
                           . spannedContent
    IO.withFile (outputPath options) IO.WriteMode $ \hdl ->
        for_ lits $ \lit -> do
            for_ (sourceLabelFor options lit) $ \label ->
                Text.IO.hPutStrLn hdl label
            Text.IO.hPutStrLn hdl $ lit ^. spanning . _Literal
  where
      allBlocks = cosmosOnOf (content . folded) (_BlockTag . content . folded)
      allBlocks = cosmosOnOf 
            (content . folded) 
            (_BlockTag . spanning . content . folded)

 data Options = Options
   { sourceLabel :: Maybe Text
@ -76,13 +82,17 @@ getOptions = A.execParser $ A.info parse info
    readKey :: A.ReadM Key
    readKey = A.maybeReader (toKey . Text.pack)

 optionsPrefix :: Options -> [Text] -> [Text]
 optionsPrefix Options{sourceLabel} =
  case sourceLabel of
    Nothing ->
        id
    Just lbl ->
        (:) (mconcat ["#line 1 \"", lbl, "\""])
 sourceLabelFor :: Options -> Spanned Literal -> Maybe Text
 sourceLabelFor Options{sourceLabel} lit = do
    label <- sourceLabel
    aSpan <- view spanOfMaybe lit
    let lineNumber = spanDetail aSpan ^. spanDetailBegin . positionLine . _Line
    pure $ mconcat 
        [ "{-# LINE "
        , Text.pack . show $ succ lineNumber
        , " \""
        , label
        , "\" #-}"]

 optionsFilter :: Options -> LiteralTag -> Bool
 optionsFilter Options{tagFilter} =
--- a/src/prosidy-manual/Prosidy/Manual.lhs
+++ b/src/prosidy-manual/Prosidy/Manual.lhs
@ -1,33 +1,20 @@
 ## vi: ft=prosidy wrap
 title: Manual.lhs
 created: 2020-01-01T17:22-8000
 updated: 2020-01-01T17:22-8000

 ---

 #=haskell:
 {-# LANGUAGE ApplicativeDo     #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE RecursiveDo       #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE TypeFamilies      #-}
 #:

 #=haskell[hide]:
 module Prosidy.Manual
    ( compileDocument
    , compileToc
    , ManualError(..)
    ) where
 #:

 #=haskell:
 import Prosidy
 import Prosidy.Compile
 import Prosidy.Manual.Monad
 import Prosidy.Manual.TableOfContents

 import Data.Tuple (swap)
 import Data.Functor (($>))
 import Data.Bifunctor      (Bifunctor(..))
 import Data.Text           (Text)
@ -42,86 +29,61 @@ import Control.Lens.Operators
 import Data.Traversable (sequenceA)
 import System.FilePath((-<.>))
 import Data.Maybe (fromMaybe)
 import Data.Text.Encoding (encodeUtf8)

 import qualified Hakyll as Ha (Item, Identifier, toFilePath, itemIdentifier, itemBody)

 import qualified Control.Lens                as L
 import qualified Data.Text                   as Text
 import qualified Data.ByteString             as BS
 import qualified Data.Char                   as Char
 import qualified Text.Blaze.Html5            as H
 import qualified Text.Blaze.Html5.Attributes as A
 #:

 #=haskell:
 type Html input = RuleT input Manual H.Html
 #:

 Our rules for parsing are all contained inside of the #lit{document} rule. Prosidy requires that a rule must be registered before it can be used to prevent some issues with non-termination.

 Because rules are mutually recursive, we have to use #lit{MonadFix} for this to work! #lit{RecursiveDo} is a wonderful extension that provides from syntactic sugar for this.

 #=haskell:
 document :: FilePath -> [Ha.Item TocItem] -> Html Document
 document currentPath toc = mdo
 #:

 Let's start with the non-recursive rules.

 For text nodes, we should just convert their content directly into HTML. The #lit{self} descriptor returns the focus of a rule directly.

 #=haskell:
    plainText <- rule @Text @Manual @H.Html "plain text" $
       fmap H.text self
 #:

 Prosidy inserts empty markers called #def{breaks} between lines in a paragraph and before or after an inline tag (if it has a space on that side). Because #i{CJKV} languages don't really care about spacing, we don't assume the user wants a space in these situations.

 The Prosidy manual, however, is in English, which #i{does} want spaces in these locations. When we encounter a break, we should render a single space.

 #=haskell:
    break <- rule "break" $
        pure $ H.text " "
 #:

 #=haskell:
    plainTextText <- rule "plain text (as text)" $ self
    plainText     <- rule "plain text" $ fmap H.text self
    breakText <- rule "break (text)" $ pure (" " :: Text)
    break     <- rule "break" $ pure $ H.text " "
    block <- choose "block context"
        [ _BlockParagraph @? paragraph
        , _BlockTag @? blockTag
        [ _BlockParagraph . spanning @? paragraph
        , _BlockTag . spanning @? blockTag
        ]

    inline <- choose "inline context"
        [ _Break @? break
        , _InlineTag @? inlineTag
        , _InlineText @? plainText
        , _InlineTag . spanning @? inlineTag
        , _InlineText . spanning @? plainText
        ]

    onlyText <- choose "inline context (only text)"
        [ _Break @? breakText
        , _InlineText . spanning  @? plainTextText
        ]
 #:

 #=haskell:
    paragraph <- rule "paragraph" $ do
        body <- descend inline $ _Paragraph . L.folded
        pure $ H.p body
 #:

 #=haskell:
    blockTag <- choose "block tag"
        [ _Tagged "section" @? section
        , _Tagged "note" @? note
        , _Tagged "list" @? list
        ]

    inlineTag <- choose "inline tag"
        [ _Tagged "b" @? bold
        , _Tagged "i" @? italics
        , _Tagged "chars" @? chars
        , _Tagged "lit" @? inlineLiteral
        , _Tagged "def" @? definition
        , _Tagged "ref" @? reference
        , _Tagged "term" @? reference
        , _Tagged "link" @? link
        ]
 #:

 With that out of the way, lets start defining custom elements for the manual.

 #-section[title='Custom Markup']:

 #=haskell:
    bold <- rule "boldface" $ do
        body <- descend inline $ content . L.folded
        pure $ H.strong body
@ -129,15 +91,47 @@ With that out of the way, lets start defining custom elements for the manual.
    italics <- rule "italics" $ do
        body <- descend inline $ content . L.folded
        pure $ H.em body
 #:

 #=haskell:
    inlineLiteral <- rule "inline literal" $ do
        body <- descend inline $ content . L.folded
        pure $ H.code body
 #:

 #=haskell:
    listItemBody <- rule "list item body" $ do
        body <- descend block $ content . L.folded
        pure $ H.li body

    listItem <- choose "list item" 
        [ _BlockTag . spanning . _Tagged "item" @? listItemBody
        ]

    list <- rule "list" $ do
        body <- descend listItem $ content . L.folded
        pure $ H.ul body

    chars <- rule "chars" $ do
        noEscape <- prop "no-escape" "Do not escape the `rep` setting."
        rep      <- reqText "rep" "The literal representation of the inner text."
        text     <- descend onlyText $ content . L.folded
        pure $ do
            let pickHex  = (!!) "0123456789ABCDEF" . fromIntegral
                toHex 0 acc = acc
                toHex n acc = uncurry toHex
                    . second ((: acc) . pickHex)
                    $ n `quotRem` 16
            H.span ! A.class_ "char-sequence" $ do
                H.text text
                " ("
                H.code ! A.class_ "char-sequence-literal" $
                    foldMap (H.span . H.toHtml) $ 
                        if noEscape 
                        then Text.unpack rep
                        else foldMap Char.showLitChar (Text.unpack rep) ""
                "; "
                H.code ! A.class_ "char-sequence-utf-8" $ do
                    for_ (Text.unpack rep) $ \ch -> H.span $
                        H.toHtml . foldr toHex [] . BS.unpack . encodeUtf8 $ 
                            Text.singleton ch
                ")"
    note <- rule "note" $ do
      level <- req readNote "level"
        "The level of the note. Can be 'caution', 'note', or 'wip'"
@ -149,9 +143,7 @@ With that out of the way, lets start defining custom elements for the manual.
              WIP     -> "wip"
        H.aside ! A.class_ levelHtml $ do
          body
 #:

 #=haskell:
    link <- rule "link" $ do
      url <- reqText "url" "The URL to link to."
      external <- prop "external" "If provided, open links in a new window."
@ -160,19 +152,25 @@ With that out of the way, lets start defining custom elements for the manual.
        H.a ! A.href (H.toValue url)
            ! (if external then A.target "blank" else mempty)
            $ body
 #:

 #=haskell:
    definition <- rule "term definition" $ do
        body <- descend inline $ content . L.folded
        pure $ H.dfn body
        body <- descend onlyText $ content . L.folded
        lemma <- optText "lemma" 
            "The optional, canonical form of a definition\
            \ used when the term being defined is declined to fit the sentence."
        pure $ do
            let id = H.toValue . ("term-" <>) . toSlug $ fromMaybe body lemma
            H.dfn (H.text body) ! A.id id

    reference <- rule "term reference" $ do
        body <- descend inline $ content . L.folded
        pure $ H.a body
 #:
        body <- descend onlyText $ content . L.folded
        lemma <- optText "lemma" 
            "The optional, canonical form of a definition\
            \ used when the term being defined is declined to fit the sentence."
        pure $ do
            let id = H.toValue . ("term-" <>) . toSlug $ fromMaybe body lemma
            H.a (H.text body) ! A.href ("#" <> id) ! A.class_ "term-reference"

 #=haskell:
    section <- rule "section" $ do
        sTitle <- reqText "title" "The title of the section."
        sSlug  <- optText "slug" "The anchor tag associated with the section.\
@ -191,13 +189,6 @@ With that out of the way, lets start defining custom elements for the manual.
            H.section ! A.id (H.toValue slug) $ do
                H.h1 title
                body
 #:

 #:

 Finally, we wrap up all of the rules we previously defined into a final rule which processes the whole #lit{Document}:

 #=haskell:
    rule "manual page" $ do
        title <- reqText "title" "The manual page's title."
        subtitle <- optText "subtitle" "The manual page's subtitle."
@ -238,9 +229,6 @@ Finally, we wrap up all of the rules we previously defined into a final rule whi
                          "Copyright ©2020 to Prosidy.org. Available under the "
                          H.a "MPL v2.0" ! A.href "https://www.mozilla.org/en-US/MPL/2.0/"
                          " license."
 #:

 #=haskell:
 data NoteLevel = Caution | Note | WIP
  deriving Show

@ -253,9 +241,6 @@ readNote unknown   = Left $ mconcat
  , show unknown
  , ". Expected 'caution', 'note', or 'wip'"
  ]
 #:

 #=haskell:
 compileToc :: FilePath -> [Ha.Item TocItem] -> H.Html
 compileToc currentPath = H.ol . foldMap (compileTocItem $ Just currentPath)

@ -273,9 +258,6 @@ compileTocItem currentPath item =
    itemURI                     = itemPath -<.> ".html"
    itemUrl                     = Text.pack itemURI <> "#" <> slug
    isCurrent                   = Just itemPath == currentPath
 #:

 #=haskell:
 compileDocument :: [Ha.Item TocItem] -> Ha.Item Document -> Either ManualError H.Html
 compileDocument toc item =
    runManual (compileM (document currentPath toc) doc) >>= first CompileError
@ -298,4 +280,3 @@ reqText = req Right

 optText :: (HasMetadata input, Monad context) => Key -> Text -> Desc input context (Maybe Text)
 optText = opt Right
 #:
--- a/src/prosidy-manual/Prosidy/Manual/TableOfContents.hs
+++ b/src/prosidy-manual/Prosidy/Manual/TableOfContents.hs
@ -2,7 +2,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Prosidy.Manual.TableOfContents where

 import Prosidy.Types
 import Prosidy
 import Data.Sequence (Seq)

 import Data.Text (Text)
@ -44,7 +44,9 @@ foldToc 0 = const pure
 foldToc depth = content . L.folded . allSections . L.to (toTocItem depth)
  where
    allSections :: L.Fold Block (Region (Seq Block))
    allSections = L.deepOf (_BlockTag . content . L.folded) (_BlockTag . _Tagged "section")
    allSections = L.deepOf 
        (_BlockTag . spanning . content . L.folded) 
        (_BlockTag . spanning . _Tagged "section")

 toTocItem :: Natural -> Region (Seq Block) -> TocItem
 toTocItem depth r = TocItem navTitle slug $ r ^.. foldToc (pred depth)
--- a/src/prosidy-manual/prosidy-manual.cabal
+++ b/src/prosidy-manual/prosidy-manual.cabal
@ -44,4 +44,5 @@ executable prosidy-manual
                       , bytestring
                       , mmorph
                       , binary
                       , bytestring

--- a/src/prosidy-markup/Main.hs
+++ b/src/prosidy-markup/Main.hs
@ -1,7 +1,7 @@
 {-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE StrictData #-}
 module Main
@ -12,6 +12,8 @@ where
 import           Prosidy
 import           Prosidy.Compile

 import Data.Maybe (fromMaybe)
 import Data.Functor.Identity (Identity)
 import           Options.Applicative
 import           Data.Text                      ( Text )
 import           Control.Exception              ( throwIO
@ -24,8 +26,10 @@ import qualified Text.Blaze.Internal           as Blaze

 import qualified System.IO                     as IO
 import qualified Data.Text.IO                  as Text.IO
 import Data.Foldable (for_)

 import qualified Control.Lens                  as L
 import Control.Lens.Operators
 import qualified Text.Blaze.Html5              as H
 import qualified Text.Blaze.Html5.Attributes   as A

@ -34,91 +38,38 @@ main = do
    opts@Opts {..} <- getOpts
    input <- withFile' IO.stdin inputFile IO.ReadMode Text.IO.hGetContents
    document <- either throwIO pure
        $ parseDocument (maybe "<stdin>" id inputFile) input
    html <- either (fail . show) (pure . toStrict . renderHtml)
        $ compile (compiler standalone breakUsing) document
    withFile' IO.stdout outputFile IO.WriteMode (`Text.IO.hPutStrLn` html)
        $ parseDocument (fromMaybe "<stdin>" inputFile) input
    case compile (compiler standalone breakUsing) document of
        Left  err  -> fail $ show err
        Right html -> do
            withFile' IO.stdout outputFile IO.WriteMode $ \handle ->
                Text.IO.hPutStrLn handle . toStrict . renderHtml $ html

 withFile'
    :: IO.Handle -> Maybe FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a
 withFile' hdl path mode =
    bracket (maybe (pure hdl) (`IO.openFile` mode) path) IO.hClose

 compiler :: Bool -> Text -> Rule Document H.Html
 compiler standalone space = mdo
    break <- rule "break" $ pure $ H.text space

    text  <- rule "plain text" $ do
        body <- self
        pure $ H.text body

    literalText <- rule "literal text" $ do
        body <- descend text _Literal
        pure $ H.code body

    block <- choose
        "block context"
        [ _BlockTag @? blockTag
        , _BlockLiteral @? codeBlock
        , _BlockParagraph @? paragraph
        ]

    inline <- choose
        "inline context"
        [_Break @? break, _InlineTag @? inlineTag, _InlineText @? text]

    blockTag <- choose
        "block tag"
        [ _Tagged [keyQ|h|] @? heading
        , _Tagged [keyQ|h+|] @? subheading
        , _Tagged [keyQ|h++|] @? subsubheading
        , _Tagged [keyQ|list|] @? list
        , _Tagged [keyQ|section|] @? section
        , _Tagged [keyQ|quote|] @? quote
        , _Tagged [keyQ|image|] @? blockImage
        ]
 compileBlockTag :: Item (Spanned Paragraph) Identity H.Html -> Item Block Identity H.Html -> ProductT (Spanned BlockTag) Identity H.Html
 compileBlockTag paragraph block = do
    textOnly <- blockRule "text only block"
        paragraph
        (disallow "literal tags not allowed in this context")
        (disallow "nested block tags are not allowed in this context")

    finalBlock <- choose "final block tag" [_BlockParagraph @? paragraph]
    heading <- tagRule "h" "first-level heading" $
        H.h2 <$> children textOnly

    inlineTag  <- choose
        "inline tag"
        [ _Tagged [keyQ|b|] @? bold
        , _Tagged [keyQ|i|] @? italic
        , _Tagged [keyQ|image|] @? image
        , _Tagged [keyQ|link|] @? link
        , _Tagged [keyQ|lit|] @? lit
        ]

    codeBlock <- rule "codeBlock" $ do
        body <- descend literalText content
        pure $ H.pre body

    paragraph <- rule "paragraph" $ do
        body <- descend inline (_Paragraph . L.folded)
        pure $ H.p body

    heading <- rule "heading" $ do
        body <- descend finalBlock (content . L.folded)
        pure $ H.h2 body
    subheading <- tagRule "h+" "second-level heading" $ do
        H.h3 <$> children textOnly

    subheading <- rule "subheading" $ do
        body <- descend finalBlock (content . L.folded)
        pure $ H.h3 body

    subsubheading <- rule "subsubheading" $ do
        body <- descend finalBlock (content . L.folded)
        pure $ H.h4 body

    image <- rule "image" $ do
        url   <- req Right [keyQ|url|] "The URL of the image to embed."
        title <- opt Right [keyQ|title|] "The title/alt-text of the image."
        pure $ do
            H.img ! A.src (H.toValue url) ! foldMap (A.title . H.toValue) title
    subsubheading <- tagRule "h++" "third-level heading" $ do
        H.h4 <$> children textOnly

    blockImage <- rule "blockImage" $ do
        url   <- req Right [keyQ|url|] "The URL of the image to embed."
        title <- opt Right [keyQ|title|] "The title/alt-text of the image."
        body  <- descend finalBlock $ content . L.folded
    blockImage <- tagRule "image" "block image with optional caption" $ do
        url   <- req Right "url" "The URL of the image to embed."
        title <- opt Right "title" "The title/alt-text of the image."
        body  <- children textOnly
        pure $ do
            H.figure $ do
                H.img
@ -126,76 +77,124 @@ compiler standalone space = mdo
                    ! foldMap (A.title . H.toValue) title
                H.figcaption body

    bold <- rule "bold" $ do
        body <- descend inline (content . L.folded)
        pure $ H.strong body
    blockQuote <- tagRule "quote" "a blockquote" $ do
        body <- children block
        pure $ H.blockquote body

    italic <- rule "italic" $ do
        body <- descend inline (content . L.folded)
        pure $ H.em body
    list <- compileList block

    link <- rule "link" $ do
        url  <- req Right [keyQ|url|] "The URL to link to."
        body <- descend inline $ content . L.folded
        pure $ H.a body ! A.href (H.toValue url)
    tags "block tags" 
        [ heading
        , subheading
        , subsubheading
        , list
        , blockImage
        , blockQuote
        ]

    lit <- rule "literal" $ do
        body <- descend inline $ content . L.folded
        pure $ H.code body
 compileList :: Item Block Identity H.Html -> SumT (Spanned BlockTag) Identity H.Html
 compileList block = do
    item <- tagRule "item" "A single item within a list." $ do
        content <- children block
        pure $ H.li content

    onlyItems <- tags "inside of a list" [item]

    insideList <- blockRule "inside of a list"
        (disallow "paragraphs are not permitted in this context")
        (disallow "literal blocks are not permitted in this context")
        onlyItems

    tagRule "list" "A listing. All children must be 'item' block tags." $ do
        isOrdered <- prop "ord" "If provided, the list is numerically ordered."
        content   <- children insideList
        pure $ (if isOrdered then H.ol else H.ul) content

 compileInlineTag :: Item Inline Identity H.Html -> ProductT (Spanned InlineTag) Identity H.Html
 compileInlineTag inline = do
    image <- tagRule "image" "images, inline with text" $ do
        url   <- req Right "url"   "The URL of the image to embed."
        title <- opt Right "title" "The title/alt-text of the image."
        pure $ do
            H.img ! A.src (H.toValue url) ! foldMap (A.title . H.toValue) title

    listItem <- choose "list item"
                       [_BlockTag . _Tagged [keyQ|item|] @? listBody]
    bold <- tagRule "b" "bold text" $ do
        H.strong <$> children inline 

    listBody <- rule "list body" $ do
        body <- descend block (content . L.folded)
        pure $ H.li body
    italic <- tagRule "i" "italic text" $ do
        H.em <$> children inline

    list <- rule "list" $ do
        isOrdered <- prop [keyQ|ord|]
                          "If provided, treat the list as a ordered-list."
        body <- descend listItem (content . L.folded)
        pure $ do
            (if isOrdered then H.ol else H.ul) body
    literal <- tagRule "lit" "inline literal text" $ do
        H.code <$> children inline

    quote <- rule "quote" $ do
        body <- descend block (content . L.folded)
        pure $ H.blockquote body
    link <- tagRule "link" "hyperlinks" $ do
        url     <- req Right "url" "The destination URL."
        content <- children inline
        pure $ H.a content ! A.href (H.toValue url)

    section <- rule "section" $ do
        class_ <- opt Right [keyQ|class|] "Optional classes to be attached."
        body   <- descend block (content . L.folded)
        pure $ H.section body ! foldMap (A.class_ . H.toValue) class_

    rule "document" $ do
        title <- req Right
                     [keyQ|title|]
                     "The document's title, used as the header."
        style <- if standalone
            then opt Right
                     [keyQ|style|]
                     "A stylesheet to attach to the document"
            else pure Nothing
        body <- descend block (content . L.folded)
    tags "inline tags"
        [ bold
        , image
        , italic
        , literal
        , link
        ]

 compileLiteralTag :: ProductT (Spanned LiteralTag) Identity H.Html
 compileLiteralTag = do
    literalText <- rule "literal-text" "text inside of a literal tag" $ do
        content <- self
        pure $ H.text (content ^. _Literal)

    code <- tagRule "code" "embedded source code" $ do
        content <- child literalText
        pure $
            H.pre . H.code $ content

    tags "literal tags"
        [ code
        ]

 compiler :: Bool -> Text -> ProductT Document Identity H.Html
 compiler standalone space = mdo
    block <- blockRule "top-level block items"
        paragraph
        literalTag
        blockTag

    inline <- inlineRule "top-level inline items" 
        (pure " ")
        (pure . H.text)
        inlineTag

    paragraph  <- paragraphRule inline (pure . H.p)
    inlineTag  <- compileInlineTag inline
    blockTag   <- compileBlockTag paragraph block
    literalTag <- compileLiteralTag

    documentRule $ do
        content    <- children block
        title      <- req Right "title" "The document's title, used in the header."
        maybeStyle <- if 
          | standalone -> opt Right "style" "A stylesheet to attach to the document."
          | otherwise  -> pure Nothing
        pure $ do
            let titleHtml = H.text title
            if standalone
                then H.html $ do
            if 
              | standalone -> do
                H.html $ do
                    H.head $ do
                        H.title titleHtml
                        foldMap
                            (\s ->
                                H.link
                                    ! A.rel "stylesheet"
                                    ! A.type_ "text/css"
                                    ! A.href (H.toValue s)
                            )
                            style
                        for_ maybeStyle $ \style ->
                            H.link ! A.rel "stylesheet"
                                   ! A.type_ "text/css"
                                   ! A.href (H.toValue style)
                    H.body $ do
                        H.header $ H.h1 titleHtml
                        H.main body
                else do
                    H.h1 titleHtml
                    body
                        H.main content
              | otherwise -> do
                H.h1 titleHtml
                content 

 data Opts = Opts
    { breakUsing :: Text
--- a/src/prosidy-markup/syntax-guide.pro
+++ b/src/prosidy-markup/syntax-guide.pro
@ -2,43 +2,33 @@ title: Syntax Guide
 style: style.css
 ---

 #-section:endsection
 #-h{Headers}

 #=prosidy:
 #=code>n class="p">[lang='prosidy']:
 #-h{This will be rendered as an h2 tag.}
 #-h+{This will be rendered as an h3 tag.}
 #-h++{This will be rendered as an h4 tag.}
 #:

 #-section[class='out']:
 #-h{This will be rendered as an h2 tag.}
 #-h+{This will be rendered as an h3 tag.}
 #-h++{This will be rendered as an h4 tag.}
 #:
 #:endsection

 #-section:endsection
 #-h{Emphasis}

 #=prosidy:
 #=code>n class="p">[lang='prosidy']:
 #i{This text will be italic,} #b{and this text will be bold.}
 You #i{#b{can}} combine them if you like.
 #:

 #-section[class='out']:
 #i{This text will be italic,} #b{and this text will be bold.}
 You #i{#b{can}} combine them if you like.
 #:
 #:endsection

 #-section:endsection
 #-h{Lists}

 #-section:endsubsection
 #-h+{Unordered}

 #=prosidy:end
 #=code>n class="p">[lang='prosidy']:end
 #-list:
  #-item{Item 1}
  #-item:
@ -58,7 +48,6 @@ You #i{#b{can}} combine them if you like.
 #:
 #:end

 #-section[class='out']:
 #-list:
  #-item{Item 1}
  #-item:
@ -76,12 +65,9 @@ You #i{#b{can}} combine them if you like.
    #:
  #:
 #:
 #:
 #:endsubsection

 #-section:endsubsection
 #-h+{Ordered}
 #=prosidy:end
 #=code>n class="p">[lang='prosidy']:end
 #-list[ord]:
  #-item{Item 1}

@ -103,7 +89,6 @@ You #i{#b{can}} combine them if you like.
 #:
 #:end

 #-section[class='out']:
 #-list[ord]:
  #-item{Item 1}

@ -123,13 +108,9 @@ You #i{#b{can}} combine them if you like.
    #:
  #:
 #:
 #:
 #:endsubsection
 #:endsection

 #-section:endsection
 #-h{Images}
 #=prosidy:end
 #=code[lang='prosidy']:end
 These images are inline—
 #image[url='https://placekitten.com/32/32?1'],
 #image[url='https://placekitten.com/32/32?2', title='The "title" key attaches "alt-text"'],
@ -138,54 +119,41 @@ but block images are also supported!
 #-image[url='https://placekitten.com/400/200?3']{And block images support captions!}
 #:end

 #-section[class='out']:
 These images are inline—
 #image[url='https://placekitten.com/32/32?1'],
 #image[url='https://placekitten.com/32/32?2', title='The "title" key attaches "alt-text"'],
 but block images are also supported!

 #-image[url='https://placekitten.com/400/200?3']{And block images support captions!}
 #:
 #:endsection

 #-section:endsection
 #-h{Links}
 #=prosidy:end
 #=code>n class="p">[lang='prosidy']:end
 Here's a link to the #link[url='https://prosidy.org']{Prosidy homepage}.
 #:end

 #-section[class='out']:
 Here's a link to the #link[url='https://prosidy.org']{Prosidy homepage}.
 #:
 #:endsection

 #-section:endsection
 #-h{Blockquotes}
 #=prosidy:end
 #=code>n class="p">[lang='prosidy']:end
 #-quote:
  Everything within a "quote" block is rendered as block quotes.
 #:
 #:end

 #-section[class='out']:
 #-quote:
  Everything within a "quote" block is rendered as block quotes.
 #:
 #:
 #:endsection

 #-section:endsection
 #-h{Code}

 #-section:endsubsection
 #-h+{Code blocks}
 #=prosidy:end
 #=haskell:
 #=code>n class="p">[lang='prosidy']:end
 #=code>n class="p">[>lang='haskell']:
 fibonacci :: [Integer]
 fibonacci = 0 : 1 : zipWith (+) fib (tail fib)
 #:

 #=python:
 #=code>n class="p">[lang='python']:
 def fibonacci(n):
    a = 0
    b = 1
@ -195,13 +163,12 @@ def fibonacci(n):
 #:
 #:end

 #-section[class='out']:
 #=haskell:
 #=code[lang='haskell']:
 fibonacci :: [Integer]
 fibonacci = 0 : 1 : zipWith (+) fib (tail fib)
 #:

 #=python:
 #=code>n class="p">[lang='python']:
 def fibonacci(n):
    a = 0
    b = 1
@ -209,17 +176,10 @@ def fibonacci(n):
      (a, b) = (b, a + b)
    return a
 #:
 #:
 #:endsubsection

 #-section:endsubsection
 #-h+{Inline code}
 #=prosidy:end
 #=code>n class="p">[lang='prosidy']:end
 Some code: #lit{foo} #lit{bar}.
 #:end
 #-section:
 Some code: #lit{foo} #lit{bar}.
 #:
 #:endsubsection
 #:endsection

 Some code: #lit{foo} #lit{bar}.
--- a/src/prosidy/Prosidy.hs
+++ b/src/prosidy/Prosidy.hs
@ -2,5 +2,5 @@ module Prosidy ( module X)
 where

 import           Prosidy.Source                as X
 import           Prosidy.Types                 as X
 import           Prosidy.Types                 as X hiding (NonEmpty, nonEmpty)
 import           Prosidy.Parse                 as X
--- a/src/prosidy/Prosidy/Parse.hs
+++ b/src/prosidy/Prosidy/Parse.hs
@ -162,23 +162,26 @@ block = choice

 blockTag :: P BlockTag
 blockTag = do
    t <- genericTag (void $ string "#-") $ option mempty blockTagContents
    t <- genericTag (void $ string "#-") $ option (Spanned Nothing mempty) blockTagContents
    emptyLines
    pure t

 blockTagContents :: P (Seq Block)
 blockTagContents :: P (Spanned (Seq Block))
 blockTagContents = choice
    [ foldMap (Seq.singleton . BlockParagraph . fmap Paragraph) . sequenceA
        <$> spanned (token tagParagraph)
    , Seq.fromList <$> withBlockDelimiters (emptyLines *> many block)
    [ spanned
          $ foldMap (Seq.singleton . BlockParagraph . fmap Paragraph) . sequenceA
        <$> token tagParagraph
    , spanned
          $ Seq.fromList 
        <$> withBlockDelimiters (emptyLines *> many block)
    ]

 literalTag :: P LiteralTag
 literalTag = genericTag (void $ string "#=") $ do
    close    <- blockTagDelim (void $ optional_ comment *> Megaparsec.newline)
    litLines <- manyTill literalLine $ try (skipSpaces *> close)
    litLines <- spanned . manyTill literalLine $ try (skipSpaces *> close)
    emptyLines
    pure . Literal . Text.Lazy.toStrict $ Text.Lazy.intercalate "\n" litLines
    pure $ Literal . Text.Lazy.toStrict . Text.Lazy.intercalate "\n" <$> litLines

 literalLine :: P Text.Lazy.Text
 literalLine = do
@ -209,9 +212,10 @@ inline = choice
    ]

 inlineTag :: P InlineTag
 inlineTag = genericTag sigil . option mempty $ fmap orEmpty tagParagraph
 inlineTag = genericTag sigil . option (Spanned Nothing mempty) $
    fmap orEmpty tagParagraph
  where
    orEmpty = maybe Seq.empty getNonEmpty
    orEmpty = fmap $ maybe Seq.empty getNonEmpty
    sigil   = try $ do
        void $ char '#'
        void . lookAhead $ satisfy isValidKeyHead
@ -242,19 +246,20 @@ paragraphSpacer = try $ do
    skipSpaces1
    notFollowedBy $ void (string "##") <|> void Megaparsec.newline

 tagParagraph :: P (Maybe (NonEmpty Seq Inline))
 tagParagraph = between start end $ option Nothing paragraphLike
 tagParagraph :: P (Spanned (Maybe (NonEmpty Seq Inline)))
 tagParagraph = between start end . spanned $ 
    option Nothing paragraphLike
  where
    start = char '{' *> skipSpaces *> optional_ endOfLine
    end   = skipSpaces *> char '}'

 -------------------------------------------------------------------------------
 genericTag :: P () -> P a -> P (Tagged (Spanned a))
 genericTag :: P () -> P (Spanned a) -> P (Tagged a)
 genericTag sigilParser bodyParser = do
    sigilParser
    thisName     <- toKeyUnchecked <$> keyLike
    thisMetadata <- meta
    thisContent  <- spanned bodyParser
    thisContent  <- bodyParser
    pure $ Tagged thisName thisMetadata thisContent

 meta :: P Metadata
--- a/src/prosidy/Prosidy/Source.hs
+++ b/src/prosidy/Prosidy/Source.hs
@ -1,5 +1,7 @@
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE GADTSyntax #-}
@ -16,11 +18,14 @@ import Data.Aeson (FromJSON(..), ToJSON(..))
 import Data.Text (Text)
 import Data.Word (Word)
 import Data.Sequence (Seq)
 import GHC.Generics (Generic)
 import Data.Hashable (Hashable)

 -------------------------------------------------------------------------------
 data Source where
    Source :: FilePath -> Text -> Source
  deriving stock (Eq, Show)
  deriving stock (Eq, Show, Generic)
  deriving anyclass (Hashable)

 sourcePath :: Lens' Source FilePath
 sourcePath = lens get set 
@ -39,7 +44,8 @@ sourceText = lens get set
 -------------------------------------------------------------------------------
 data Span where
    Span :: Source -> Offset -> Offset -> Span
  deriving stock (Eq, Show)
  deriving stock (Eq, Show, Generic)
  deriving anyclass (Hashable)

 spanSource :: Lens' Span Source
 spanSource = lens get set
@ -64,15 +70,37 @@ spanEnd = lens get set

 -------------------------------------------------------------------------------
 data SpanDetail where 
    SpanDetail :: Source -> Position -> Position -> Text -> SpanDetail
  deriving (Show, Eq)
    SpanDetail :: Position -> Position -> Text -> SpanDetail
  deriving stock (Eq, Show, Generic)
  deriving anyclass (Hashable)

 spanDetailBegin :: Lens' SpanDetail Position
 spanDetailBegin = lens get set
  where
    get (SpanDetail x _ _) = x
    set (SpanDetail _ y z) x = SpanDetail x y z
 {-# INLINE spanDetailBegin #-}

 spanDetailEnd :: Lens' SpanDetail Position
 spanDetailEnd = lens get set
  where
    get (SpanDetail _ y _) = y
    set (SpanDetail x _ z) y = SpanDetail x y z
 {-# INLINE spanDetailEnd #-}

 spanDetailText :: Lens' SpanDetail Text
 spanDetailText = lens get set
  where
    get (SpanDetail _ _ z) = z
    set (SpanDetail x y _) = SpanDetail x y
 {-# INLINE spanDetailText #-}

 spanDetail :: Span -> SpanDetail
 spanDetail (Span source@(Source _ srcText) (Offset from) (Offset to)) =
    SpanDetail source startPosition endPosition spanned
 spanDetail (Span (Source _ srcText) (Offset from) (Offset to)) =
    SpanDetail startPosition endPosition spanned
  where
    (before, srcText') = Text.splitAt (fromIntegral from) srcText
    (spanned, _)      = Text.splitAt (fromIntegral to) srcText'
    (spanned, _after)  = Text.splitAt (fromIntegral to) srcText'
    startPosition      = advancePosition (Position (Line 0) (Column 0)) before
    endPosition        = advancePosition startPosition spanned

@ -87,7 +115,15 @@ advancePosition p = fst . foldl' (uncurry go) (p, '\0') . Text.unpack
 -------------------------------------------------------------------------------
 data Spanned a where
    Spanned :: Maybe Span -> a -> Spanned a
  deriving stock (Eq, Show, Functor, Foldable, Traversable)
  deriving stock (Eq, Functor, Foldable, Traversable, Generic)
  deriving anyclass (Hashable)

 instance Show a => Show (Spanned a) where
  show (Spanned Nothing x) = "Unspanned " <> show x
  show (Spanned (Just s) x) =
      "Spanned " <> (show from) <> (show to) <> (show txt) <> (show x)
    where
      SpanDetail from to txt = spanDetail s

 instance FromJSON a => FromJSON (Spanned a) where
    parseJSON = fmap (Spanned Nothing) . parseJSON
@ -122,27 +158,43 @@ type SpannedSeq a = Spanned (Seq (Spanned a))
 -------------------------------------------------------------------------------
 data Position where
    Position :: Line -> Column -> Position
  deriving (Show, Eq)
  deriving stock (Eq, Show, Generic)
  deriving anyclass (Hashable)

 positionLine :: Lens' Position Line
 positionLine = lens get set
  where
    get (Position l _) = l
    set (Position _ c) = flip Position c

 positionColumn :: Lens' Position Column
 positionColumn = lens get set
  where
    get (Position _ c) = c
    set (Position l _) = Position l

 newtype Line = Line Word
  deriving stock (Eq, Show)
  deriving stock (Eq, Show, Generic)
  deriving newtype (ToJSON, FromJSON)
  deriving anyclass (Hashable)

 _Line :: Iso' Line Word
 _Line = iso (\(Line n) -> n) Line
 {-# INLINE _Line #-}

 newtype Column = Column Word
  deriving stock (Eq, Show)
  deriving stock (Eq, Show, Generic)
  deriving newtype (ToJSON, FromJSON)
  deriving anyclass (Hashable)

 _Column :: Iso' Column Word
 _Column = iso (\(Column n) -> n) Column
 {-# INLINE _Column #-}

 newtype Offset = Offset Word
  deriving stock (Eq, Show)
  deriving stock (Eq, Show, Generic)
  deriving newtype (ToJSON, FromJSON)
  deriving anyclass (Hashable)

 _Offset :: Iso' Offset Word
 _Offset = iso (\(Offset n) -> n) Offset
--- a/src/prosidy/Prosidy/Types.hs
+++ b/src/prosidy/Prosidy/Types.hs
@ -97,9 +97,9 @@ instance Serde Block where
        , noMatch "Expected a LiteralTag, BlockTag, or Paragraph"
        ]

 type BlockTag = Tagged (Spanned (Seq Block))
 type BlockTag = Tagged (Seq Block)

 type LiteralTag = Tagged (Spanned Literal)
 type LiteralTag = Tagged Literal

 _BlockLiteral :: Prism' Block (Spanned LiteralTag)
 _BlockLiteral = prism BlockLiteral $ \case
@ -128,15 +128,15 @@ data Document where
 instance Serde Document where
    serde = Document
        <$> field "metadata" metadata
        <*> field "content"  content
        <*> field "content"  spannedContent

 instance HasContent Document where
    type Content Document = Spanned (Seq Block)
    content = lens get set
    type Content Document = Seq Block
    spannedContent = lens get set
      where
        get (Document _ c) = c
        set (Document m _) = Document m
    {-# INLINE content #-}
    {-# INLINE spannedContent #-}

 instance HasMetadata Document where
    metadata = lens get set
@ -145,7 +145,7 @@ instance HasMetadata Document where
        set (Document _ c) m = Document m c
    {-# INLINE metadata #-}

 _Document :: Iso' Document (Region (Spanned (Seq Block)))
 _Document :: Iso' Document (Region (Seq Block))
 _Document = iso (\(Document m c) -> Region m c) (\(Region m c) -> Document m c)

 -------------------------------------------------------------------------------
@ -164,7 +164,7 @@ instance Serde Inline where
        , noMatch "Expected an Break, InlineTag, or Inline Text"
        ]

 type InlineTag = Tagged (Spanned (Seq Inline))
 type InlineTag = Tagged (Seq Inline)

 _Break :: Prism' Inline ()
 _Break = prism (const Break) $ \case
@ -289,17 +289,17 @@ _Paragraph = iso (\(Paragraph xs) -> xs) Paragraph

 -------------------------------------------------------------------------------
 data Tagged content where
    Tagged :: Key -> Metadata -> content -> Tagged content
    Tagged :: Key -> Metadata -> Spanned content -> Tagged content
  deriving stock (Eq, Foldable, Functor, Show, Traversable)
  deriving (FromJSON, ToJSON) via (JSON (Tagged content))

 instance HasContent (Tagged content) where
    type Content (Tagged content) = content
    content = lens get set
    spannedContent = lens get set
      where
        get (Tagged _ _ c) = c
        set (Tagged k m _) = Tagged k m
    {-# INLINE content #-}
    {-# INLINE spannedContent #-}

 instance HasMetadata (Tagged c) where
    metadata = lens get set
@ -312,7 +312,7 @@ instance (Typeable c, ToJSON c, FromJSON c) => Serde (Tagged c) where
    serde = Tagged
        <$> field "name" tag
        <*> field "metadata" metadata
        <*> field "content" content
        <*> field "content" spannedContent

 tag :: Lens' (Tagged c) Key
 tag = lens get set
@ -330,17 +330,17 @@ _Tagged key = prism (addTag key) $ \case

 -------------------------------------------------------------------------------
 data Region content where
    Region :: Metadata -> content -> Region content
    Region :: Metadata -> Spanned content -> Region content
  deriving stock (Eq, Foldable, Functor, Show, Traversable)
  deriving (FromJSON, ToJSON) via (JSON (Region content))

 instance HasContent (Region content) where
    type Content (Region content) = content
    content = lens get set
    spannedContent = lens get set
      where
        get (Region _ c) = c
        set (Region m _) = Region m
    {-# INLINE content #-}
    {-# INLINE spannedContent #-}

 instance HasMetadata (Region c) where
    metadata = lens get set
@ -352,7 +352,7 @@ instance HasMetadata (Region c) where
 instance (Typeable c, ToJSON c, FromJSON c) => Serde (Region c) where
    serde = Region
        <$> field "metadata" metadata
        <*> field "content" content
        <*> field "content" spannedContent

 addTag :: Key -> Region c -> Tagged c
 addTag key (Region m c) = Tagged key m c
@ -360,8 +360,13 @@ addTag key (Region m c) = Tagged key m c
 -------------------------------------------------------------------------------
 class HasContent node where
    type family Content node
    spannedContent :: Lens' node (Spanned (Content node))

    content :: Lens' node (Content node)
    content = spannedContent . spanning

    {-# INLINE content #-}
    {-# MINIMAL spannedContent #-}
 -------------------------------------------------------------------------------
 class HasMetadata node where
    metadata :: Lens' node Metadata
--- a/src/prosidyc/Prosidy/Compile.hs
+++ b/src/prosidyc/Prosidy/Compile.hs
@ -9,35 +9,44 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 module Prosidy.Compile
    ( Compile
    , RuleT
    , Rule
    , ProductT
    , SumT
    , Desc
    , Item
    , Choice
    , Error(..)
    , tags
    , tagRule
    , blockRule
    , inlineRule
    , documentRule
    , paragraphRule
    , rule
    , access
    , staticOnly
    , compileM
    , compile
    , rule
    , choose
    , self
    , prop
    , req
    , opt
    , descend
    , child
    , children
    , embed
    , (@?)
    )
 where
    , disallow
    ) where

 import qualified Prosidy.Compile.Internal.Eval as Eval
 import qualified Prosidy.Compile.Internal.Spec as Spec
 import qualified Prosidy.Compile.Internal.Util as Util
 import qualified Control.Lens                  as L
 import Control.Lens.Operators

 import Data.Sequence (Seq)
 import           Prosidy.Compile.Internal.Spec  ( ItemKey(..) )
 import           Prosidy.Compile.Internal.Error ( Errors
                                                , Result(..)
@ -45,12 +54,33 @@ import           Prosidy.Compile.Internal.Error ( Errors
                                                , resultError
                                                , liftResult
                                                , eachError
                                                , mapErrors
                                                , raiseError
                                                )

 import           Prosidy.Types                  ( Key
                                                , HasMetadata
                                                )

                                                , Tagged
                                                , Region
                                                , Paragraph
                                                , Literal
                                                , LiteralTag
                                                , BlockTag
                                                , InlineTag
                                                , Block
                                                , Inline
                                                , _BlockTag
                                                , _BlockLiteral
                                                , _InlineTag
                                                , _BlockParagraph
                                                , _InlineText
                                                , _Literal
                                                , _Break