diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,10 +4,63 @@ ## [Unreleased] +## [1.0.0] + +This is a milestone release! Version 1.0.0. Several breaking changes, but if you +read through the changes below, you should find updating your code to be pretty +easy. Please email me if you are having problems! + +### Added +- Added GHC 8.4 and 8.6 support. +- Added `(<<|)` and `coll` to add collection values into structrues. +- Added `useFilePath`, `escapeXml`, `rename`, `to`, `move` to manipulate loaded `Page`s. +- Added `loadAndRender` convenience method. Supports individual files and + directories. You'll want to use this one to move over static assets quickly + and easily: `loadAndRender "images/"`. +- Added `toTextRss` and `rfc822DateFormat` to render content ready for an RSS + template. See the Blog example for details. + +### Changed +- All of the `Pencil.Blog` functions are now re-exported in `Pencil`. So you + only need to `import Pencil` now. +- `load` now automatically figures out the desired final FilePath, so it + doesn't take a `(FilePath -> FilePath)` as the first argument anymore. You + can change your code from `load toHtml "foo.markdown"` to `load + "foo.markdown"`, for the most part. Use `load'` to manually specify the + FilePath transform. See examples in the Hackage docs for `load'`, `to`, + `move` and `rename`. +- `loadResources`, like `load`, no longers takes a file path transformer. Use + `to`, `move` or `rename` to change the file path. But really, you probably can + use `loadDir` or `loadDir'` or `loadAndRender` instead of `loadResources.` +- Renamed `structure` to `struct`. It's shorter. +- `passthrough` now works with directories too. +- `insertPages` return type changed from `Env` to `PencilApp Env`. We now + evaluate the given pages (e.g. replace variables) before inserting into + env. So you'll need to change from `let env' = insertPages "posts" posts env` + to `env <- insertPages "posts" posts env`. +- Renamed `updateEnvVal` to `adjust`. +- Renamed `insertEnv` to `insert`. +- Renamed `injectTagsEnv` to `injectTags`. +- Renamed `arrayContainsString` to `arrayContainsText`. +- Changed how structures work internally to allow collection values into structures. +- Examples now match the tutorials. This is the start of merging the tutorials into the pencil + repo itself, instead of living somewhere else. +- Two new errors: `CollectionNotLastInStructure` and + `CollectionFirstInStructure` to handle collection positions in structures. + +### Fixed +- Specify example test files in the pencil.cabal file, so that pencil tests run properly. + +### Removed +- `renderCss`. Use `loadAndRender` instead. As in: `loadAndRender "style.scss"` +- Removed `VarNotInEnv` error type, since Pencil no longer throws that. + ## [0.1.3] ### Changed - Updated dependencies. Should be able to use with recent versions of Stack LTS releases and Nix channels. +- Pandoc updated to 2.5 from 1.x. Source code renders using `` tags now, so you may have to change your CSS. If you want + CSS to target only `` tags, use `a[href] { ... }`. ## [0.1.2] @@ -42,5 +95,7 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/). [Unreleased]: https://github.com/elben/pencil/compare/v1.0.0...HEAD +[1.0.0]: https://github.com/elben/pencil/compare/v0.1.3...v1.0.0 +[0.1.3]: https://github.com/elben/pencil/compare/v0.1.2...v0.1.3 [0.1.2]: https://github.com/elben/pencil/compare/v0.1.1...v0.1.2 [0.1.1]: https://github.com/elben/pencil/compare/cb14e3610aa18dd3c71279bd56231c6bb23bae7b...v0.1.1 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,9 +2,10 @@ # Pencil -Pencil is a static site generator. Use it to generate your personal website! -Pencil comes pre-loaded with goodies such as blogging, tagging, templating, -and Markdown Sass/Scss support. Flexible enough to extend for your own needs. +Pencil is a static site generator. Use Pencil to build a personal website, a +blog, and more. Pencil comes pre-loaded with goodies such as Markdown and +Sass/Scss support, templating, blogging, and tagging. Designed with the +Haskell beginner in mind, but flexible enough to extend for your own needs. The easiest way to get started is to read the tutorials at [elbenshira.com/pencil](http://elbenshira.com/pencil) and reference the [Haddock @@ -14,35 +15,38 @@ > marble topped tables, the smell of early morning... and luck were all you > needed. — Ernest Hemingway, A Moveable Feast -# Setup +# Examples -First, make sure you have `nix` installed: +Here's an example that shows a personal website with a blog and an RSS feed. +Based off the [this +example](https://github.com/elben/pencil/tree/master/examples/Simple). -```bash -curl https://nixos.org/nix/install | sh -nix-channel --add https://nixos.org/channels/nixos-18.09 nixpkgs -nix-channel --update -``` +```haskell +{-# LANGUAGE OverloadedStrings #-} -# Examples +module Main where -Checkout the [examples provided](https://github.com/elben/pencil/tree/master/examples). To run the [Simple](https://github.com/elben/pencil/tree/master/examples/Simple) example: +import Pencil -``` -nix-shell --attr env -[nix-shell]$ cabal new-run pencil-example-simple -``` +config :: Config +config = + updateEnv (insertText "title" "My Awesome Website") defaultConfig -Open the `examples/Simple/out/` folder to see the rendered web pages. To serve -the web pages (so that relative URLs work), using `python`'s built in web server -is easiest: +website :: PencilApp () +website = do + layout <- load "layout.html" + index <- load "index.markdown" + render (layout <|| index) -``` -cd examples/Simple/out/ -python -m SimpleHTTPServer 8000 + loadAndRender "stylesheet.scss" + +main :: IO () +main = run website config ``` -And go to [localhost:8000](http://localhost:8000). +You can check out other [examples](https://github.com/elben/pencil/tree/master/examples). The [Blog](https://github.com/elben/pencil/tree/master/examples/Blog) is a good one. + +My personal website (http://elbenshira.com) uses Pencil ([source here](https://github.com/elben/elben.github.io)). And so does Pencil's website at [elbenshira.com/pencil](http://elbenshira.com/pencil) ([source here](https://github.com/elben/pencil/tree/master/examples/Docs)). # Development diff --git a/examples/Blog/Main.hs b/examples/Blog/Main.hs deleted file mode 100644 --- a/examples/Blog/Main.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Main where - -import Pencil -import Pencil.Blog -import qualified Data.HashMap.Strict as H -import qualified Data.Text as T - -websiteTitle :: T.Text -websiteTitle = "My Blog" - -config :: Config -config = - (updateEnv (insertText "title" websiteTitle) . - setSourceDir "examples/Blog/site/" . - setOutputDir "examples/Blog/out/") defaultConfig - -website :: PencilApp () -website = do - layout <- load toHtml "layout.html" - - -- Load all our blog posts into `posts`, which is of type [Page] - postLayout <- load toHtml "post-layout.html" - posts <- loadBlogPosts "blog/" - - -- Build tag index pages. This is a map of a Tag (which is just text) - -- to a Page which has the environment stuffed with blog posts that has that - -- tag. - tagPages <- buildTagPages "tag-list.html" posts - - -- Render all our blog posts. So for each post in posts, we: - -- - -- - injectTitle - This generates a `title` variable in our env that has the - -- format of "post title - My Blog" - -- - -- - injectTagsEnv - This injects some environment variables so that our blog - -- post page knows what tags it has (via `tags` variable), AND a reference to - -- the tag index page that we built above (via `this.url`). Look through - -- post-layout.html to see how to use these tag variables. - -- - -- - (layout <|| postLayout <|) - We push the generated post Page into this - -- structure, so that all blog posts share the same postLayout. - -- - -- - render - Finally we render all of our blog posts into files. - -- - render $ fmap ((layout <|| postLayout <|) . injectTagsEnv tagPages . injectTitle websiteTitle) - posts - - -- Build our index page. Insert the blog posts into the env, so that we can - -- render the list of blog posts. `withEnv` tells Pencil to use the modified - -- environment when rendering the index page, since that's the env that has - -- the list of blog posts. - index <- load toHtml "index.html" - env <- asks getEnv - let indexEnv = insertPages "posts" posts env - withEnv indexEnv (render (layout <|| index)) - - -- Render tag list pages. This is so that we can go to /blog/tags/awesome to - -- see all the blog posts tagged with "awesome". - render $ fmap (layout <||) (H.elems tagPages) - -main :: IO () -main = run website config - diff --git a/examples/Blog/site/blog/2018-01-30-code-related-stuff.markdown b/examples/Blog/site/blog/2018-01-30-code-related-stuff.markdown new file mode 100644 --- /dev/null +++ b/examples/Blog/site/blog/2018-01-30-code-related-stuff.markdown @@ -0,0 +1,19 @@ + + +This shows code-related stuff! A cool `variable`. + +```python +import unittest + +class TestSomething(unittest.TestCase): + def test1(self): + self.assert_(True) + +if __name__ == '__main__': + unittest.main() +``` diff --git a/examples/Blog/site/blog/2018-01-31-ramblings.markdown b/examples/Blog/site/blog/2018-01-31-ramblings.markdown new file mode 100644 --- /dev/null +++ b/examples/Blog/site/blog/2018-01-31-ramblings.markdown @@ -0,0 +1,11 @@ + + +Life is like a *cloud*. Clouds are like, just some **cold water in cloud form**. So +life is like cold water in cloud form. + +``` +I am more like me. These em tags should be escaped. +``` diff --git a/examples/Blog/site/blog/2018-02-01-more-ramblings.markdown b/examples/Blog/site/blog/2018-02-01-more-ramblings.markdown new file mode 100644 --- /dev/null +++ b/examples/Blog/site/blog/2018-02-01-more-ramblings.markdown @@ -0,0 +1,8 @@ + + +These ramblings are still a work-in-progress... diff --git a/examples/Blog/site/index.html b/examples/Blog/site/index.html new file mode 100644 --- /dev/null +++ b/examples/Blog/site/index.html @@ -0,0 +1,7 @@ +

My Blog

+ +

This is my blog. Check out my blog posts:

+ +${partial("post-list.html")} + +

RSS Feed

diff --git a/examples/Blog/site/layout.html b/examples/Blog/site/layout.html new file mode 100644 --- /dev/null +++ b/examples/Blog/site/layout.html @@ -0,0 +1,16 @@ + + + + + + ${title} + + + + +
+ ${body} +
+ + + diff --git a/examples/Blog/site/post-bullet.html b/examples/Blog/site/post-bullet.html new file mode 100644 --- /dev/null +++ b/examples/Blog/site/post-bullet.html @@ -0,0 +1,3 @@ +
  • + ${postTitle} - ${date} +
    • diff --git a/examples/Blog/site/post-layout.html b/examples/Blog/site/post-layout.html new file mode 100644 --- /dev/null +++ b/examples/Blog/site/post-layout.html @@ -0,0 +1,13 @@ +
    +

    ${postTitle}

    +
    ${date}
    +
    + ${if(tags)} + Tags: ${for(tags)} ${tag} ${end} + ${end} +
    +
    +
    + ${body} +
    +
    diff --git a/examples/Blog/site/post-list.html b/examples/Blog/site/post-list.html new file mode 100644 --- /dev/null +++ b/examples/Blog/site/post-list.html @@ -0,0 +1,5 @@ + diff --git a/examples/Blog/site/tag-list.html b/examples/Blog/site/tag-list.html new file mode 100644 --- /dev/null +++ b/examples/Blog/site/tag-list.html @@ -0,0 +1,3 @@ +

    Posts tagged with ${tag}

    + +${partial("post-list.html")} diff --git a/examples/Blog/src/Main.hs b/examples/Blog/src/Main.hs new file mode 100644 --- /dev/null +++ b/examples/Blog/src/Main.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Pencil +import qualified Data.HashMap.Strict as H +import qualified Data.Text as T + +websiteTitle :: T.Text +websiteTitle = "My Blog" + +config :: Config +config = + (updateEnv (insertText "title" websiteTitle) . + setSourceDir "examples/Blog/site/" . + setOutputDir "examples/Blog/out/" + ) defaultConfig + +website :: PencilApp () +website = do + loadAndRender "assets/style.scss" + + layout <- load "layout.html" + postLayout <- load "post-layout.html" + + -- Load all our blog posts into `posts`, which is of type [Page] + posts <- loadPosts "blog/" + + -- Build tag index pages. This is a map of a Tag (which is just Text) + -- to a Page which has the environment stuffed with blog posts that has that + -- tag. + tagPages <- buildTagPages "tag-list.html" posts + + -- Render all our blog posts. So for each post in posts, we: + -- + -- - injectTitle - This generates a `title` variable in our env that has the + -- format of "post title - My Blog" + -- + -- - injectTags - This injects some environment variables so that our blog + -- post page knows what tags it has (via `tags` variable), AND a reference to + -- the tag index page that we built above (via `this.url`). Look through + -- post-layout.html to see how to use these tag variables. + -- + -- - (layout <|| postLayout <|) - We push the generated post Page into this + -- Structure, so that all blog posts share the same postLayout. + -- + -- - render - Finally we render all of our blog posts into files. + -- + render $ fmap ((layout <|| postLayout <|) . injectTags tagPages . injectTitle websiteTitle) + posts + + -- Load our index page. + index <- load "index.html" + + -- Build our index page. + -- + -- - coll "posts" posts - Creates a collection of pages inside the Structure. + -- The entire structure has access to these pages, via the "posts" variable. + -- + -- - a <<| c - pushes the collection node c into Structure a. + -- + render (layout <|| index <<| coll "posts" posts) + + -- Render tag list pages. This is so that we can go to /blog/tags/awesome to + -- see all the blog posts tagged with "awesome". + render $ fmap (layout <||) (H.elems tagPages) + + -- Load RSS layout. + rssLayout <- load "rss.xml" + + -- Build RSS feed of the last 10 posts. + -- + -- - `struct` converts the Page into a Struct + -- + -- - `escapeXml` sets the Page to escape the XML/HTML tags in our blog + -- content, since we're going to render this inside the RSS + -- tag. + -- + -- - `coll "posts" ...` creates a collection of pages inside the Structure. + -- See rss.xml file to see how that's used. + -- + let rssFeedStruct = struct rssLayout <<| coll "posts" (fmap escapeXml (take 10 posts)) + + -- Render the RSS feed. We need to render inside a modified environment, where + -- @toTextRss@ is used as the render function, so that dates are rendered in + -- the RFC 822 format, per the RSS specification. + local (setDisplayValue toTextRss) + (render rssFeedStruct) + +main :: IO () +main = run website config + diff --git a/examples/Complex/src/Main.hs b/examples/Complex/src/Main.hs new file mode 100644 --- /dev/null +++ b/examples/Complex/src/Main.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Pencil +import qualified Data.HashMap.Strict as H +import qualified Data.Text as T + +websiteTitle :: T.Text +websiteTitle = "Complex Test" + +config :: Config +config = + (updateEnv (insertText "title" websiteTitle) . + updateEnv (insertText "secret" "My global secret") . + setSourceDir "examples/Complex/site/" . + setOutputDir "examples/Complex/out/" + ) defaultConfig + +website :: PencilApp () +website = do + loadAndRender "assets/style.scss" + loadAndRender "assets/giraffe.jpg" + + -- Should not convert this file. Rendered as assets/examples/example.markdown. + move "assets/examples/" <$> passthrough "assets/example.markdown" >>= render + + -- Static files are passed-through. Convertible files are converted. + loadResources True False "assets/fun/" >>= render + + -- Copy the assets/passthroughs folder to its destination without converting + -- any of the files in there. + move "assets/passthroughs-to/" <$> passthrough "assets/passthroughs/" >>= render + + -- Convertible files are converted, and static assets are passed through. + loadAndRender "assets/conversions/" + + layout <- load "layout.html" + + -- Load all our blog posts into `posts`, which is of type [Page] + postLayout <- load "post-layout.html" + posts <- loadPosts "blog/" + + -- Build tag index pages. This is a map of a Tag (which is just text) + -- to a Page which has the environment stuffed with blog posts that has that + -- tag. + tagPages <- buildTagPages "tag-list.html" posts + + -- Render all our blog posts. So for each post in posts, we: + -- + -- - injectTitle - This generates a `title` variable in our env that has the + -- format of "post title - My Blog" + -- + -- - injectTags - This injects some environment variables so that our blog + -- post page knows what tags it has (via `tags` variable), AND a reference to + -- the tag index page that we built above (via `this.url`). Look through + -- post-layout.html to see how to use these tag variables. + -- + -- - (layout <|| postLayout <|) - We push the generated post Page into this + -- Structure, so that all blog posts share the same postLayout. + -- + -- - render - Finally we render all of our blog posts into files. + -- + render $ fmap ((layout <|| postLayout <|) . injectTags tagPages . injectTitle websiteTitle) + posts + + -- Build our index page. + index <- load "index.html" + render $ layout <|| index <<| coll "posts" posts + + -- Render tag list pages. This is so that we can go to /blog/tags/awesome to + -- see all the blog posts tagged with "awesome". + render $ fmap (layout <||) (H.elems tagPages) + + -- Load RSS layout. + rssLayout <- move "blog/" <$> load "rss.xml" + + -- Build RSS feed of the last 10 posts. + let rssFeedStruct = struct rssLayout <<| coll "posts" (fmap escapeXml (take 10 posts)) + + -- Render the RSS feed. We need to render inside a modified environment, where + -- @toTextRss@ is used as the render function, so that dates are rendered in + -- the RFC 822 format, per the RSS specification. + local (setDisplayValue toTextRss) + (render rssFeedStruct) + + deep1 <- load "deep/deep1.md" + deep2 <- load "deep/deep2.html" + deep3 <- load "deep/deep3.markdown" + deep4a <- load "deep/deep4a.markdown" + deep4b <- load "deep/deep4b.md" + render $ layout <|| deep1 <| deep2 <| move "deep/index.html" deep3 <<| coll "deep4s" [deep4a, deep4b] + + toPage <- to "to/" <$> load "deep/deep1.md" + render $ struct toPage + +main :: IO () +main = run website config + diff --git a/examples/Docs/src/Main.hs b/examples/Docs/src/Main.hs new file mode 100644 --- /dev/null +++ b/examples/Docs/src/Main.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Pencil + +config :: Config +config = + (updateEnv (insertText "title" "Pencil Documentation") . + setSourceDir "examples/Docs/site/" . + setOutputDir "docs/") + defaultConfig + +website :: PencilApp () +website = do + loadAndRender "default.scss" + loadAndRender "tutorials/images/" + loadAndRender "guides/images/" + + layout <- load "layout.html" + + index <- load "index.markdown" + render (layout <|| index) + + tuts <- loadDir False "tutorials/" + renderDir layout tuts + + guides <- loadDir False "guides/" + renderDir layout guides + + where + renderDir layout pages = render $ fmap ((layout <||) . rename toDir) pages + + +main :: IO () +main = run website config diff --git a/examples/Simple/Main.hs b/examples/Simple/Main.hs deleted file mode 100644 --- a/examples/Simple/Main.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Main where - -import Pencil - -config :: Config -config = - (updateEnv (insertText "title" "My Simple Website") . - setSourceDir "examples/Simple/site/" . - setOutputDir "examples/Simple/out/") defaultConfig - -website :: PencilApp () -website = do - layout <- load toHtml "layout.html" - index <- load toHtml "index.markdown" - render (layout <|| index) - - renderCss "style.scss" - -main :: IO () -main = run website config diff --git a/examples/Simple/site/index.markdown b/examples/Simple/site/index.markdown new file mode 100644 --- /dev/null +++ b/examples/Simple/site/index.markdown @@ -0,0 +1,3 @@ +# My Awesome Website + +Welcome to my *awesome* [website](http://example.com)! diff --git a/examples/Simple/site/layout.html b/examples/Simple/site/layout.html new file mode 100644 --- /dev/null +++ b/examples/Simple/site/layout.html @@ -0,0 +1,13 @@ + + + + + ${title} + + + +
    + ${body} +
    + + diff --git a/examples/Simple/site/stylesheet.scss b/examples/Simple/site/stylesheet.scss new file mode 100644 --- /dev/null +++ b/examples/Simple/site/stylesheet.scss @@ -0,0 +1,13 @@ +$bgColor: #ffffff; + +body { + background-color: $bgColor; + font-family: sans-serif; + font-size: 18px; +} + +.structure { + margin-left: auto; + margin-right: auto; + width: 600px; +} diff --git a/examples/Simple/src/Main.hs b/examples/Simple/src/Main.hs new file mode 100644 --- /dev/null +++ b/examples/Simple/src/Main.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Pencil + +config :: Config +config = + (updateEnv (insertText "title" "My Awesome Website") . + setSourceDir "examples/Simple/site/" . + setOutputDir "examples/Simple/out/") + defaultConfig + +website :: PencilApp () +website = do + layout <- load "layout.html" + index <- load "index.markdown" + render (layout <|| index) + + loadAndRender "stylesheet.scss" + +main :: IO () +main = run website config diff --git a/pencil.cabal b/pencil.cabal --- a/pencil.cabal +++ b/pencil.cabal @@ -1,43 +1,66 @@ name: pencil -version: 0.1.3 +version: 1.0.0 synopsis: Static site generator description: - Pencil is a static site generator. Use it to generate your personal website! - Pencil comes pre-loaded blogging, tagging, templating, and Markdown and - Sass/Scss support. Flexible enough to extend for your own needs. + Pencil is a static site generator. Use Pencil to build a personal website, a + blog, and more. Pencil comes pre-loaded with goodies such as Markdown and + Sass/Scss support, templating, blogging, and tagging. Designed with the + Haskell beginner in mind, but flexible enough to extend for your own needs. homepage: https://github.com/elben/pencil license: BSD3 license-file: LICENSE author: Elben Shira -maintainer: elbenshira@gmail.com +maintainer: elben@shira.im copyright: 2018 Elben Shira category: Web build-type: Simple -extra-source-files: README.md, CHANGELOG.md +extra-source-files: README.md + , CHANGELOG.md + + -- List out test example files so that they are included in the `cabal new-sdist` + -- distribution, so that tests can run. + , examples/Simple/site/*.html + , examples/Simple/site/*.scss + , examples/Simple/site/*.markdown + , examples/Blog/site/*.html + , examples/Blog/site/blog/*.markdown + + -- Once cabal 2.4 is enforced, we could just list them out as: + -- , examples/**/*.html + -- , examples/**/*.markdown + -- , examples/**/*.scss cabal-version: >=1.10 tested-with: GHC == 8.0.2, GHC == 8.2.2 + GHC == 8.4 + GHC == 8.6 library hs-source-dirs: src exposed-modules: Pencil + , Pencil.App + , Pencil.App.Internal , Pencil.Blog - , Pencil.Internal.Pencil - , Pencil.Internal.Env - , Pencil.Internal.Parser + , Pencil.Config + , Pencil.Content + , Pencil.Content.Internal + , Pencil.Content.Nodes + , Pencil.Env + , Pencil.Env.Internal + , Pencil.Parser build-depends: base >= 4.8 && < 5 , data-default >= 0.7 && < 1 , directory >= 1.2.5.0 && < 1.4 , edit-distance >= 0.2.2.1 && < 0.3 , filepath >= 1.4 && < 1.5 - , hashable >= 1.2.6.0 && < 1.3 + , hashable >= 1.2.6.0 && <= 1.3 , hsass >= 0.8 && < 1 , mtl >= 2.2 && < 3 , pandoc >= 2.0 && < 3 - , semigroups >= 0.18.2 && < 0.19 , parsec >= 3.1 && < 3.2 + , semigroups >= 0.18.2 && < 0.20 , text >= 1.2.2 && < 1.3 - , time >= 1.5.0.1 && < 1.9 + , time >= 1.5.0.1 && < 2 , unordered-containers >= 0.2.7.2 && < 0.3 , vector >= 0.12.0 && < 0.13 , xml >= 1.3.10 && < 1.4 @@ -50,14 +73,14 @@ main-is: Spec.hs build-depends: base >= 4.8 && < 5 , pencil - , doctest >= 0.16.0.1 && < 1 + , doctest >= 0.16 && < 1 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 test-suite pencil-example-simple type: exitcode-stdio-1.0 hs-source-dirs: examples/Simple - main-is: Main.hs + main-is: src/Main.hs ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: base >= 4.8 && < 5 , pencil @@ -66,11 +89,34 @@ test-suite pencil-example-blog type: exitcode-stdio-1.0 hs-source-dirs: examples/Blog - main-is: Main.hs + main-is: src/Main.hs ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: base >= 4.8 && < 5 , pencil + , text , unordered-containers + , mtl + default-language: Haskell2010 + +test-suite pencil-example-complex + type: exitcode-stdio-1.0 + hs-source-dirs: examples/Complex + main-is: src/Main.hs + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: base >= 4.8 && < 5 + , pencil + , text + , unordered-containers + , mtl + default-language: Haskell2010 + +test-suite pencil-docs + type: exitcode-stdio-1.0 + hs-source-dirs: examples/Docs + main-is: src/Main.hs + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: base >= 4.8 && < 5 + , pencil , text default-language: Haskell2010 diff --git a/src/Pencil.hs b/src/Pencil.hs --- a/src/Pencil.hs +++ b/src/Pencil.hs @@ -1,82 +1,49 @@ +{-| +Main Pencil module. This module re-exports most functions, so you should only need to import this one. +-} module Pencil ( - -- * Getting started - -- - -- $gettingstarted - - -- * Templates - -- - -- $templates + -- * Getting started + -- + -- $gettingstarted - PencilApp - , run + -- * Templates + -- + -- $templates -- * Pages, Structures and Resources -- -- $pagesStructuresResources - - , Page - , getPageEnv, setPageEnv - , load - , withEnv - , renderCss - - , Structure - , (<||) - , (<|) - , structure - - , Resource - , loadResource - , loadResources - , passthrough - , listDir + module Pencil.Content - , Render(..) - , toHtml - , toDir - , toCss - , toExpected + -- * Blogging + -- + -- $blogging + , module Pencil.Blog -- * Environment Manipulation - - , merge - , insertEnv - , insertText - , insertPages - , updateEnvVal - , sortByVar - , filterByVar - , groupByElements + -- + -- $environment + , module Pencil.Env -- * Configuration - , Config - , defaultConfig - , getSourceDir, setSourceDir - , getOutputDir, setOutputDir - , getEnv, setEnv, updateEnv - , getDisplayValue, setDisplayValue - , getSassOptions, setSassOptions - , getPandocReaderOptions, setPandocReaderOptions - , getPandocWriterOptions, setPandocWriterOptions - - -- * Utils and re-exports + , module Pencil.Config - , FileType - , fileType - , toExtension + -- * The Pencil Type + -- | Provides the main Pencil type that everything runs in. + , module Pencil.App - -- Re-exports + -- * Re-exports , Reader.asks - - -- * Error handling - - , PencilException - + , Reader.local ) where -import Pencil.Internal.Pencil +import Pencil.App +import Pencil.Blog +import Pencil.Config +import Pencil.Content +import Pencil.Env import Control.Monad.Reader as Reader @@ -84,198 +51,55 @@ -- $gettingstarted -- --- To get started, let's look at --- --- example, which is a very simple website with only a couple of pages. Browse --- through the --- --- folder to see the source web pages we'll be using. You can run this example --- by following the instructions found in the --- . --- --- First, we have @layout.html@, which will serve as the layout of all our --- pages. Notice that @layout.html@ contains strings that look like @${title}@ --- and @${body}@. These are variable directives that we'll need to fill values --- in for. +-- Pencil helps you build static websites in Haskell. Write your website's +-- content in HTML or Markdown, and use the power of Pencil to compose +-- components together into HTML pages. -- --- @index.markdown@ is a pretty basic Markdown file, and @style.scss@ is a --- file. +-- The best way to get started is to follow the tutorials and guides found at +-- [elbenshira.com/pencil](https://elbenshira.com/pencil). -- --- Now let's look inside @Main.hs@: +-- Here is a simple website of a couple of pages, based off +-- [this](https://github.com/elben/pencil/blob/master/examples/Simple/src/Main.hs) +-- example: -- +-- > module Main where +-- > -- > import Pencil --- > --- > config :: Config --- > config = --- > (updateEnv (insertText "title" "My Simple Website") . --- > setSourceDir "examples/Simple/site/" . --- > setOutputDir "examples/Simple/out/") defaultConfig --- > +-- > -- > website :: PencilApp () -- > website = do --- > layout <- load toHtml "layout.html" --- > index <- load toHtml "index.markdown" +-- > layout <- load "layout.html" +-- > index <- load "index.markdown" -- > render (layout <|| index) --- > --- > renderCss "style.scss" --- > +-- > +-- > loadAndRender "stylesheet.scss" +-- > -- > main :: IO () --- > main = run website config --- --- First, we need to set up a 'Config'. We start with 'defaultConfig', and --- modify it slightly, specifying where the source files live, and where we want --- the output files to go. We also add a @title@ variable with the value @"My --- Simple Website"@ into the environment. --- --- An 'Env', or environment, is just a mapping of variables to its values. A --- variable can hold a string, number, boolean, date, and so forth. Once a --- variable is defined, we can use that variable in our web pages via a --- variable directive like @${title}@. --- --- Let's now look at the @website@ function. Note that its type is @PencilApp --- ()@. 'PencilApp' is the monad transformer that web pages are built under. --- Don't worry if you aren't familiar with monad transformers; in simple terms, --- @PencilApp@ is a function that takes a @Config@, and does all the source file --- loading and web page rendering under the @IO@ monad. So @website@ is a --- function that is waiting for a @Config@. We "give" @website@ a @Config@ with --- this code, which is the @main@ function: --- --- @ --- run website config --- @ --- --- Now let's dissect the @website@ function itself. The first thing we do is --- @'load' toHtml "layout.html"@, which loads our layout file into something --- called a 'Page'. In short, a 'Page' holds the contents of the file, plus the --- environment of that file, plus the final output destination of that file if --- it is rendered. The 'toHtml' function tells 'load' that you want the output --- file to have the @.html@ extension. --- --- It's important to realize that 'toHtml' is not telling 'load' /how/ to load --- @layout.html@; it's telling it what kind of file you want when you spit it --- out. 'load' itself looks at the file extension to figure out that --- @layout.html@ is an HTML file, and @index.markdown@ is a Markdown file. So we --- use 'toHtml' when loading @index.markdown@ because we want the index page to --- be rendered as an @.html@ file. --- --- Now, what about @render (layout <|| index)@. What the heck is going on here? --- In plain language, you can think of @(layout <|| index)@ as injecting the --- contents of @index@ into @layout@. The way this works is that the contents of --- @index@ is rendered (Markdown is converted to HTML, variable directives are --- resolved through the given environment, etc) and then stuffed into a special --- @body@ variable in @layout@'s environment. When @layout@ is rendered, the --- variable directive @${body}@ in @layout@ is replaced with the contents of --- @index@. --- --- @(layout <|| index)@ describes what /will/ happen; it forms a 'Structure'. --- Passing it into 'render' is what actually generates the web page. --- --- Finally, we have @'renderCss' "style.scss"@, which is a helper method to load --- and render CSS files in one step. --- --- And that's it! If you run this code, it will spit out an @index.html@ file --- and a @style.css@ file in the @examples\/Simple\/out\/@ folder. +-- > main = run website defaultConfig -- --- To learn more, read through the documentation found in this module. To build --- a blog, look at the Pencil.Blog module. +-- To learn more, dig into the tutorials and guides found on +-- [elbenshira.com/pencil](elbenshira.com/pencil). ---------------------------------------------------------------------- -- $templates -- -- Pencil comes with a simple templating engine. Templates allow us to build web --- pages dynamically using Haskell code. This allows us to build modular --- components. Templates can be used for things like shared page layouts, --- navigation and blog post templates. --- --- Pencil templates are regular text files that can contain a /preamble/ and --- /directives/. --- --- == Preamble --- --- Preambles are YAML-formatted environment variable declarations inside your --- source files. They should be declared at the top of the file, and you may --- only have one preamble per source file. Example preamble, in the first part --- of @my-blog-post.markdown@: --- --- > --- --- In the above example, Pencil will intelligently parse the @date@ value as a --- `VDateTime`. --- --- == Directives --- --- Directives are rendering /commands/. They are surrounded by @${...}@. --- --- === Variables --- --- The simplest directive is the variable directive. --- --- @ --- Hello ${name}! --- @ --- --- The above template will render the value of the variable @name@, which is --- expected to be in the environment at 'render'. If the variable is not found, --- Pencil will throw an exception with some debugging information. --- --- === If block --- --- The @if@ directive allows us to render content based off the existence of a --- variable in the current environment. --- --- > ${if(name)} --- > Hello ${name}! --- > ${end} --- --- In this case, we now make sure that @name@ is available before rendering. +-- pages dynamically using Haskell code. Blog posts, for example, can share a +-- common HTML template. -- --- === For loop +-- Pencil's templating engine comes with variables, if blocks, for loops, and +-- partials. Read the [templates +-- guide](https://elbenshira.com/pencil/guides/templates/) for a thorough +-- walk-through. -- --- The @for@ directive allows us to loop over array type variable. This is --- useful for things like rendering a list of blog post titles, and URLs to the --- individual blog posts. +-- Example: -- -- >
      -- > ${for(posts)} -- >
    • ${postTitle} - ${date}
      • -- > ${end} -- >
    --- --- Assuming that @posts@ exists in our environment as an array of @Value@, --- this will render each post's title, publish date, and will link it to --- @this.url@. Note that inside the @for@ block, you have access to the current --- environment's variables. This is why we're able to simply request --- @${postTitle}@—it is the current post's @postTitle@ that will be rendered. --- --- @this.url@ is a special variable that is automatically inserted for you --- inside a loaded @Page@. It points to the final file path destination of that --- current @Page@. --- --- === Partials --- --- The @partial@ directive injects another template file into the current file. --- The directives inside the partial are rendered in the same environmental --- context as the @partial@ directive. --- --- Think of partials as just copy-and-pasting snippet from one file to another. --- Unlike 'Structure's, partials cannot define environment variables. --- --- In the example below, the first @partial@ is rendered with the current --- environment. The @partial@ inside the @for@ loop receives the same --- environemnt as any other snippet inside the loop, and thus has access to --- the environment inside each post. --- --- > ${partial("partials/nav-bar.html")} --- > --- > ${for(posts)} --- > ${partial("partials/nav-bar.html")} --- > ${end} ---------------------------------------------------------------------- @@ -283,5 +107,29 @@ -- -- 'Page', 'Structure' and 'Resource' are the "big three" data types you need to -- know to effectively use Pencil. +-- +-- The [Pages and +-- Structures](https://elbenshira.com/pencil/guides/pages-and-structures/) guide +-- introduces these important data types. The documentation found here goes into +-- further detail. + +---------------------------------------------------------------------- + +-- $blogging +-- +-- This module provides out-of-the-box blogging functionality. Read through the +-- [blogging tutorial](http://elbenshira.com/pencil/tutorials/03-blogging/) to +-- learn how to use it. + +---------------------------------------------------------------------- + +-- $environment +-- +-- The environment is where variables live. Composing web pages together +-- implies composing environments. This is where Pencil's power lies: in helping +-- you easily build the proper environment to render your web pages. +-- +-- To get started, read the [environment +-- guide](https://elbenshira.com/pencil/guides/environment/). ---------------------------------------------------------------------- diff --git a/src/Pencil/App.hs b/src/Pencil/App.hs new file mode 100644 --- /dev/null +++ b/src/Pencil/App.hs @@ -0,0 +1,62 @@ + +{-| +Pencil's run and error types. +-} +module Pencil.App + ( PencilApp + , run + ) where + +import Pencil.App.Internal +import Pencil.Content +import Pencil.Config + +import Control.Monad.Except +import Control.Monad.Reader + +import qualified Data.List as L +import qualified Data.Text as T +import qualified Text.EditDistance as EditDistance + +-- | Run the Pencil app. +-- +-- Note that this can throw a fatal exception. +run :: PencilApp a -> Config -> IO () +run app config = do + e <- runExceptT $ runReaderT app config + case e of + Left (FileNotFound (Just fp)) -> do + e2 <- runExceptT $ runReaderT (mostSimilarFiles fp) config + case e2 of + Right closestFiles -> + if not (null closestFiles) + then do + putStrLn ("File " ++ fp ++ " not found. Maybe you meant: ") + printAsList (take 3 closestFiles) + else putStrLn ("File " ++ fp ++ " not found.") + _ -> return () + Left (CollectionNotLastInStructure name) -> + putStrLn ("Collections must be last in a Structure. But the collection named " ++ + T.unpack name ++ " was not the last in the Structure.") + Left (CollectionFirstInStructure name) -> + putStrLn ("Collections cannot be first in a Structure. But the collection named " ++ + T.unpack name ++ " first in the Structure.") + Left (NotTextFile fp) -> + putStrLn ("Tried to load " ++ maybe "UNKNOWNFILE" id fp ++ " as text file, but either it's not a text file or the file is corrupted.") + _ -> return () + + case e of + -- Force program to exit with error state + Left _ -> fail "Exception when running program!" + _ -> return () + +-- | Given a file path, look at all file paths and find the one that seems most +-- similar. +mostSimilarFiles :: FilePath -> PencilApp [FilePath] +mostSimilarFiles fp = do + sitePrefix <- asks getSourceDir + fps <- listDir True "" + let fps' = map (sitePrefix ++) fps -- add site prefix for distance search + let costs = map (\f -> (f, EditDistance.levenshteinDistance EditDistance.defaultEditCosts fp f)) fps' + let sorted = L.sortBy (\(_, d1) (_, d2) -> compare d1 d2) costs + return $ map fst sorted diff --git a/src/Pencil/App/Internal.hs b/src/Pencil/App/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Pencil/App/Internal.hs @@ -0,0 +1,74 @@ +{-| +Internal implementation of Pencil's main functionality. +-} +module Pencil.App.Internal where + +import Pencil.Config + +import Control.Monad.Except +import Control.Monad.Reader (ReaderT(..)) +import Data.Typeable (Typeable) +import GHC.IO.Exception (IOException(ioe_description, ioe_filename, ioe_type), IOErrorType(NoSuchThing)) + +import qualified Data.Text as T + +-- | The primary monad transformer stack for a Pencil application. +-- +-- This unrolls to: +-- +-- > PencilApp a = Config -> IO (Except PencilException a) +-- +-- The @ExceptT@ monad allows us to catch "checked" exceptions; errors that we +-- know how to handle, in PencilException. Note that Unknown "unchecked" +-- exceptions can still go through IO. +-- +type PencilApp = ReaderT Config (ExceptT PencilException IO) + +-- | Known Pencil errors that we know how to either recover from or quit +-- gracefully. +data PencilException + = NotTextFile (Maybe FilePath) + -- ^ Failed to read a file as a text file. + | FileNotFound (Maybe FilePath) + -- ^ File not found. We may or may not know the file we were looking for. + | CollectionNotLastInStructure T.Text + -- ^ The collection in the structure was not the last element in the + -- structure. + | CollectionFirstInStructure T.Text + -- ^ A collection cannot be the first element in the structure (it's useless + -- there, as nothing can reference the pages in the collection). + deriving (Typeable, Show) + +-- | Converts the IOError to a known 'PencilException'. +-- +-- How to test errors: +-- +-- @ +-- import Control.Exception +-- import qualified Data.Text.IO as TIO +-- +-- (\e -> print ('GHC.IO.ioe_description' (e :: IOError)) >> return "") 'Control.Exception.handle' (TIO.readFile "foo") +-- @ +-- +toPencilException :: IOError -> Maybe PencilException +toPencilException e + | isInvalidByteSequence e = Just (NotTextFile (ioe_filename e)) + | isNoSuchFile e = Just (FileNotFound (ioe_filename e)) + | otherwise = Nothing + +-- | Returns true if the IOError is an invalid byte sequence error. This +-- suggests that the file is a binary file. +isInvalidByteSequence :: IOError -> Bool +isInvalidByteSequence e = ioe_description e == "invalid byte sequence" + +-- | Returns true if the IOError is due to missing file. +isNoSuchFile :: IOError -> Bool +isNoSuchFile e = ioe_type e == NoSuchThing + +-- | Print the list of Strings, one line at a time, prefixed with "-". +printAsList :: [String] -> IO () +printAsList [] = return () +printAsList (a:as) = do + putStr "- " + putStrLn a + printAsList as diff --git a/src/Pencil/Blog.hs b/src/Pencil/Blog.hs --- a/src/Pencil/Blog.hs +++ b/src/Pencil/Blog.hs @@ -1,88 +1,96 @@ {-# LANGUAGE OverloadedStrings #-} +{-| +This module provides a standard way of building and generating blog posts. +Check out the Blog example +. You can +also follow the [blogging tutorial +here](https://elbenshira.com/pencil/tutorials/03-blogging/). + +To generate a blog for your website, first create a @blog/@ directory in +your web page source directory. + +Then, name your blog posts in this format: + +> yyyy-mm-dd-title-of-blog-post.markdown + +Where @yyyy-mm-dd@ should be something like @2019-12-30@. This isn't used for +anything other than to keep each post ordered in the directory, for your ease +of viewing. + +Each post is expected to have a preamble that has at least @postTitle@ and +@date@ defined. The date set in the preamble is used as the sort order of the +blog posts. The other variables are optional. + +> + +You can mark a post as a draft via the @draft@ variable, so that it won't be +loaded when you call 'loadPosts'. You can also set the post's tags using, +as seen above in @tags@. Then, use 'loadPosts' to load the entire @blog/@ +directory. + +In the example below, @layout.html@ defines the outer HTML structure (with +global components like navigation), and @blog-post.html@ is a generic blog +post container that renders @${postTitle}@ as a header, @${date}@, and +@${body}@ for the post body. + +@ +layout <- 'load' "layout.html" +postLayout <- 'load' "blog-post.html" +posts <- 'loadPosts' "blog/" +render (fmap (layout <|| postLayout <|) posts) +@ +-} module Pencil.Blog - ( - -- * Getting started - -- - -- $gettingstarted - -- - loadBlogPosts - , blogPostUrl + ( loadPosts + , postUrl , injectTitle - , buildTagPagesWith + + -- * Tags + -- | You can add tags to blog posts. + , Tag , buildTagPages - , injectTagsEnv + , buildTagPagesWith + , injectTags ) where -import Pencil -import Pencil.Internal.Env -import Control.Monad (liftM, foldM) +import Pencil.Config +import Pencil.Env +import Pencil.App +import Pencil.Content +import Control.Monad (foldM) import Control.Monad.Reader (asks) import qualified Data.HashMap.Strict as H import qualified Data.List as L import qualified Data.Text as T import qualified System.FilePath as FP --- $gettingstarted --- --- This module provides a standard way of building and generating blog posts. --- Check out the Blog example --- . --- --- To generate a blog for your website, first create a @blog/@ directory in --- your web page source directory. --- --- Then, name your blog posts in this format: --- --- > yyyy-mm-dd-title-of-blog-post.markdown --- --- The files in that directory are expected to have preambles that have at --- least @postTitle@ and @date@ defined. The other ones are optional. --- --- > --- --- You can mark a post as a draft via the @draft@ variable (it won't be --- loaded when you call 'loadBlogPosts'), and add tagging (see below) via --- @tags@. Then, use 'loadBlogPosts' to load the entire @blog/@ directory. --- --- In the example below, @layout.html@ defines the outer HTML structure (with --- global components like navigation), and @blog-post.html@ is a generic blog --- post container that renders @${postTitle}@ as a header, @${date}@, and --- @${body}@ for the post body. --- --- @ --- layout <- 'load' toHtml "layout.html" --- postLayout <- 'load' toHtml "blog-post.html" --- posts <- 'loadBlogPosts' "blog/" --- render (fmap (layout <|| postLayout <|) posts) --- @ --- - -- | Loads the given directory as a series of blog posts, sorted by the @date@ --- PREAMBLE environment variable. Posts with @draft: true@ are filtered out. +-- preamble environment variable. Posts with @draft: true@ are filtered out. -- -- @ --- posts <- loadBlogPosts "blog/" +-- posts <- loadPosts "blog/" -- @ -loadBlogPosts :: FilePath -> PencilApp [Page] -loadBlogPosts fp = do - -- Load posts - postFps <- listDir False fp - - -- Sort by date (newest first) and filter out drafts - liftM (filterByVar True "draft" (VBool True /=) . sortByVar "date" dateOrdering) - (mapM (load blogPostUrl) postFps) +loadPosts :: FilePath -> PencilApp [Page] +loadPosts fp = do + posts <- loadDir False fp + return $ + (filterByVar True "draft" (VBool True /=) . sortByVar "date" dateOrdering) + (fmap (rename postUrl) posts) -- | Rewrites file path for blog posts. --- @\/blog\/2011-01-01-the-post-title.html@ => @\/blog\/the-post-title\/@ -blogPostUrl :: FilePath -> FilePath -blogPostUrl fp = FP.replaceFileName fp (drop 11 (FP.takeBaseName fp)) ++ "/" +-- +-- > postUrl "/blog/2011-01-01-post-title.html" +-- > -- "/blog/1-post-title.html/" +-- +postUrl :: FilePath -> FilePath +postUrl fp = FP.replaceFileName fp (drop 11 (FP.takeBaseName fp)) ++ "/" -- | Given that the current @Page@ has a @postTitle@ in the environment, inject -- the post title into the @title@ environment variable, prefixed with the given @@ -91,15 +99,16 @@ -- This is useful for generating the @\${title}\@ tags in your -- container layout. -- +-- For example, if the page's preamble has @postTitle: "The Meaning of Life"@, +-- then the snippet below will insert a @title@ variable with the value @"The +-- Meaning of Life - My Awesome Website"@: +-- -- @ -- injectTitle "My Awesome Website" post -- @ -- --- The above example may insert a @title@ variable with the value @"How to do X --- - My Awesome Website"@. --- injectTitle :: T.Text - -- ^ Title prefix. + -- ^ Title prefix -> Page -> Page injectTitle titlePrefix page = @@ -109,9 +118,14 @@ env' = insertText "title" title (getPageEnv page) in setPageEnv env' page +-- | Like, you know, a hashtag. Wraps a text. type Tag = T.Text --- | Helper of 'buildTagPagesWith' defaulting to the variable name @posts@, and +-- | Finds all the tags from the given pages, and generates a page for each tag +-- found. Each tag page has a variable "posts" containing all pages that have +-- the tag. +-- +-- Helper of 'buildTagPagesWith' defaulting to the variable name @posts@, and -- the tag index page file path @blog\/tags\/my-tag-name\/@. -- -- @ @@ -138,7 +152,7 @@ -- tagPages <- buildTagPagesWith -- "tag-list.html" -- "posts" --- (\tag _ -> "blog/tags/" ++ 'Data.Text.unpack' tag ++ "/") +-- (\\tag _ -> "blog\/tags\/" ++ 'Data.Text.unpack' tag ++ "\/") -- posts -- @ buildTagPagesWith :: FilePath @@ -147,7 +161,7 @@ -- ^ Variable name inserted into Tag index pages for the list of -- Pages tagged with the specified tag -> (Tag -> FilePath -> FilePath) - -- ^ Function to generate the URL of the tag pages. + -- ^ Function to generate the URL of the tag pages -> [Page] -> PencilApp (H.HashMap Tag Page) buildTagPagesWith tagPageFp pagesVar fpf pages = do @@ -158,17 +172,20 @@ foldM (\acc (tag, taggedPosts) -> do - tagPage <- load (fpf tag) tagPageFp - let tagEnv = (insertPages pagesVar taggedPosts . insertText "tag" tag . merge (getPageEnv tagPage)) env + tagPage <- rename (fpf tag) <$> load tagPageFp + -- Generate the URL that this tag page will use. + let url = T.pack $ "/" ++ getFilePath tagPage + tagEnv <- (insertPages pagesVar taggedPosts . insertText "tag" tag . insertText "this.url" url . merge (getPageEnv tagPage)) env return $ H.insert tag (setPageEnv tagEnv tagPage) acc ) H.empty (H.toList tagMap) --- | Inject the given tagging map into the given @Page@'s environment, as the --- @tags@ variable, whose value is a @VEnvList@. -injectTagsEnv :: H.HashMap Tag Page -> Page -> Page -injectTagsEnv tagMap page = +-- | Injects the tag map (usually generated by 'buildTagPages' or +-- 'buildTagPagesWith') into the page's environment as the variable @tags@, +-- which is an @VEnvList@. +injectTags :: H.HashMap Tag Page -> Page -> Page +injectTags tagMap page = -- Build up an env list of tag to that tag page's env. This is so that we can -- have access to the URL of the tag index pages. let envs = @@ -190,6 +207,5 @@ -- have access to the URL of the Tag index. env' = if null envs then getPageEnv page - else insertEnv "tags" (VEnvList envs) (getPageEnv page) + else insert "tags" (VEnvList envs) (getPageEnv page) in setPageEnv env' page - diff --git a/src/Pencil/Config.hs b/src/Pencil/Config.hs new file mode 100644 --- /dev/null +++ b/src/Pencil/Config.hs @@ -0,0 +1,181 @@ +{-| +Pencil Config. +-} +module Pencil.Config + ( Config(..) + , defaultConfig + , getSourceDir , setSourceDir + , getOutputDir , setOutputDir + , getEnv , setEnv , updateEnv + , getDisplayValue , setDisplayValue + , getSassOptions , setSassOptions + , getPandocReaderOptions , setPandocReaderOptions + , getPandocWriterOptions , setPandocWriterOptions + )where + +import Data.Default (Default) +import Pencil.Env.Internal +import Text.Pandoc.Extensions (disableExtension, Extension(..)) +import Text.Sass.Options (defaultSassOptions) +import qualified Data.HashMap.Strict as H +import qualified Data.Text as T +import qualified Text.Pandoc as P +import qualified Text.Pandoc.Highlighting +import qualified Text.Sass as Sass + +-- | The main @Config@ needed to build your website. Your app's @Config@ is +-- passed into the 'Pencil.App.PencilApp' monad transformer. +-- +-- Use 'defaultConfig' as a starting point, along with the config-modification +-- helpers such as 'setSourceDir'. +-- +data Config = Config + { configSourceDir :: FilePath + , configOutputDir :: FilePath + , configEnv :: Env + , configDisplayValue :: Value -> T.Text + , configSassOptions :: Sass.SassOptions + , configPandocReaderOptions :: P.ReaderOptions + , configPandocWriterOptions :: P.WriterOptions + } + +-- 'Data.Default.Default' instance for 'Config'. +instance Default Config where + def = defaultConfig + +-- | This default @Config@ gives you everything you need to start. +-- +-- Default values: +-- +-- @ +-- Config +-- { 'configSourceDir' = "site/" +-- , 'configOutputDir' = "out/" +-- , 'configEnv' = HashMap.empty +-- , 'configDisplayValue' = 'toText' +-- , 'configSassOptions' = Text.Sass.Options.defaultSassOptions +-- , 'configPandocReaderOptions' = Text.Pandoc.def { +-- Text.Pandoc.readerExtensions = 'Text.Pandoc.Extensions.disableExtension' 'Text.Pandoc.Extensions.Ext_tex_math_dollars' ('Text.Pandoc.Extensions.getDefaultExtensions' "markdown") +-- } +-- , 'configPandocWriterOptions' = Text.Pandoc.def { Text.Pandoc.writerHighlightStyle = Just Text.Pandoc.Highlighting.monochrome } +-- , 'configDisplayValue = 'toText' +-- } +-- @ +-- +-- @Ext_tex_math_dollars@ is disabled because it messes with parsing template +-- variable directives. If you want TeX math, the better option is drop in a +-- JavaScript library like KaTeX (https://katex.org). +-- +defaultConfig :: Config +defaultConfig = Config + { configSourceDir = "site/" + , configOutputDir = "out/" + , configEnv = H.empty + , configSassOptions = Text.Sass.Options.defaultSassOptions + + -- For markdown reader. We use getDefaultExtensions "markdown" here to get default Markdown extensions. + -- See + -- https://hackage.haskell.org/package/pandoc/docs/Text-Pandoc-Extensions.html#v:getDefaultExtensions + -- + -- Ext_text_math_dollars is disabled because it messes with variable + -- directives. For example, this renders weird (as of Pandoc 2.7.2): + -- > **${name}** and **${age}** + , configPandocReaderOptions = P.def { + P.readerExtensions = disableExtension Ext_tex_math_dollars (P.getDefaultExtensions "markdown") + } + , configPandocWriterOptions = P.def { + P.writerHighlightStyle = Just Text.Pandoc.Highlighting.monochrome + } + , configDisplayValue = toText + } + +-- | Gets the source directory of your web page source files. +getSourceDir :: Config -> FilePath +getSourceDir = configSourceDir + +-- | Sets the source directory of your web page source files. +setSourceDir :: FilePath -> Config -> Config +setSourceDir fp c = c { configSourceDir = fp } + +-- | Gets the output directory of your rendered web pages. +getOutputDir :: Config -> FilePath +getOutputDir = configOutputDir + +-- | Sets the output directory of your rendered web pages. +setOutputDir :: FilePath -> Config -> Config +setOutputDir fp c = c { configOutputDir = fp } + +-- | Gets environment of the @Config@, which is what the @PencilApp@ monad +-- transformer uses. This is where variables are set for rendering template +-- directives. +getEnv :: Config -> Env +getEnv = configEnv + +-- | Sets the current environment. You may also want to look at 'Pencil.App.withEnv' if you +-- want to 'Pencil.Content.render' things in a modified environment. +setEnv :: Env -> Config -> Config +setEnv env c = c { configEnv = env } + +-- | Updates the Env inside the 'Config'. +updateEnv :: (Env -> Env) -> Config -> Config +updateEnv f c = c { configEnv = f (getEnv c) } + +-- | Gets the 'Sass.SassOptions' for rendering Sass/Scss files. +getSassOptions :: Config -> Sass.SassOptions +getSassOptions = configSassOptions + +-- | Sets the 'Sass.SassOptions' for rendering Sass/Scss files. +setSassOptions :: Sass.SassOptions -> Config -> Config +setSassOptions env c = c { configSassOptions = env } + +-- | Gets the 'Text.Pandoc.ReaderOptions' for reading files that use Pandoc. +-- Supported formats: +-- +-- * Markdown +-- * Open a GitHub issue if you'd like to see more options! +-- +getPandocReaderOptions :: Config -> P.ReaderOptions +getPandocReaderOptions = configPandocReaderOptions + +-- | Sets the 'Text.Pandoc.ReaderOptions'. For example, you may want to enable +-- some Pandoc extensions like 'Text.Pandoc.Extensions.Ext_literate_haskell': +-- +-- @ +-- setPandocReaderOptions +-- (Text.Pandoc.def { 'Text.Pandoc.Options.readerExtensions' = extensionsFromList [Ext_literate_haskell] }) +-- config +-- @ +setPandocReaderOptions :: P.ReaderOptions -> Config -> Config +setPandocReaderOptions o c = c { configPandocReaderOptions = o } + +-- | Gets the 'Text.Pandoc.WriterOptions' for rendering files that use Pandoc. +getPandocWriterOptions :: Config -> P.WriterOptions +getPandocWriterOptions = configPandocWriterOptions + +-- | Sets the 'Text.Pandoc.WriterOptions'. +setPandocWriterOptions :: P.WriterOptions -> Config -> Config +setPandocWriterOptions o c = c { configPandocWriterOptions = o } + +-- | Gets the function that renders 'Value' to text. +getDisplayValue :: Config -> Value -> T.Text +getDisplayValue = configDisplayValue + +-- | Sets the function that renders 'Value' to text. Overwrite this with your +-- own function if you would like to change how certain 'Value's are rendered +-- (e.g. 'Pencil.Env.Internal.VDateTime'). +-- +-- @ +-- myRender :: Value -> T.Text +-- myRender (VDateTime dt) = 'T.pack' $ 'TF.formatTime' 'TF.defaultTimeLocale' "%e %B %Y" dt +-- myRender t = 'toText' t +-- +-- ... +-- +-- setDisplayValue myRender config +-- @ +-- +-- In the above example, we change the @VDateTime@ rendering to show @25 +-- December 2017@. Leave everything else unchanged. +-- +setDisplayValue :: (Value -> T.Text) -> Config -> Config +setDisplayValue f c = c { configDisplayValue = f } diff --git a/src/Pencil/Content.hs b/src/Pencil/Content.hs new file mode 100644 --- /dev/null +++ b/src/Pencil/Content.hs @@ -0,0 +1,640 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} + +{-| +Load, compose and render content. +-} +module Pencil.Content + ( + -- ** Page + + Page + , load + , load' + , loadDir + , loadDir' + , loadAndRender + , rename + , to + , move + , useFilePath + , escapeXml + , getPageEnv, setPageEnv + , filterByVar + , sortByVar + , groupByElements + , insertPages + + -- ** Structure + + , Structure + , struct + , (<||) + , (<|) + , (<<|) + , coll + + -- ** Resource + + , Resource + , passthrough + , loadResource + , loadResources + + -- ** Render + + , Render(..) + + -- ** File paths and types + + , listDir + , toExpected + , toHtml + , toCss + , toDir + + , FileType + , fileType + , toExtension + + , HasFilePath(..) + ) where + +import Pencil.App.Internal +import Pencil.Config +import Pencil.Content.Internal +import Pencil.Content.Nodes +import Pencil.Env +import Pencil.Env.Internal +import Pencil.Parser + +import Control.Monad (forM_, foldM, filterM) +import Control.Monad.Except +import Control.Monad.Reader +import Data.List.NonEmpty (NonEmpty(..)) -- Import the NonEmpty data constructor, (:|) +import qualified Data.HashMap.Strict as H +import qualified Data.List as L +import qualified Data.List.NonEmpty as NE +import qualified Data.Maybe as M +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import qualified System.Directory as D +import qualified System.FilePath as FP +import qualified Text.Pandoc.XML as XML + + +-- | Lists files in given directory. The file paths returned is prefixed with the +-- given directory. +listDir :: Bool + -- ^ Recursive if @True@. + -> FilePath + -> PencilApp [FilePath] +listDir recursive dir = do + let dir' = if null dir then dir else FP.addTrailingPathSeparator dir + fps <- listDir_ recursive dir' + return $ map (dir' ++) fps + +-- | 'listDir' helper. +listDir_ :: Bool -> FilePath -> PencilApp [FilePath] +listDir_ recursive dir = do + sitePrefix <- asks getSourceDir + -- List files (just the filename, without the fp directory prefix) + listing <- liftIO $ D.listDirectory (sitePrefix ++ dir) + -- Filter only for files (we have to add the right directory prefixes to the + -- file check) + files <- liftIO $ filterM (\f -> D.doesFileExist (sitePrefix ++ dir ++ f)) listing + dirs <- liftIO $ filterM (\f -> D.doesDirectoryExist (sitePrefix ++ dir ++ f)) listing + + innerFiles <- if recursive + then mapM + (\d -> do + ff <- listDir_ recursive (dir ++ d ++ "/") + -- Add the inner directory as a prefix + return (map (\f -> d ++ "/" ++ f) ff)) + dirs + else return [] + + return $ files ++ concat innerFiles + +---------------------------------------------------------------------- +-- Page +---------------------------------------------------------------------- + +-- | Applies the environment variables on the given pages. +-- +-- The 'Structure' is expected to be ordered by inner-most content first (such +-- that the final, HTML structure layout is last in the list). +-- +-- The returned Page contains the fully-applied environment and the nodes of the +-- fully rendered page in this.nodes. The `this.url` variable is set to the Page +-- in the Structure that specified 'useFilePath'; if no Page specified this, +-- then it defaults to the URL of the first (inner-most) Page. +-- +-- Variable application. The outer environment's variables are applied down into +-- the inner environments. Once it hits the lowest environment, that page is +-- rendered (and has access to all variables defined in the parent). The page's +-- rendered content is now set as the @${body}@ variable in the environment. +-- The parent page now gets rendered with this new environment, and so on. +-- +-- As an example, there is the common scenario where we have a default layout +-- (e.g. @default.html@), with the full HTML structure, but no body. It has only +-- a @${body}@ template variable inside. This is the parent layout. There is a +-- child layout, the partial called "blog-post.html", which has HTML for +-- rendering a blog post, like usage of ${postTitle} and ${postDate}. Inside +-- this, there is another child layout, the blog post content itself, which +-- defines the variables @postTitle@ and @postDate@, and may renderer parent +-- variables such as @websiteTitle@. +-- +-- > +--------------+ +-- > | | <--- default.html +-- > | | Defines websiteTitle +-- > | +---------+ | +-- > | | |<+----- blog-post.html +-- > | | +-----+ | | Renders ${postTitle}, ${postDate} +-- > | | | | | | +-- > | | | | | | +-- > | | | |<+-+----- blog-article-content.markdown +-- > | | | | | | Renders ${websiteTitle} +-- > | | +-----+ | | Defines postTitle, postDate +-- > | +---------+ | +-- > +--------------+ +-- +-- In this case, we want to accumulate the environment variables, starting from +-- default.html, to blog-post.html, and blog-article-content.markdown variables. +-- Combine all of that, then render the blog post content. This content is then +-- injected into the parent's environment as a @${body}@ variable, for use in +-- blog-post.html. Now /that/ content is injected into the parent environment's +-- @${body}@ variable, which is then used to render the full-blown HTML page. +-- +apply :: Structure -> PencilApp Page +apply structure = do + let reversed = NE.reverse (structureNodes structure) + + -- Collections cannot be the first element in the structure. It would be + -- useless there, since nothing can reference it. + let h = NE.head reversed + when (isColl h) $ throwError (CollectionFirstInStructure (nodeName h)) + + setFilePath (getFilePath structure) <$> apply_ reversed + +-- | Apply list of @Page@s and convert to @Page@. +-- +-- It's simpler to implement if NonEmpty is ordered outer-structure first (e.g. +-- HTML layout). +-- +apply_ :: NE.NonEmpty Node -> PencilApp Page +apply_ (Node _ page :| []) = do + env <- asks getEnv + + -- Evaluate this page's nodes using the combined env + applyPage env page + +apply_ (Nodes name pages :| rest) = do + -- Collection nodes must be the last element in the Structure. Before, you + -- could attach more Pages after a collection (such that each page in the + -- collection received the rest of the structure's env.) + -- + -- But we now disallow this for a couple of reasons: + -- + -- - Most use-cases of collections involve it being the last item anyways + -- (e.g. list of blog posts) + -- - Simplifes logic of choosing with Page becomes the default file path to be + -- used in the Structure render. The rule is now: the last non-collection + -- Page becomes the default file name. It was complicated with collections, + -- since a collection had N pages to choose from. And most use-cases (e.g. + -- list of blog posts) would then require you to call `useFilePath` for the + -- last Page to specify. + when (not (null rest)) $ throwError (CollectionNotLastInStructure name) + + env <- asks getEnv + + -- Apply the inner pages against the rest of the Structure. + pages' <- mapM (\p -> apply_ (Node "body" p :| rest)) pages + + return $ + Page ((H.insert name (VEnvList (map getPageEnv pages')) env)) "UNSPECIFIED_FILE_PATH" False False + +apply_ (Node name page :| (h : rest)) = do + -- Apply the inner Pages to accumulate the inner environments and pages. Do it + -- in a local env where this Page's env is merged with the current env. + pageInner <- local (\c -> setEnv (merge (getPageEnv page) (getEnv c)) c) (apply_ (h :| rest)) + + -- At this point, pageInner's env is the accumulate of this page's env and all + -- the inner pages' envs. + -- + -- Get the inner page's rendered content, and insert into a new env using the + -- specified `name`. This assumes that the inner Page's content was rendered, + -- above. Some pages don't have this.content (e.g. 'Nodes' pages). + let env' = maybe (getPageEnv pageInner) + (\content -> insertText name content (getPageEnv pageInner)) + (getContent (getPageEnv pageInner)) + + -- Apply this current Page's nodes with the accumulated environment of all the + -- inner Pages. + applyPage env' page + +-- | Applies the Page by merging the given env with the Page's env, evaluating +-- the nodes with the combined env, and generating a new env for the Page, +-- containing @this.url@, @this.nodes@ and @this.content@ in the env. +applyPage :: Env -> Page -> PencilApp Page +applyPage env page = do + let env' = merge (getPageEnv page) env + + -- Evaluate the Page's nodes with the specified environment. + nodes <- evalNodes env' (getNodes (getPageEnv page)) + + -- Generate this Page's final file path. + -- Insert the nodes and rendered content into the env. + let env'' = (insertText "this.url" (T.pack ("/" ++ pageFilePath page)) . + insert "this.nodes" (VNodes nodes) . + insertText "this.content" (nodesToText (pageEscapeXml page) nodes)) + env' + + -- Use inner-most Page's file path, as this will be the destination of the + -- accumluated, final, rendered page. + return $ page { pageEnv = env'' } + +-- | Render nodes. XML/HTML tags are escaped if @escpXml@ is True. +nodesToText :: Bool + -- ^ XML/HTML tags escaped if True. + -> [PNode] + -> T.Text +nodesToText escXml nodes = + (if escXml then escapeForXml else id) (renderNodes nodes) + +-- | Escape XML tags in the given Text. +escapeForXml :: T.Text -> T.Text +escapeForXml text = T.pack (XML.escapeStringForXML (T.unpack text)) + +-- | Sorts pages by an ordering function. +sortByVar :: T.Text + -- ^ Environment variable name. + -> (Value -> Value -> Ordering) + -- ^ Ordering function to compare Value against. If the variable is + -- not in the Env, the Page will be placed at the bottom of the order. + -> [Page] + -> [Page] +sortByVar var ordering = + L.sortBy + (\a b -> + maybeOrdering ordering (H.lookup var (getPageEnv a)) (H.lookup var (getPageEnv b))) + +-- | Filters pages by a variable's value in the environment. +filterByVar :: Bool + -- ^ If true, include pages without the specified variable. + -> T.Text + -- ^ Environment variable name. + -> (Value -> Bool) + -> [Page] + -> [Page] +filterByVar includeMissing var f = + L.filter + (\p -> M.fromMaybe includeMissing (H.lookup var (getPageEnv p) >>= (Just . f))) + +-- | Given a variable (whose value is assumed to be an array of VText) and list +-- of pages, groups the pages by the VText found in the variable. +-- +-- For example, say each Page has a variable "tags" that is a list of tags. The +-- first Page has a "tags" variable that is an @VArray [VText "a"]@, and the +-- second Page has a "tags" variable that is an @VArray [VText "a", VText "b"]@. +-- The final output would be a map @fromList [("a", [page1, page2]), ("b", +-- [page2])]@. +groupByElements :: T.Text + -- ^ Environment variable name. + -> [Page] + -> H.HashMap T.Text [Page] +groupByElements var pages = + -- This outer fold takes the list of pages, and accumulates the giant HashMap. + L.foldl' + (\acc page -> + let x = H.lookup var (getPageEnv page) + in case x of + Just (VArray values) -> + -- This fold takes each of the found values (each is a key in the + -- hash map), and adds the current page (from the outer fold) into + -- each of the key. + L.foldl' + (\hashmap envData -> + case envData of + -- Only insert Pages into the map if the variable is an VArray of + -- VText. Alter the map to either (1) insert this current + -- page into the existing list, or (2) create a new list (the + -- key has never been seen) with just this page. + VText val -> H.alter (\mv -> Just (page : M.fromMaybe [] mv)) val hashmap + _ -> hashmap) + acc values + _ -> acc + ) + H.empty + -- Reverse to keep ordering consistent inside hash map, since the fold + -- prepends into accumulated list. + (reverse pages) + +-- | Copy file from source to output dir. If both the input and output file +-- paths are directories, recursively copy the contents from one to the other. +copyFile :: FilePath -> FilePath -> PencilApp () +copyFile fpIn fpOut = do + sitePrefix <- asks getSourceDir + outPrefix <- asks getOutputDir + liftIO $ D.createDirectoryIfMissing True (FP.takeDirectory (outPrefix ++ fpOut)) + + if isDir fpIn && isDir fpOut + -- Copying directories + then do + fps <- listDir True fpIn + forM_ fps (\fp -> copyFile fp (fpOut ++ (FP.takeFileName fp))) + else + liftIO $ D.copyFile (sitePrefix ++ fpIn) (outPrefix ++ fpOut) + + +-- | Loads a file as a 'Resource'. Use this for binary files (e.g. images) and +-- for files without template directives that may still need conversion (e.g. +-- Markdown to HTML, SASS to CSS). +-- +-- Generally, you can just use `loadAndRender` instead of this method. +-- +-- Loads and renders the image as-is. Underneath the hood this is just a file +-- copy: +-- +-- > loadResource "images/profile.jpg" >>= render +-- +-- Loads and renders to @about.html@: +-- +-- > loadResource "about.markdown" >>= render +-- +loadResource :: FilePath -> PencilApp Resource +loadResource fp = + -- If we can load the Page as text file, convert to a Single. Otherwise if it + -- wasn't a text file, then return a Passthroguh resource. This is where we + -- finally handle the "checked" exception; that is, converting the Left error + -- case (NotTextFile) into a Right case (Passthrough). + fmap Single (load fp) + `catchError` handle + -- 'handle' requires FlexibleContexts + where handle e = case e of + NotTextFile _ -> return (Passthrough fp fp) + _ -> throwError e + +-- | Loads file in given directory as 'Resource's. +-- +-- Generally, you can just use `loadAndRender` instead of this method. +-- +-- Load everything inside the @assets/@ folder, renaming converted files as +-- expected (e.g. SCSS to CSS): +-- +-- > loadResources True True "assets/" +-- +loadResources :: Bool + -- ^ Recursive if @True@. + -> Bool + -- ^ Handle as pass-throughs (file copy) if @True@. + -> FilePath + -> PencilApp [Resource] +loadResources recursive pass dir = do + fps <- listDir recursive dir + if pass + then return $ map (\fp -> Passthrough fp fp) fps + else mapM loadResource fps + +-- | Loads file as a pass-through. There is no content conversion, and template +-- directives are ignored. In essence this is a file copy. +-- +-- @ +-- passthrough "robots.txt" >>= render +-- +-- render (move "images\/profile.jpg" \<$\> passthrough "images\/myProfile.jpg") +-- @ +-- +passthrough :: FilePath -> PencilApp Resource +passthrough fp = return $ Passthrough fp fp + +-- | Loads a file as a page, rendering the file (as determined by the file +-- extension) into the proper output format (e.g. Markdown rendered to +-- HTML, SCSS to CSS). Parses the template directives and preamble variables +-- into its environment. +-- +-- This loads @index.markdown@ with the destination file path set to @index.html@: +-- +-- > load "index.markdown" +-- +-- Because this is already an HTML file, the file path is kept as @about.html@: +-- +-- > load "about.html" +-- +-- Using 'rename' and 'toDir', the destination file path becomes @pages\/about\/index.html@: +-- +-- @ +-- 'render' $ 'rename' 'toDir' \<$\> load "pages/about.markdown" +-- @ +-- +load :: FilePath -> PencilApp Page +load fp = rename toExpected <$> load' fp + +-- | Like 'load', loads a file as a page. Unlike 'load', the source file path +-- is used as the destination file path (i.e. the extension name is not changed). +-- +load' :: FilePath -> PencilApp Page +load' fp = do + (_, nodes) <- parseAndConvertTextFiles fp + -- Filter out preamble nodes, since we've already injected preamble into the + -- env. + let env' = H.insert "this.nodes" (VNodes (filter (not . isPreamble) nodes)) (findEnv nodes) + return $ Page env' fp False False + +-- | A version of 'load' for directories. +-- +-- @ +-- layout <- load "layout.html" +-- tutorials <- loadDir False "tutorials/" +-- render $ fmap ((layout '<||') . 'rename' 'toDir') tutorials +-- @ +loadDir :: Bool + -- ^ If True, recursively load files in the directory + -> FilePath + -> PencilApp [Page] +loadDir = loadDirWith load + +-- | A version of load' for directories. Loads the files in the specified +-- directory as pages. Keeps the original file path. +-- +-- @ +-- tutorials <- loadDir' False "tutorials/" +-- render $ fmap ((layout <||) . rename toDir) pages +-- @ +loadDir' :: Bool + -- ^ Recursive if true + -> FilePath + -> PencilApp [Page] +loadDir' = loadDirWith load' + +-- | Internal implemenation for loading directories to pgaes. +loadDirWith :: (FilePath -> PencilApp Page) + -> Bool + -- ^ Recursive if true + -> FilePath + -> PencilApp [Page] +loadDirWith loadF recur fp = do + fps <- listDir recur fp + foldM + (\acc fpath -> do + mp <- (loadF fpath >>= return . Just) `catchError` handle + return (maybe acc (\p -> p : acc) mp)) + [] + (reverse fps) + where handle e = case e of + NotTextFile _ -> return Nothing + _ -> throwError e + +-- | Loads and renders file, converting content if it's convertible (e.g. +-- Markdown to HTML). The final file path is the "default conversion", if Pencil +-- knows how to convert the file (e.g. .markdown to .html). Otherwise, the same +-- file name is kept (e.g. .txt). +-- +-- Load @style.sass@, convert to CSS, and render as @style.css@: +-- +-- > loadAndRender "style.sass" +-- +-- Load, convert and render everything in the @assets/@ folder. Binary files are +-- copied as-is without any further processing: +-- +-- > loadAndRender "assets/" +-- +loadAndRender :: FilePath -> PencilApp () +loadAndRender fp = + if isDir fp + then loadResources True False fp >>= render + else loadResource fp >>= render + +-- | Returns True if the given Node is a collection node. +isColl :: Node -> Bool +isColl (Nodes _ _) = True +isColl _ = False + +-- | Get the node's name. +nodeName :: Node -> T.Text +nodeName (Node n _) = n +nodeName (Nodes n _) = n + +-- | Creates a new structure from two pages. Pronounced "smash". +-- +-- @ +-- layout <- load "layout.html" +-- index <- load "index.markdown" +-- render (layout <|| index) +-- @ +(<||) :: Page -> Page -> Structure +(<||) x y = Structure + { structureNodes = Node "body" y :| [Node "body" x] + , structureFilePath = getFilePath y + , structureFilePathFrozen = False + } + +-- | Pushes @Page@ into @Structure@. Pronounced "push". +-- +-- @ +-- layout <- load "layout.html" +-- blogLayout <- load "blog-layout.html" +-- blogPost <- load "myblogpost.markdown" +-- render (layout <|| blogLayout <| blogPost) +-- @ +(<|) :: Structure -> Page -> Structure +(<|) s p = s { structureNodes = NE.cons (Node "body" p) (structureNodes s) + , structureFilePath = if structureFilePathFrozen s then structureFilePath s else getFilePath p + , structureFilePathFrozen = structureFilePathFrozen s || pageUseFilePath p + } + +-- | Pushes @Node@ into the @Structure@. Usually used in conjunction with 'coll'. +-- +-- @ +-- blogLayout <- load "blog-layout.html" +-- blogPosts <- 'Pencil.Blog.loadPosts' "posts/" +-- render (struct blogLayout <<| coll "posts" blogPosts) +-- @ +(<<|) :: Structure -> Node -> Structure +(<<|) s node = + let (fp, frozen) = if structureFilePathFrozen s + then + (structureFilePath s, True) + else + case node of + -- If collection, use the existing file path (ignore file paths in + -- collection). This keeps with the rule that the default file path + -- is the last non-collection page. + Nodes _ _ -> (structureFilePath s, False) + Node _ p -> (getFilePath p, pageUseFilePath p) + in s { structureNodes = NE.cons node (structureNodes s) + , structureFilePath = fp + , structureFilePathFrozen = frozen + } + +-- | Creates a collection 'Node'. Usually used in conjunction with '<<|'. +coll :: T.Text -> [Page] -> Node +coll = Nodes + +-- | Converts a @Page@ into a @Structure@. This is a "singleton" structure. +struct :: Page -> Structure +struct p = Structure + { structureNodes = Node "body" p :| [] + , structureFilePath = getFilePath p + , structureFilePathFrozen = pageUseFilePath p + } + + +---------------------------------------------------------------------- +-- Render class +---------------------------------------------------------------------- + +-- | To render something is to create the output web pages, evaluating template +-- directives into their final form using the current environment. +class Render a where + -- | Renders @a@ as web page(s). + render :: a -> PencilApp () + +instance Render Resource where + render (Single page) = render page + render (Passthrough fpIn fpOut) = copyFile fpIn fpOut + +-- This requires FlexibleInstances. +instance Render Structure where + render s = apply s >>= render + +instance Render Page where + render page = do + let fpOut = pageFilePath page + outPrefix <- asks getOutputDir + let fpOut' = outPrefix ++ if isDir fpOut then fpOut ++ "index.html" else fpOut + liftIO $ D.createDirectoryIfMissing True (FP.takeDirectory fpOut') + liftIO $ TIO.writeFile fpOut' (renderNodes (getNodes (getPageEnv page))) + +-- This requires FlexibleInstances. +instance Render r => Render [r] where + render rs = forM_ rs render + +---------------------------------------------------------------------- +-- Environment modifications +---------------------------------------------------------------------- + +-- | Inserts pages into the environment. The pages are evaluated and applied before insertion. +-- +-- @ +-- posts <- 'Pencil.Blog.loadPosts' "blog/" +-- env <- asks 'getEnv' +-- env' <- insertPages "posts" posts env +-- @ +insertPages :: T.Text + -- ^ Environment variable name. + -> [Page] + -- ^ @Page@s to insert. + -> Env + -- ^ Environment to modify. + -> PencilApp Env +insertPages var pages env = do + envs <- mapM + (\p -> do + p' <- apply (struct p) + let text = renderNodes (getNodes (getPageEnv p')) + let penv = insertText "this.content" text (getPageEnv p') + return penv) + pages + return $ H.insert var (VEnvList envs) env diff --git a/src/Pencil/Content/Internal.hs b/src/Pencil/Content/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Pencil/Content/Internal.hs @@ -0,0 +1,375 @@ +{-# LANGUAGE DeriveGeneric #-} + +{-| +Internal implementation for functions that content. +-} +module Pencil.Content.Internal where + +import Data.Hashable (Hashable) +import Data.List.NonEmpty (NonEmpty(..)) -- Import the NonEmpty data constructor, (:|) +import GHC.Generics (Generic) +import Pencil.Env.Internal +import qualified Data.Char as Char +import qualified Data.HashMap.Strict as H +import qualified Data.Maybe as M +import qualified Data.Text as T +import qualified System.FilePath as FP + +-- | The @Page@ is an important data type in Pencil. +-- +-- Source files like Markdown and HTML are loaded (e.g. via 'Pencil.Content.load') as a @Page@. +-- A page contains the contents of the file, their un-evaluated [template +-- directives](https://elbenshira.com/pencil/guides/templates/) (e.g. +-- @${body}@), the variables defined in the preamble, and the destination file +-- path. +-- +-- The contents /may/ be in its converted form. 'Pencil.Content.load' will convert Markdown to +-- HTML, for example. +-- +-- Pages can be /combined/ together into a 'Structure', or inserted into the +-- environment (see 'Pencil.Content.insertPages'). But at the end of the day, even a structure +-- is converted back into a page on 'Pencil.Content.render'. This is because it is the page +-- that is finally rendered into an actual web page when you run your program. +-- +data Page = Page + { pageEnv :: Env + + , pageFilePath :: FilePath + -- ^ The rendered output path of this page. Defaults to the input file path. + -- This file path is used to generate the self URL that is injected into the + -- environment. + + , pageUseFilePath :: Bool + -- ^ Whether or not this Page's URL should be used as the final URL in the + -- render. + + , pageEscapeXml :: Bool + -- ^ Whether or not XML/HTML tags should be escaped when rendered. + } deriving (Eq, Show) + +-- | Gets the Env of a 'Page'. +getPageEnv :: Page -> Env +getPageEnv = pageEnv + +-- | Sets the Env of a 'Page'. +setPageEnv :: Env -> Page -> Page +setPageEnv env p = p { pageEnv = env } + +-- | Sets this 'Page' as the designated final 'FilePath'. +-- +-- This is useful when you are building a 'Structure' but don't want the file +-- path of the last 'Page' in the structure to be the destination file path on +-- render. +-- +-- The [Pages and +-- Structures](https://elbenshira.com/pencil/guides/pages-and-structures/) guide +-- describes this in detail. +-- +-- @ +-- a <- load "a.html" +-- b <- load "b.html" +-- c <- load "c.html" +-- +-- -- Rendered file path is "c.html" +-- render $ a <|| b <| c +-- +-- -- Rendered file path is "b.html" +-- render $ a <|| useFilePath b <| c +-- @ +-- +useFilePath :: Page -> Page +useFilePath p = p { pageUseFilePath = True } + +-- | Sets this 'Page' to render with escaped XML/HTML tags. +-- +-- This is useful when you are building an RSS feed, and you need the /contents/ +-- of each item in the feed to HTML-escaped. +-- +-- @ +-- rss <- load "rss.xml" +-- item1 <- load "item1.html" +-- +-- render $ rss <|| escapeXml item1 +-- @ +-- +escapeXml :: Page -> Page +escapeXml p = p { pageEscapeXml = True } + + +-- | A @Structure@ is a list of 'Page's, defining a nesting order. Think of them +-- like . +-- The first element defines the outer-most container, and subsequent elements +-- are /inside/ the previous element. +-- +-- You commonly use @Structure@s to insert a page containing content (e.g. a blog +-- post) into a container (e.g. a layout shared across all your web pages). +-- +-- Build structures using 'Pencil.Content.struct', 'Pencil.Content.<||' and 'Pencil.Content.<|'. +-- +-- @ +-- layout <- load "layout.html" +-- index <- load "index.markdown" +-- about <- load "about.markdown" +-- render (layout <|| index) +-- render (layout <|| about) +-- @ +-- +-- In the example above we load a layout page, which defines the outer HTML +-- structure like @\\<\/html\>@. We then "push" the index page and the +-- about page into the layout. +-- +-- When we 'Pencil.Content.render' @layout <|| index@, the contents of the index (and about) +-- page is injected into the layout page through the variable @${body}@. So +-- @layout.html@ must use @${body}@ somewhere in its own body. +-- +-- Structures also control the closure of variables. Variables defined in a +-- page are accessible both by pages above and below. This allows inner +-- pages to define variables like the blog post title, which may be used in +-- the outer page to, say, set the @\@ tag. +-- +-- In this way, structures allows efficient page reuse. See the private function +-- 'Pencil.Content.Internal.apply' to learn more about how structures are evaluated. +-- +-- /The Default File Path Rule/. When a structure is rendered, the /last/ +-- non-collection page in the structure is used as the destination file path. +-- You can select a different page via 'useFilePath'. +-- +-- The [Pages and +-- Structures](https://elbenshira.com/pencil/guides/pages-and-structures/) guide +-- also describes structures in detail. +-- +-- Note that structures differ from the @${partial(...)}@ directive, which has no +-- such variable closures. The partial directive is much simpler—think of them +-- as copy-and-pasting snippets from one file to another. A partial has +-- the same environment as the context in which the partial directive appears. +-- +-- +data Structure = Structure + { structureNodes :: NonEmpty Node + , structureFilePath :: FilePath + , structureFilePathFrozen :: Bool + -- ^ True if the file path should no longer be changed. This happens when a + -- page with `useFilePath = True` was pushed into the structure. + } + +-- | An inner element in the Structure. Either a singular Page, or a collection +-- of Pages. The Text element is the variable name that the inner page's content +-- is injected as. Defaults to @"body"@. +data Node = + Node T.Text Page + | Nodes T.Text [Page] + +-- | @Resource@ is used to copy static binary files to the destination, and to +-- load and render files that just needs conversion without template directives +-- or structures. +-- +-- This is how Pencil handles files like images, compiled JavaScript, or text +-- files that require only a straight-forward conversion. +-- +-- Use 'Pencil.Content.passthrough', 'Pencil.Content.loadResource' and +-- 'Pencil.Content.loadResources' to build a @Resource@ from a file. +-- +-- In the example below, @robots.txt@ and everything in the @images/@ directory +-- will be rendered as-is. +-- +-- @ +-- passthrough "robots.txt" >>= render +-- passthrough "images/" >>= render +-- @ +-- +data Resource + = Single Page + | Passthrough FilePath FilePath + -- ^ in and out file paths (can be dir or files) + + +-- | Enum for file types that can be parsed and converted by Pencil. +data FileType = Html + | Markdown + | Css + | Sass + | Other + deriving (Eq, Generic) + +-- | 'Hashable' instance of @FileType@. +instance Hashable FileType + +-- | A 'H.HashMap' of file extensions (e.g. @markdown@) to 'FileType'. +-- +-- * 'Html': @html, htm@ +-- * 'Markdown': @markdown, md@ +-- * 'Css': @css@ +-- * 'Sass': @sass, scss@ +-- +fileTypeMap :: H.HashMap String FileType +fileTypeMap = H.fromList + [ ("html", Html) + , ("htm", Html) + , ("markdown", Markdown) + , ("md", Markdown) + , ("css", Css) + , ("sass", Sass) + , ("scss", Sass) + ] + +-- | Mapping of 'FileType' to the final converted format. Only contains +-- 'FileType's that Pencil will convert. +-- +-- * 'Markdown': @html@ +-- * 'Sass': @css@ +-- +extensionMap :: H.HashMap FileType String +extensionMap = H.fromList + [ (Markdown, "html") + , (Sass, "css")] + +-- | Converts a 'FileType' into its converted webpage extension, if Pencil would +-- convert it (e.g. Markdown to HTML). +-- +-- >>> toExtension Markdown +-- Just "html" +-- +toExtension :: FileType -> Maybe String +toExtension ft = H.lookup ft extensionMap + +-- | Takes a file path and returns the 'FileType', defaulting to 'Other' if it's +-- not a supported extension. +fileType :: FilePath -> FileType +fileType fp = + -- takeExtension returns ".markdown", so drop the "." + M.fromMaybe Other (H.lookup (map Char.toLower (drop 1 (FP.takeExtension fp))) fileTypeMap) + +-- | Returns True if the file path is a directory. +-- Examples: foo/bar/ +-- Examples of not directories: /foo, foo/bar, foo/bar.baz +isDir :: FilePath -> Bool +isDir fp = null (FP.takeBaseName fp) + +-- | Replaces the file path's extension with @.html@. +-- +-- @ +-- rename toHtml \<$\> 'Pencil.Content.load' "about.htm" +-- @ +-- +toHtml :: FilePath -> FilePath +toHtml fp = FP.dropExtension fp ++ ".html" + +-- | Converts a file path into a directory name, dropping the extension. +-- Pages with a directory as its file path is rendered as an index file in that +-- directory. +-- +-- For example, @pages/about.html@ is transformed into @pages\/about\/@, which +-- upon 'Pencil.Content.render' results in the destination file path @pages\/about\/index.html@: +-- +-- @ +-- toDir "pages/about.html" +-- @ +-- +-- Load and render as @pages\/about\/@: +-- +-- @ +-- render $ 'rename' toDir \<$\> 'Pencil.Content.load' "pages/about.html" +-- @ +-- +toDir :: FilePath -> FilePath +toDir fp = FP.replaceFileName fp (FP.takeBaseName fp) ++ "/" + +-- | Replaces the file path's extension with @.css@. +-- +-- @ +-- rename toCss \<$\> 'Pencil.Content.load' "style.sass" +-- @ +-- +toCss :: FilePath -> FilePath +toCss fp = FP.dropExtension fp ++ ".css" + +-- | Converts file path into the expected extensions. This means @.markdown@ +-- become @.html@, @.sass@ becomes @.css@, and so forth. See 'extensionMap' for +-- conversion table. +toExpected :: FilePath -> FilePath +toExpected fp = maybe fp ((FP.dropExtension fp ++ ".") ++) (toExtension (fileType fp)) + +-- | Transforms the file path. +-- +-- @ +-- about <- load "about.htm" +-- render $ struct (rename 'toHtml' about) +-- @ +rename :: HasFilePath a => (FilePath -> FilePath) -> a -> a +rename f a = setFilePath (f (getFilePath a)) a + +-- | Sets the target file path to the specified file path. If the given file path +-- is a directory, the file name set to @index.html@. If the file path is a file +-- name, then the file is renamed. +-- +-- Move @stuff/about.html@ to @about/blah.html@ on render: +-- +-- > about <- to "about/blah.html" <$> load "stuff/about.htm" +-- +-- Convert the destination file path to @about/index.html@: +-- +-- > about <- to "about/" <$> load "stuff/about.htm" +-- > render about +-- +-- Equivalent to the above example: +-- +-- > about <- load "stuff/about.htm" +-- > render $ to "about/" about +-- +to :: HasFilePath a => FilePath -> a -> a +to = move' "index.html" + +-- | Moves the target file path to the specified file path. Behaves similar to +-- the UNIX @mv@ command: if the given file path is a directory, the file name +-- is kept the same. If the file path is a file name, then the file is renamed. +-- +-- Move @assets/style.css@ to @stylesheets/style.css@: +-- +-- > move "stylesheets/" <$> load "assets/style.css" +-- +-- Move @assets/style.css@ to @stylesheets/base.css@. +-- +-- > move "stylesheets/base.css" <$> load "assets/style.css" +-- +move :: HasFilePath a => FilePath -> a -> a +move fp a = move' (FP.takeFileName (getFilePath a)) fp a + +-- | Internal implemenation for 'move' and 'to'. +-- +-- Moves the target file path to the specified FilePath. If the given FilePath +-- is a directory, the file name is kept the same. If the FilePath is a file +-- name, then @fromFileName@ is used as the file name. +move' :: HasFilePath a => FilePath -> FilePath -> a -> a +move' fromFileName fp a = + let dir = FP.takeDirectory fp + fp' = if isDir fp + then dir ++ "/" ++ fromFileName + else dir ++ "/" ++ FP.takeFileName fp + in setFilePath fp' a + +---------------------------------------------------------------------- +-- HasFilePath class +---------------------------------------------------------------------- + +-- | Class for types that has a final file path for rendering. +-- +-- This allows file-path-changing methods to be re-used across 'Pencil.Content.Internal.Page', +-- 'Pencil.Content.Internal.Structure' and 'Pencil.Content.Internal.Resource' types. +class HasFilePath a where + getFilePath :: a -> FilePath + setFilePath :: FilePath -> a -> a + +instance HasFilePath Page where + getFilePath = pageFilePath + setFilePath fp p = p { pageFilePath = fp } + +instance HasFilePath Resource where + getFilePath (Single p) = getFilePath p + getFilePath (Passthrough _ fp) = fp + + setFilePath fp (Single p) = Single $ setFilePath fp p + setFilePath fp (Passthrough ofp _) = Passthrough ofp fp + +instance HasFilePath Structure where + getFilePath = structureFilePath + setFilePath fp s = s { structureFilePath = fp } diff --git a/src/Pencil/Content/Nodes.hs b/src/Pencil/Content/Nodes.hs new file mode 100644 --- /dev/null +++ b/src/Pencil/Content/Nodes.hs @@ -0,0 +1,120 @@ +{-| +Internal functions that deal with nodes. +-} +module Pencil.Content.Nodes where + +import Pencil.App.Internal +import Pencil.Env.Internal +import Pencil.Parser +import Pencil.Content.Internal +import Pencil.Config + +import Control.Monad.Reader +import Control.Monad.Except +import Control.Exception (tryJust) +import Data.Text.Encoding (decodeUtf8) + +import qualified Data.HashMap.Strict as H +import qualified Data.Text as T +import qualified Text.Pandoc as P +import qualified Text.Sass as Sass +import qualified Data.Text.IO as TIO + +-- | Evaluate the nodes in the given environment. Note that it returns an IO +-- because of @${partial(..)}@ calls that requires us to load a file. +evalNodes :: Env -> [PNode] -> PencilApp [PNode] +evalNodes _ [] = return [] +evalNodes env (PVar var : rest) = do + nodes <- evalNodes env rest + case H.lookup var env of + Nothing -> + -- Can't find var in env. Skip over it for now and we'll just render the + -- directive to help user debug missing variables. Later on we'll do some + -- nice error handling w/o crashing the system (throw warnings instead of + -- errors). + return $ PVar var : nodes + Just envData -> do + displayValue <- asks getDisplayValue + return $ PText (displayValue envData) : nodes +evalNodes env (PIf var nodes : rest) = do + rest' <- evalNodes env rest + case H.lookup var env of + Nothing -> + -- Can't find var in env; everything inside the if-statement is thrown away + return rest' + Just _ -> do + -- Render nodes inside the if-statement + nodes' <- evalNodes env nodes + return $ nodes' ++ rest' +evalNodes env (PFor var nodes : rest) = do + rest' <- evalNodes env rest + case H.lookup var env of + Nothing -> + -- Can't find var in env; everything inside the for-statement is throw away + return rest' + Just (VEnvList envs) -> do + -- Render the for nodes once for each given env, and append them together + forNodes <- + foldM + (\accNodes e -> do + nodes' <- evalNodes (H.union e env) nodes + return $ accNodes ++ nodes') + [] envs + return $ forNodes ++ rest' + -- Var is not an VEnvList; everything inside the for-statement is thrown away + Just _ -> return rest' +evalNodes env (PPartial fp : rest) = do + (_, nodes) <- parseAndConvertTextFiles (T.unpack fp) + nodes' <- evalNodes env nodes + rest' <- evalNodes env rest + return $ nodes' ++ rest' +evalNodes env (n : rest) = do + rest' <- evalNodes env rest + return $ n : rest' + +-- | Loads and parses the given file path. Converts 'Markdown' files to HTML, +-- compiles 'Sass' files into CSS, and leaves everything else alone. +parseAndConvertTextFiles :: FilePath -> PencilApp (T.Text, [PNode]) +parseAndConvertTextFiles fp = do + content <- loadTextFile fp + content' <- + case fileType fp of + Markdown -> do + pandocReaderOptions <- asks getPandocReaderOptions + pandocWriterOptions <- asks getPandocWriterOptions + result <- liftIO $ P.runIO (readMarkdownWriteHtml pandocReaderOptions pandocWriterOptions content) + case result of + Left _ -> return content + Right text -> return text + Sass -> do + sassOptions <- asks getSassOptions + sitePrefix <- asks getSourceDir + -- Use compileFile so that SASS @import works + result <- liftIO $ Sass.compileFile (sitePrefix ++ fp) sassOptions + case result of + Left _ -> return content + Right byteStr -> return $ decodeUtf8 byteStr + _ -> return content + let nodes = case parseText content' of + Left _ -> [] + Right n -> n + return (content', nodes) + +-- | Loads the given file as a text file. Throws an exception into the ExceptT +-- monad transformer if the file is not a text file. +loadTextFile :: FilePath -> PencilApp T.Text +loadTextFile fp = do + sitePrefix <- asks getSourceDir + -- Try to read the file. If it fails because it's not a text file, capture the + -- exception and convert it to a "checked" exception in the ExceptT stack via + -- 'throwError'. + eitherContent <- liftIO $ tryJust toPencilException (TIO.readFile (sitePrefix ++ fp)) + case eitherContent of + Left e -> throwError e + Right a -> return a + +-- | Converts Markdown to HTML using the given options. +readMarkdownWriteHtml :: P.PandocMonad m => P.ReaderOptions -> P.WriterOptions -> T.Text -> m T.Text +readMarkdownWriteHtml readerOptions writerOptions content = do + pandoc <- P.readMarkdown readerOptions content + P.writeHtml5String writerOptions pandoc diff --git a/src/Pencil/Env.hs b/src/Pencil/Env.hs new file mode 100644 --- /dev/null +++ b/src/Pencil/Env.hs @@ -0,0 +1,98 @@ +{-| +Functions that manipulate the environment. +-} +module Pencil.Env + ( Value(..) + , withEnv + , insert + , insertText + -- , insertPages + , adjust + , merge + , toText + , toTextRss + + , arrayContainsText + , dateOrdering + , maybeOrdering + ) where + +import Pencil.Env.Internal +import Pencil.App.Internal +import Pencil.Config + +import qualified Control.Monad.Reader as Reader +import qualified Data.HashMap.Strict as H +import qualified Data.Text as T + +-- | Inserts @Value@ into the given @Env@. +insert :: T.Text + -- ^ Environment variable name. + -> Value + -- ^ @Value@ to insert. + -> Env + -- ^ Environment to modify. + -> Env +insert = H.insert + +-- | Modifies a variable in the given environment. +adjust :: (Value -> Value) + -> T.Text + -- ^ Environment variable name. + -> Env + -> Env +adjust = H.adjust + +-- | Merges two @Env@s together, biased towards the left-hand @Env@ on duplicates. +merge :: Env -> Env -> Env +merge = H.union + +-- | Inserts text into the given @Env@. +-- +-- @ +-- env <- asks getEnv +-- insertText "title" "My Awesome Website" env +-- @ +insertText :: T.Text + -- ^ Environment variable name. + -> T.Text + -- ^ Text to insert. + -> Env + -- ^ Environment to modify. + -> Env +insertText var val = H.insert var (VText val) + +-- | Runs the computation with the given environment. This is useful when you +-- want to render a 'Pencil.Content.Internal.Page' or 'Pencil.Content.Internal.Structure' with a modified environment. +-- +-- @ +-- withEnv ('Pencil.Env.insertText' "newvar" "newval" env) ('Pencil.Content.render' page) +-- @ +-- +-- Alternatively, use 'Reader.local', which is re-exported in the Pencil module. +-- +withEnv :: Env -> PencilApp a -> PencilApp a +withEnv env = Reader.local (setEnv env) + +-- | Returns true if the given @Value@ is a @VArray@ that contains the given +-- text. +arrayContainsText :: T.Text -> Value -> Bool +arrayContainsText t (VArray arr) = + any (\d -> case d of + VText t' -> t == t' + _ -> False) + arr +arrayContainsText _ _ = False + +-- | Defines an ordering for possibly-missing Value. Nothings are ordered last. +maybeOrdering :: (Value -> Value -> Ordering) + -> Maybe Value -> Maybe Value -> Ordering +maybeOrdering _ Nothing Nothing = EQ +maybeOrdering _ (Just _) Nothing = GT +maybeOrdering _ Nothing (Just _) = LT +maybeOrdering o (Just a) (Just b) = o a b + +-- | Sort by newest first. +dateOrdering :: Value -> Value -> Ordering +dateOrdering (VDateTime a) (VDateTime b) = compare b a +dateOrdering _ _ = EQ diff --git a/src/Pencil/Env/Internal.hs b/src/Pencil/Env/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Pencil/Env/Internal.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| +Internal implementation of Pencil's environment. +-} +module Pencil.Env.Internal where + +import qualified Pencil.Parser as P + +import Data.Text.Encoding (encodeUtf8) + +import qualified Data.HashMap.Strict as H +import qualified Data.Maybe as M +import qualified Data.Text as T +import qualified Data.Time.Clock as TC +import qualified Data.Time.Format as TF +import qualified Data.Vector as V +import qualified Data.Yaml as A + +-- | Represents the data types found in an environment. +-- +-- This includes at least 'Data.Aeson' 'Data.Aeson.Types.Value' types, plus other +-- useful ones. +data Value = + VNull -- JSON null + | VText T.Text + | VBool Bool + | VDateTime TC.UTCTime + | VArray [Value] + | VEnvList [Env] + | VNodes [P.PNode] + deriving (Eq, Show) + +-- | Environment map of variables to 'Value's. +type Env = H.HashMap T.Text Value + +-- | Converts an Aeson 'Aeson.Value' to a Pencil 'Value'. +toValue :: A.Value -> Maybe Value +toValue A.Null = Just VNull +toValue (A.Bool b) = Just $ VBool b +toValue (A.String s) = + -- See if coercible to datetime + case toDateTime (T.unpack s) of + Nothing -> Just $ VText s + Just dt -> Just $ VDateTime dt +toValue (A.Array arr) = + Just $ VArray (V.toList (V.mapMaybe toValue arr)) +toValue _ = Nothing + +-- | Accepted format is ISO 8601 (YYYY-MM-DD), optionally with an appended "THH:MM:SS". +-- Examples: +-- +-- * 2010-01-30 +-- * 2010-01-30T09:08:00 +-- +toDateTime :: String -> Maybe TC.UTCTime +toDateTime s = + -- Try to parse "YYYY-MM-DD" + case parseIso8601 Nothing s of + -- Try to parse "YYYY-MM-DDTHH:MM:SS" + Nothing -> parseIso8601 (Just "%H:%M:%S") s + Just dt -> Just dt + +-- | Helper for 'TF.parseTimeM' using ISO 8601. YYYY-MM-DDTHH:MM:SS and +-- YYYY-MM-DD formats. +-- +-- https://hackage.haskell.org/package/time-1.9/docs/Data-Time-Format.html#v:iso8601DateFormat +parseIso8601 :: Maybe String -> String -> Maybe TC.UTCTime +parseIso8601 f = TF.parseTimeM True TF.defaultTimeLocale (TF.iso8601DateFormat f) + +-- | Gets the nodes from the env, from the @this.nodes@ variable. Returns empty +-- list if this variable is missing. +getNodes :: Env -> [P.PNode] +getNodes env = + case H.lookup "this.nodes" env of + Just (VNodes nodes) -> nodes + _ -> [] + +-- | Find preamble node, and load as an Env. If no preamble is found, return a +-- blank Env. +findEnv :: [P.PNode] -> Env +findEnv nodes = + aesonToEnv $ M.fromMaybe H.empty (P.findPreambleText nodes >>= (A.decodeThrow . encodeUtf8 . T.strip)) + +-- | Converts an Aeson Object to an Env. +aesonToEnv :: A.Object -> Env +aesonToEnv = H.foldlWithKey' maybeInsertIntoEnv H.empty + +-- | Convert known Aeson 'Aeson.Value' into a Pencil +-- 'Pencil.Env.Internal.Value', and insert into the env. If there is no +-- conversion possible, the env is not modified. +maybeInsertIntoEnv :: Env -> T.Text -> A.Value -> Env +maybeInsertIntoEnv env k v = + case toValue v of + Nothing -> env + Just d -> H.insert k d env + + +-- | Gets the rendered content from the env, from the @this.content@ variable. +-- Returns empty is the variable is missing (e.g. has not been rendered). +getContent :: Env -> Maybe T.Text +getContent env = + case H.lookup "this.content" env of + Just (VText content) -> return content + _ -> Nothing + +-- | Renders environment value for human consumption. This is the default one. +toText :: Value -> T.Text +toText VNull = "null" +toText (VText t) = t +toText (VArray arr) = T.unwords $ map toText arr +toText (VBool b) = if b then "true" else "false" +toText (VEnvList envs) = T.unwords $ map (T.unwords . map toText . H.elems) envs +toText (VDateTime dt) = + -- December 30, 2017 + T.pack $ TF.formatTime TF.defaultTimeLocale "%B %e, %Y" dt +toText (VNodes nodes) = P.renderNodes nodes + +-- | A version of 'toText' that renders 'Value' acceptable for an RSS feed. +-- +-- * Dates are rendered in the RFC 822 format. +-- * Everything else defaults to the 'toText' implementation. +-- +-- You'll probably want to also use 'Pencil.Content.Internal.escapeXml' to render an RSS feed. +-- +toTextRss :: Value -> T.Text +toTextRss (VDateTime dt) = T.pack $ TF.formatTime TF.defaultTimeLocale rfc822DateFormat dt +toTextRss v = toText v + +-- | RFC 822 date format. +-- +-- Helps to pass https://validator.w3.org/feed/check.cgi. +-- +-- Same as https://hackage.haskell.org/package/time/docs/Data-Time-Format.html#v:rfc822DateFormat +-- but no padding for the day section, so that single-digit days only has one space preceeding it. +-- +-- Also changed to spit out the offset timezone (+0000) because the default was spitting out "UTC" +-- which is not valid RFC 822. Weird, since the defaultTimeLocal source and docs show that it won't +-- use "UTC": +-- https://hackage.haskell.org/package/time/docs/Data-Time-Format.html#v:defaultTimeLocale +-- +rfc822DateFormat :: String +rfc822DateFormat = "%a, %d %b %Y %H:%M:%S %z" diff --git a/src/Pencil/Internal/Env.hs b/src/Pencil/Internal/Env.hs deleted file mode 100644 --- a/src/Pencil/Internal/Env.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Pencil.Internal.Env where - -import qualified Data.HashMap.Strict as H -import qualified Data.Text as T -import qualified Data.Time.Clock as TC -import qualified Data.Time.Format as TF -import qualified Data.Vector as V -import qualified Data.Yaml as A - --- | Represents the data types found in an environment. --- --- This includes at least Data.Aeson Value type --- (https://hackage.haskell.org/package/aeson-1.2.3.0/docs/Data-Aeson.html#t:Value), --- plus other useful ones. -data Value = - VNull -- JSON null - | VText T.Text - | VBool Bool - | VDateTime TC.UTCTime - | VArray [Value] - | VEnvList [Env] - deriving (Eq, Show) - --- | Environment map of variables to 'Value's. -type Env = H.HashMap T.Text Value - --- | Converts an Aeson @Value@ to a Pencil 'Value'. -toValue :: A.Value -> Maybe Value -toValue A.Null = Just VNull -toValue (A.Bool b) = Just $ VBool b -toValue (A.String s) = - -- See if coercible to datetime - case toDateTime (T.unpack s) of - Nothing -> Just $ VText s - Just dt -> Just $ VDateTime dt -toValue (A.Array arr) = - Just $ VArray (V.toList (V.mapMaybe toValue arr)) -toValue _ = Nothing - --- | Render for human consumption. This is the default one. Pass into Config as --- part of the Reader? -toText :: Value -> T.Text -toText VNull = "null" -toText (VText t) = t -toText (VArray arr) = T.unwords $ map toText arr -toText (VBool b) = if b then "true" else "false" -toText (VEnvList envs) = T.unwords $ map (T.unwords . map toText . H.elems) envs -toText (VDateTime dt) = - -- December 30, 2017 - T.pack $ TF.formatTime TF.defaultTimeLocale "%B %e, %Y" dt - --- | Accepted format is ISO 8601 (YYYY-MM-DD), optionally with an appended "THH:MM:SS". --- Example: 2010-01-30, 2010-01-30T09:08:00 -toDateTime :: String -> Maybe TC.UTCTime -toDateTime s = - -- Try to parse "YYYY-MM-DD" - case maybeParseIso8601 Nothing s of - -- Try to parse "YYYY-MM-DDTHH:MM:SS" - Nothing -> maybeParseIso8601 (Just "%H:%M:%S") s - Just dt -> Just dt - --- | Helper for 'TF.parseTimeM' using ISO 8601. YYYY-MM-DDTHH:MM:SS and --- YYYY-MM-DD formats. --- --- https://hackage.haskell.org/package/time-1.9/docs/Data-Time-Format.html#v:iso8601DateFormat -maybeParseIso8601 :: Maybe String -> String -> Maybe TC.UTCTime -maybeParseIso8601 f = TF.parseTimeM True TF.defaultTimeLocale (TF.iso8601DateFormat f) - --- | Define an ordering for possibly-missing Value. Nothings are ordered last. -maybeOrdering :: (Value -> Value -> Ordering) - -> Maybe Value -> Maybe Value -> Ordering -maybeOrdering _ Nothing Nothing = EQ -maybeOrdering _ (Just _) Nothing = GT -maybeOrdering _ Nothing (Just _) = LT -maybeOrdering o (Just a) (Just b) = o a b - --- | Sort by newest first. -dateOrdering :: Value -> Value -> Ordering -dateOrdering (VDateTime a) (VDateTime b) = compare b a -dateOrdering _ _ = EQ - --- | Returns true if the given @Value@ is a @VArray@ that contains the given --- string. -arrayContainsString :: T.Text -> Value -> Bool -arrayContainsString t (VArray arr) = - any (\d -> case d of - VText t' -> t == t' - _ -> False) - arr -arrayContainsString _ _ = False - diff --git a/src/Pencil/Internal/Parser.hs b/src/Pencil/Internal/Parser.hs deleted file mode 100644 --- a/src/Pencil/Internal/Parser.hs +++ /dev/null @@ -1,397 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Pencil.Internal.Parser where - -import Text.ParserCombinators.Parsec -import qualified Data.List as DL -import qualified Data.Text as T -import qualified Text.Parsec as P - --- Doctest setup. --- --- $setup --- >>> :set -XOverloadedStrings --- >>> import Data.Either (isLeft) - --- | Pencil's @Page@ AST. -data PNode = - PText T.Text - | PVar T.Text - | PFor T.Text [PNode] - | PIf T.Text [PNode] - | PPartial T.Text - | PPreamble T.Text - - -- Signals a If/For expression in the stack waiting for expressions. So that we - -- can find the next unused open if/for-statement in nested if/for-statements. - | PMetaIf T.Text - | PMetaFor T.Text - - -- A terminating node that represents the end of the program, to help with AST - -- converstion - | PMetaEnd - deriving (Show, Eq) - --- | Pencil's tokens for content. -data Token = - TokText T.Text - | TokVar T.Text - | TokFor T.Text - | TokIf T.Text - | TokPartial T.Text - | TokPreamble T.Text - | TokEnd - deriving (Show, Eq) - --- | Convert Tokens to PNode AST. --- --- >>> transform [TokText "hello", TokText "world"] --- [PText "hello",PText "world"] --- --- >>> transform [TokIf "title", TokEnd] --- [PIf "title" []] --- --- >>> transform [TokIf "title", TokText "hello", TokText "world", TokEnd] --- [PIf "title" [PText "hello",PText "world"]] --- --- > ${if(title)} --- > ${for(posts)} --- > world --- > ${end} --- > ${end} --- --- >>> transform [TokIf "title", TokFor "posts", TokText "world", TokEnd, TokEnd] --- [PIf "title" [PFor "posts" [PText "world"]]] --- --- > begin --- > now --- > ${if(title)} --- > hello --- > world --- > ${if(body)} --- > ${body} --- > ${someothervar} --- > wahh --- > ${end} --- > final --- > thing --- > ${end} --- > the --- > lastline --- --- >>> transform [TokText "begin", TokText "now", TokIf "title", TokText "hello", TokText "world", TokIf "body", TokVar "body", TokVar "someothervar", TokText "wahh", TokEnd, TokText "final", TokText "thing", TokEnd, TokText "the", TokText "lastline"] --- [PText "begin",PText "now",PIf "title" [PText "hello",PText "world",PIf "body" [PVar "body",PVar "someothervar",PText "wahh"],PText "final",PText "thing"],PText "the",PText "lastline"] --- --- > --- > Hello world ${foo} --- --- >>> transform [TokPreamble "foo: bar\ndo:\n - re\n -me", TokText "Hello world ", TokVar "foo"] --- [PPreamble "foo: bar\ndo:\n - re\n -me",PText "Hello world ",PVar "foo"] --- -transform :: [Token] -> [PNode] -transform toks = - let stack = ast [] toks - in reverse stack - --- | Converts Tokens, which is just the raw list of parsed tokens, into PNodes --- which are the tree-structure expressions (i.e. if/for nesting) --- --- This function works by using a stack to keep track of where we are for nested --- expressions such as if and for statements. When a token that starts a nesting --- is found (like a TokIf), a "meta" expression (PMetaIf) is pushed into the --- stack. When we finally see an end token (TokEnd), we pop all the expressions --- off the stack until the first meta tag (e.g PMetaIf) is reached. All the --- expressions popped off are now known to be nested inside that if statement. --- -ast :: [PNode] -- stack - -> [Token] -- remaining - -> [PNode] -- (AST, remaining) -ast stack [] = stack -ast stack (TokText t : toks) = ast (PText t : stack) toks -ast stack (TokVar t : toks) = ast (PVar t : stack) toks -ast stack (TokPartial fp : toks) = ast (PPartial fp : stack) toks -ast stack (TokPreamble t : toks) = ast (PPreamble t : stack) toks -ast stack (TokIf t : toks) = ast (PMetaIf t : stack) toks -ast stack (TokFor t : toks) = ast (PMetaFor t : stack) toks -ast stack (TokEnd : toks) = - let (node, popped, remaining) = popNodes stack - -- ^ Find the last unused if/for statement, and grab all the expressions - -- in-between this TokEnd and the opening if/for keyword. - n = case node of - PMetaIf t -> PIf t popped - PMetaFor t -> PFor t popped - _ -> PMetaEnd - -- Push the statement into the stack - in ast (n : remaining) toks - --- | Pop nodes until we hit a If/For statement. --- Return pair (constructor found, nodes popped, remaining stack) -popNodes :: [PNode] -> (PNode, [PNode], [PNode]) -popNodes = popNodes_ [] - --- | Helper for 'popNodes'. -popNodes_ :: [PNode] -> [PNode] -> (PNode, [PNode], [PNode]) -popNodes_ popped [] = (PMetaEnd, popped, []) -popNodes_ popped (PMetaIf t : rest) = (PMetaIf t, popped, rest) -popNodes_ popped (PMetaFor t : rest) = (PMetaFor t, popped, rest) -popNodes_ popped (t : rest) = popNodes_ (t : popped) rest - --- | Render nodes as string. -renderNodes :: [PNode] -> T.Text -renderNodes = DL.foldl' (\str n -> (T.append str (renderNode n))) "" - --- | Render node as string. -renderNode :: PNode -> T.Text -renderNode (PText t) = t -renderNode (PVar t) = T.append (T.append "${" t) "}" -renderNode (PFor t nodes) = - let for = T.append (T.append "${for(" t) ")}" - body = renderNodes nodes - end = "${end}" - in T.append (T.append for body) end -renderNode (PIf t nodes) = - let for = T.append (T.append "${if(" t) ")}" - body = renderNodes nodes - end = "${end}" - in T.append (T.append for body) end -renderNode (PPartial file) = T.append (T.append "${partial(" file) ")}" -renderNode (PMetaIf v) = renderNode (PIf v []) -renderNode (PMetaFor v) = renderNode (PFor v []) -renderNode PMetaEnd = "" -renderNode (PPreamble _) = "" -- Don't render the PREAMBLE - --- | Render tokens. -renderTokens :: [Token] -> T.Text -renderTokens = DL.foldl' (\str n -> (T.append str (renderToken n))) "" - --- | Render token. -renderToken :: Token -> T.Text -renderToken (TokText t) = t -renderToken (TokVar t) = T.append (T.append "${" t) "}" -renderToken (TokPartial fp) = T.append (T.append "${partial(\"" fp) "\"}" -renderToken (TokFor t) = T.append (T.append "${for(" t) ")}" -renderToken (TokEnd) = "${end}" -renderToken (TokIf t) = T.append (T.append "${if(" t) ")}" -renderToken (TokPreamble _) = "" -- Hide preamble content - --- | Parse text. -parseText :: T.Text -> Either ParseError [PNode] -parseText text = do - toks <- parse parseEverything (T.unpack "") (T.unpack text) - return $ transform toks - --- | Parse everything. --- --- >>> parse parseEverything "" "Hello ${man} and ${woman}." --- Right [TokText "Hello ",TokVar "man",TokText " and ",TokVar "woman",TokText "."] --- --- >>> parse parseEverything "" "Hello ${man} and ${if(woman)} text here ${end}." --- Right [TokText "Hello ",TokVar "man",TokText " and ",TokIf "woman",TokText " text here ",TokEnd,TokText "."] --- --- >>> parse parseEverything "" "Hi ${for(people)} ${name}, ${end} everyone!" --- Right [TokText "Hi ",TokFor "people",TokText " ",TokVar "name",TokText ", ",TokEnd,TokText " everyone!"] --- --- >>> parse parseEverything "" "${realvar} $.get(javascript) $$ $$$ $} $( $45.50 $$escape $${escape2} wonderful life! ${truth}" --- Right [TokVar "realvar",TokText " $.get(javascript) $$ $$$ $} $( $45.50 $$escape ",TokText "${",TokText "escape2} wonderful life! ",TokVar "truth"] --- --- >>> parse parseEverything "" "waffle house ${lyfe}" --- Right [TokPreamble " \n foo: bar\ndo:\n - re\n -me\n ",TokText "waffle house ",TokVar "lyfe"] --- --- >>> parse parseEverything "" "YO ${foo} waffle house ${lyfe}" --- Right [TokText "YO ",TokVar "foo",TokText " ",TokPreamble " \n ${foo}: bar\ndo:\n - re\n -me\n ",TokText "waffle house ",TokVar "lyfe"] --- --- This is a degenerate case that we will just allow (for now) to go sideways: --- >>> parse parseEverything "" "this ${var never closes ${realvar}" --- Right [TokText "this ",TokVar "var never closes ${realvar"] --- -parseEverything :: Parser [Token] -parseEverything = - -- Note that order matters here. We want "most general" to be last (variable - -- names). - many1 (try parsePreamble - <|> try parseEscape - <|> try parseContent - <|> try parseEnd - <|> try parseFor - <|> try parseIf - <|> try parseEnd - <|> try parsePartial - <|> parseVar) - --- >>> parse parseVar "" "${ffwe} yep" --- Right (TokVar "ffwe") --- --- >>> parse parseVar "" "${spaces technically allowed}" --- Right (TokVar "spaces technically allowed") --- --- >>> isLeft $ parse parseVar "" "Hello ${name}" --- True --- --- >>> isLeft $ parse parseVar "" "${}" --- True --- --- | Parse variables. -parseVar :: Parser Token -parseVar = try $ do - _ <- char '$' - _ <- char '{' - varName <- many1 (noneOf "}") - _ <- char '}' - return $ TokVar (T.pack varName) - --- | Parse preamble. -parsePreamble :: Parser Token -parsePreamble = do - _ <- parsePreambleStart - - -- "Note the overlapping parsers anyChar and string "-->", and therefore the - -- use of the try combinator." - -- (https://hackage.haskell.org/package/parsec-3.1.11/docs/Text-Parsec.html) - content <- manyTill anyChar (try (string "-->")) - return $ TokPreamble (T.pack content) - --- | Parse the start of a PREAMBLE. -parsePreambleStart :: Parser String -parsePreambleStart = string " +-- > Hello world ${foo} +-- +-- >>> transform [TokPreamble "foo: bar\ndo:\n - re\n -me", TokText "Hello world ", TokVar "foo"] +-- [PPreamble "foo: bar\ndo:\n - re\n -me",PText "Hello world ",PVar "foo"] +-- +transform :: [Token] -> [PNode] +transform toks = + let stack = ast [] toks + in reverse stack + +-- | Converts Tokens, which is just the raw list of parsed tokens, into PNodes +-- which are the tree-structure expressions (i.e. if/for nesting) +-- +-- This function works by using a stack to keep track of where we are for nested +-- expressions such as if and for statements. When a token that starts a nesting +-- is found (like a TokIf), a "meta" expression (PMetaIf) is pushed into the +-- stack. When we finally see an end token (TokEnd), we pop all the expressions +-- off the stack until the first meta tag (e.g PMetaIf) is reached. All the +-- expressions popped off are now known to be nested inside that if statement. +-- +ast :: [PNode] -- stack + -> [Token] -- remaining + -> [PNode] -- (AST, remaining) +ast stack [] = stack +ast stack (TokText t : toks) = ast (PText t : stack) toks +ast stack (TokVar t : toks) = ast (PVar t : stack) toks +ast stack (TokPartial fp : toks) = ast (PPartial fp : stack) toks +ast stack (TokPreamble t : toks) = ast (PPreamble t : stack) toks +ast stack (TokIf t : toks) = ast (PMetaIf t : stack) toks +ast stack (TokFor t : toks) = ast (PMetaFor t : stack) toks +ast stack (TokEnd : toks) = + let (node, popped, remaining) = popNodes stack + -- ^ Find the last unused if/for statement, and grab all the expressions + -- in-between this TokEnd and the opening if/for keyword. + n = case node of + PMetaIf t -> PIf t popped + PMetaFor t -> PFor t popped + _ -> PMetaEnd + -- Push the statement into the stack + in ast (n : remaining) toks + +-- | Pop nodes until we hit a If/For statement. +-- Return pair (constructor found, nodes popped, remaining stack) +popNodes :: [PNode] -> (PNode, [PNode], [PNode]) +popNodes = popNodes_ [] + +-- | Helper for 'popNodes'. +popNodes_ :: [PNode] -> [PNode] -> (PNode, [PNode], [PNode]) +popNodes_ popped [] = (PMetaEnd, popped, []) +popNodes_ popped (PMetaIf t : rest) = (PMetaIf t, popped, rest) +popNodes_ popped (PMetaFor t : rest) = (PMetaFor t, popped, rest) +popNodes_ popped (t : rest) = popNodes_ (t : popped) rest + +-- | Render nodes as string. +renderNodes :: [PNode] -> T.Text +renderNodes = DL.foldl' (\str n -> (T.append str (renderNode n))) "" + +-- | Render node as string. +renderNode :: PNode -> T.Text +renderNode (PText t) = t +renderNode (PVar t) = T.append (T.append "${" t) "}" +renderNode (PFor t nodes) = + let for = T.append (T.append "${for(" t) ")}" + body = renderNodes nodes + end = "${end}" + in T.append (T.append for body) end +renderNode (PIf t nodes) = + let for = T.append (T.append "${if(" t) ")}" + body = renderNodes nodes + end = "${end}" + in T.append (T.append for body) end +renderNode (PPartial file) = T.append (T.append "${partial(" file) ")}" +renderNode (PMetaIf v) = renderNode (PIf v []) +renderNode (PMetaFor v) = renderNode (PFor v []) +renderNode PMetaEnd = "" +renderNode (PPreamble _) = "" -- Don't render the PREAMBLE + +-- | Render tokens. +renderTokens :: [Token] -> T.Text +renderTokens = DL.foldl' (\str n -> (T.append str (renderToken n))) "" + +-- | Render token. +renderToken :: Token -> T.Text +renderToken (TokText t) = t +renderToken (TokVar t) = T.append (T.append "${" t) "}" +renderToken (TokPartial fp) = T.append (T.append "${partial(\"" fp) "\"}" +renderToken (TokFor t) = T.append (T.append "${for(" t) ")}" +renderToken (TokEnd) = "${end}" +renderToken (TokIf t) = T.append (T.append "${if(" t) ")}" +renderToken (TokPreamble _) = "" -- Hide preamble content + +-- | Parse text. +parseText :: T.Text -> Either ParseError [PNode] +parseText text = do + toks <- parse parseEverything (T.unpack "") (T.unpack text) + return $ transform toks + +-- | Parse everything. +-- +-- >>> parse parseEverything "" "Hello ${man} and ${woman}." +-- Right [TokText "Hello ",TokVar "man",TokText " and ",TokVar "woman",TokText "."] +-- +-- >>> parse parseEverything "" "Hello ${man} and ${if(woman)} text here ${end}." +-- Right [TokText "Hello ",TokVar "man",TokText " and ",TokIf "woman",TokText " text here ",TokEnd,TokText "."] +-- +-- >>> parse parseEverything "" "Hi ${for(people)} ${name}, ${end} everyone!" +-- Right [TokText "Hi ",TokFor "people",TokText " ",TokVar "name",TokText ", ",TokEnd,TokText " everyone!"] +-- +-- >>> parse parseEverything "" "${realvar} $.get(javascript) $$ $$$ $} $( $45.50 $$escape $${escape2} wonderful life! ${truth}" +-- Right [TokVar "realvar",TokText " $.get(javascript) $$ $$$ $} $( $45.50 $$escape ",TokText "${",TokText "escape2} wonderful life! ",TokVar "truth"] +-- +-- >>> parse parseEverything "" "waffle house ${lyfe}" +-- Right [TokPreamble " \n foo: bar\ndo:\n - re\n -me\n ",TokText "waffle house ",TokVar "lyfe"] +-- +-- >>> parse parseEverything "" "YO ${foo} waffle house ${lyfe}" +-- Right [TokText "YO ",TokVar "foo",TokText " ",TokPreamble " \n ${foo}: bar\ndo:\n - re\n -me\n ",TokText "waffle house ",TokVar "lyfe"] +-- +-- This is a degenerate case that we will just allow (for now) to go sideways: +-- >>> parse parseEverything "" "this ${var never closes ${realvar}" +-- Right [TokText "this ",TokVar "var never closes ${realvar"] +-- +parseEverything :: Parser [Token] +parseEverything = + -- Note that order matters here. We want "most general" to be last (variable + -- names). + many1 (try parsePreamble + <|> try parseEscape + <|> try parseContent + <|> try parseEnd + <|> try parseFor + <|> try parseIf + <|> try parseEnd + <|> try parsePartial + <|> parseVar) + +-- >>> parse parseVar "" "${ffwe} yep" +-- Right (TokVar "ffwe") +-- +-- >>> parse parseVar "" "${spaces technically allowed}" +-- Right (TokVar "spaces technically allowed") +-- +-- >>> isLeft $ parse parseVar "" "Hello ${name}" +-- True +-- +-- >>> isLeft $ parse parseVar "" "${}" +-- True +-- +-- | Parse variables. +parseVar :: Parser Token +parseVar = try $ do + _ <- char '$' + _ <- char '{' + varName <- many1 (noneOf "}") + _ <- char '}' + return $ TokVar (T.pack varName) + +-- | Parse preamble. +parsePreamble :: Parser Token +parsePreamble = do + _ <- parsePreambleStart + + -- "Note the overlapping parsers anyChar and string "-->", and therefore the + -- use of the try combinator." + -- (https://hackage.haskell.org/package/parsec-3.1.11/docs/Text-Parsec.html) + content <- manyTill anyChar (try (string "-->")) + return $ TokPreamble (T.pack content) + +-- | Parse the start of a PREAMBLE. +parsePreambleStart :: Parser String +parsePreambleStart = string "