diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,19 @@ +# CHANGELOG + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/). + +## [0.1.0](https://github.com/elben/pencil/) + +### Added +- First release. + +## [0.0.0](https://github.com/elben/pencil/) + +### Added +### Changed +### Fixed +### Removed +### Deprecated +### Security diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Elben Shira (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Elben Shira nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,41 @@ +# 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. + +> The blue-backed notebooks, the two pencils and the pencil sharpener... the +> marble topped tables, the smell of early morning... and luck were all you +> needed. — Ernest Hemingway, A Moveable Feast + +# Examples + +Checkout the [examples provided](https://github.com/elben/pencil/blob/master/test/Example/). To run the [Simple](https://github.com/elben/pencil/blob/master/test/Example/Simple) example: + +``` +stack build +stack exec pencil-example-simple +``` + +Open the `examples/Simple/out/` folder to see the rendered web pages. + +# Development + +```bash +stack build --pedantic +stack test +stack exec doctest src/ +``` + +## Documentation + +``` +stack haddock +``` + +## Ctags + +```bash +stack install hasktags +hasktags --ignore-close-implementation --ctags . +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/Simple/Main.hs b/examples/Simple/Main.hs new file mode 100644 --- /dev/null +++ b/examples/Simple/Main.hs @@ -0,0 +1,22 @@ +{-# 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/pencil.cabal b/pencil.cabal new file mode 100644 --- /dev/null +++ b/pencil.cabal @@ -0,0 +1,65 @@ +name: pencil +version: 0.1.0 +synopsis: Static site generator +description: + 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. +homepage: https://github.com/elben/pencil +license: BSD3 +license-file: LICENSE +author: Elben Shira +maintainer: elbenshira@gmail.com +copyright: 2018 Elben Shira +category: Web +build-type: Simple +extra-source-files: README.md, CHANGELOG.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Pencil + , Pencil.Blog + , Pencil.Internal + , Pencil.Internal.Env + , Pencil.Internal.Parser + build-depends: base >= 4.7 && < 5 + , data-default >= 0.7 && < 1 + , directory >= 1.3 && < 1.4 + , edit-distance >= 0.2.2.1 && < 0.3 + , feed >= 0.3.12.0 && < 1 + , filepath >= 1.4 && < 1.5 + , hashable >= 1.2.6.0 && < 1.3 + , hsass >= 0.4.0 && < 0.5 + , mtl >= 2.2 && < 3 + , pandoc >= 1.19.2 && < 2 + , parsec >= 3.1 && < 3.2 + , text >= 1.2.2 && < 1.3 + , time >= 1.6 && < 1.7 + , unordered-containers >= 0.2.7.2 && < 0.3 + , vector >= 0.12.0 && < 0.13 + , xml >= 1.3.10 && < 1.4 + , yaml >= 0.8.23 && < 0.9 + default-language: Haskell2010 + +test-suite pencil-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , pencil + , doctest >= 0.11.4 && < 0.12 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +executable pencil-example-simple + hs-source-dirs: examples/Simple + main-is: Main.hs + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , pencil + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/elben/pencil diff --git a/src/Pencil.hs b/src/Pencil.hs new file mode 100644 --- /dev/null +++ b/src/Pencil.hs @@ -0,0 +1,287 @@ +module Pencil + ( + -- * Getting started + -- + -- $gettingstarted + + -- * Templates + -- + -- $templates + + PencilApp + , run + + -- * Pages, Structures and Resources + -- + -- $pagesStructuresResources + + , Page + , getPageEnv, setPageEnv + , load + , withEnv + , renderCss + + , Structure + , (<||) + , (<|) + , structure + + , Resource + , loadResource + , loadResources + , passthrough + , listDir + + , Render(..) + , toHtml + , toDir + , toCss + , toExpected + + -- * Environment Manipulation + + , merge + , insertEnv + , insertText + , insertPages + , updateEnvVal + , sortByVar + , filterByVar + , groupByElements + + -- * Configuration + + , Config + , defaultConfig + , getSourceDir, setSourceDir + , getOutputDir, setOutputDir + , getEnv, setEnv, updateEnv + , getDisplayValue, setDisplayValue + , getSassOptions, setSassOptions + , getPandocReaderOptions, setPandocReaderOptions + , getPandocWriterOptions, setPandocWriterOptions + + -- * Utils and re-exports + + , FileType + , fileType + , toExtension + + -- Re-exports + , Reader.asks + + -- * Error handling + + , PencilException + + ) where + +import Pencil.Internal + +import Control.Monad.Reader as Reader + +---------------------------------------------------------------------- + +-- $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. +-- +-- @index.markdown@ is a pretty basic Markdown file, and @style.scss@ is a +-- file. +-- +-- Now let's look inside @Main.hs@: +-- +-- > 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 +-- +-- 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. +-- +-- To learn more, read through the documentation found in this module. To build +-- a blog, look at 'Pencil.Blog'. + +---------------------------------------------------------------------- + +-- $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. +-- +-- === For loop +-- +-- 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. +-- +-- >
    +-- > ${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} + +---------------------------------------------------------------------- + +-- $pagesStructuresResources +-- +-- 'Page', 'Structure' and 'Resource' are the "big three" data types you need to +-- know to effectively use Pencil. + +---------------------------------------------------------------------- diff --git a/src/Pencil/Blog.hs b/src/Pencil/Blog.hs new file mode 100644 --- /dev/null +++ b/src/Pencil/Blog.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Pencil.Blog + ( + -- * Getting started + -- + -- $gettingstarted + -- + loadBlogPosts + , blogPostUrl + , injectTitle + , buildTagPages + , injectTagsEnv + ) where + +import Pencil +import Pencil.Internal.Env +import Control.Monad (liftM, 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. +-- 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 the following variables: +-- +-- > +-- +-- You can also 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. +-- +-- @ +-- posts <- 'loadBlogPosts' "blog/" +-- forM_ posts render +-- @ +-- +-- You probably will want to enclose your blog posts in your web site's +-- layout, however. 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/" +-- forM_ posts (\\post -> render (layout <|| postLayout <| post)) +-- @ +-- + +-- | Loads the given directory as a series of blog posts. +-- +-- @ +-- posts <- loadBlogPosts "blog/" +-- forM_ posts render +-- @ +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) + +-- | 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)) ++ "/" + +-- | Given that the current @Page@ has a @postTitle@ in the environment, inject +-- the post title into the @title@ environment variable, prefixed with the given +-- title prefix. +-- +-- This is useful for generating the @\${title}\@ tags in your +-- container layout. +-- +-- @ +-- 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. + -> Page + -> Page +injectTitle titlePrefix page = + let title = case H.lookup "postTitle" (getPageEnv page) of + Just (VText t) -> T.append (T.append t " - ") titlePrefix + _ -> titlePrefix + env' = insertText "title" title (getPageEnv page) + in setPageEnv env' page + +type Tag = T.Text + +-- | Given Pages with @tags@ variables in its environments, builds Pages that +-- contain in its environment the list of Pages that were tagged with that +-- particular tag. +buildTagPages :: FilePath + -- ^ Partial to load for the Tag index pages + -> T.Text + -- ^ 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. + -> [Page] + -> PencilApp (H.HashMap Tag Page) +buildTagPages tagPageFp pagesVar fpf pages = do + env <- asks getEnv + + let tagMap = groupByElements "tags" pages + -- Build a mapping of tag to the tag list Page + + foldM + (\acc (tag, taggedPosts) -> do + tagPage <- load (fpf tag) tagPageFp + let tagEnv = (insertPages pagesVar taggedPosts . insertText "tag" tag . merge (getPageEnv tagPage)) env + return $ H.insert tag (setPageEnv tagEnv tagPage) acc + ) + H.empty + (H.toList tagMap) + +injectTagsEnv :: H.HashMap Tag Page -> Page -> Page +injectTagsEnv 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 tagEnvList = + case H.lookup "tags" (getPageEnv page) of + Just (VArray tags) -> + VEnvList $ + L.foldl' + (\acc envData -> + case envData of + VText tag -> + case H.lookup tag tagMap of + Just tagIndexPage -> getPageEnv tagIndexPage : acc + _ -> acc + _ -> acc) + [] tags + _ -> VEnvList [] + + -- Overwrite the VArray "tags" variable in the post Page with VEnvList of the + -- loaded Tag index pages. This is so that when we render the blog posts, we + -- have access to the URL of the Tag index. + env' = insertEnv "tags" tagEnvList (getPageEnv page) + in setPageEnv env' page + diff --git a/src/Pencil/Internal.hs b/src/Pencil/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Pencil/Internal.hs @@ -0,0 +1,932 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} + +module Pencil.Internal where + +import Pencil.Internal.Env +import Pencil.Internal.Parser + +import Control.Exception (tryJust) +import Control.Monad (forM_, foldM, filterM, liftM) +import Control.Monad.Except +import Control.Monad.Reader +import Data.Char (toLower) +import Data.Default (Default) +import Data.List.NonEmpty (NonEmpty(..)) -- Import the NonEmpty data constructor, (:|) +import Data.Text.Encoding (encodeUtf8, decodeUtf8) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import GHC.IO.Exception (IOException(ioe_description, ioe_filename, ioe_type), IOErrorType(NoSuchThing)) +import Text.EditDistance (levenshteinDistance, defaultEditCosts) +import Text.Sass.Options (defaultSassOptions) +import Data.Hashable (Hashable) +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 Data.Yaml as A +import qualified System.Directory as D +import qualified System.FilePath as FP +import qualified Text.Pandoc as P +import qualified Text.Sass as Sass + +-- | The main 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) + +-- | The main @Config@ needed to build your website. Your app's @Config@ is +-- passed into the '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 +-- , 'configPandocWriterOptions' = Text.Pandoc.def { Text.Pandoc.writerHighlight = True } +-- , 'configDisplayValue = 'toText' +-- } +-- @ +-- +defaultConfig :: Config +defaultConfig = Config + { configSourceDir = "site/" + , configOutputDir = "out/" + , configEnv = H.empty + , configSassOptions = Text.Sass.Options.defaultSassOptions + , configPandocReaderOptions = P.def + , configPandocWriterOptions = P.def { P.writerHighlight = True } + , configDisplayValue = toText + } + +-- | The directory path 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 } + +-- | The directory path 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 } + +-- | The 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 'withEnv' if you +-- want to 'render' things in a modified environment. +setEnv :: Env -> Config -> Config +setEnv env c = c { configEnv = env } + +-- | Update the 'Env' inside the 'Config'. +updateEnv :: (Env -> Env) -> Config -> Config +updateEnv f c = c { configEnv = f (getEnv c) } + +-- | The 'Sass.SassOptions' for rendering Sass/Scss files. +getSassOptions :: Config -> Sass.SassOptions +getSassOptions = configSassOptions + +-- | Sets the 'Sass.SassOptions'. +setSassOptions :: Sass.SassOptions -> Config -> Config +setSassOptions env c = c { configSassOptions = env } + +-- | The 'Text.Pandoc.ReaderOptions' for reading files that use Pandoc. +-- Supported formats by Pencil are: Markdown. +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 } + +-- | The 'Text.Pandoc.WriterOptions' for rendering files that use Pandoc. +-- Supported formats by Pencil are: Markdown. +getPandocWriterOptions :: Config -> P.WriterOptions +getPandocWriterOptions = configPandocWriterOptions + +-- | Sets the 'Text.Pandoc.WriterOptions'. +setPandocWriterOptions :: P.WriterOptions -> Config -> Config +setPandocWriterOptions o c = c { configPandocWriterOptions = o } + +-- | 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. '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 } + +-- | 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 err -> + case err of + FileNotFound mfp -> + case mfp of + Just fp -> do + e2 <- runExceptT $ runReaderT (mostSimilarFile fp) config + case e2 of + Left _ -> return () + Right mBest -> + case mBest of + Just best -> putStrLn ("Maybe you mean this: " ++ best) + Nothing -> return () + Nothing -> return () + VarNotInEnv var fp -> + putStrLn ("Variable ${" ++ T.unpack var ++ "}" ++ " not found in the environment when rendering file " ++ fp ++ ".") + _ -> return () + Right _ -> return () + +-- | Given a file path, look at all file paths and find the one that seems most +-- similar. +mostSimilarFile :: FilePath -> PencilApp (Maybe FilePath) +mostSimilarFile fp = do + sitePrefix <- asks getSourceDir + fps <- listDir True "" + let fps' = map (sitePrefix ++) fps -- add site prefix for distance search + let costs = map (\f -> (f, levenshteinDistance defaultEditCosts fp f)) fps' + let sorted = L.sortBy (\(_, d1) (_, d2) -> compare d1 d2) costs + return $ fst <$> M.listToMaybe sorted + +-- | Known Pencil errors that we know how to either recover from or quit +-- gracefully. +data PencilException + = NotTextFile IOError + -- ^ 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. + | VarNotInEnv T.Text FilePath + -- ^ Variable is not in the environment. Variable name, and file where the + -- variable was reference. + deriving (Typeable, Show) + +-- | 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 toLower (drop 1 (FP.takeExtension fp))) fileTypeMap) + +-- | The Page is an important data type in Pencil. It contains the parsed +-- template of a file (e.g. of Markdown or HTML files). It may have template +-- directives (e.g. @${body}@) that has not yet been rendered, and an +-- environment loaded from the preamble section of the file. A Page also +-- contains 'pageFilePath', which is the output file path. +data Page = Page + { pageNodes :: [PNode] + , 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. + } deriving (Eq, Show) + +-- | Returns the 'Env' from a 'Page'. +getPageEnv :: Page -> Env +getPageEnv = pageEnv + +-- | Sets the 'Env' in a 'Page'. +setPageEnv :: Env -> Page -> Page +setPageEnv env p = p { pageEnv = env } + +-- | 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 Nodes of the fully rendered page, the +-- fully-applied environment, and the URL of the last (inner-most) Page. +-- +-- The variable application works by applying the outer environments down into +-- the inner environments, until it hits the lowest environment, in which the +-- page is rendered. Once done, this rendered content is saved as the @${body}@ +-- variable for the parent structure, which is then applied, 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 the markdown file's 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 pages = apply_ (NE.reverse pages) + +-- | Apply @Structure@ and convert to @Page@. +-- +-- It's simpler to implement if NonEmpty is ordered outer-structure first (e.g. +-- HTML layout). +apply_ :: Structure -> PencilApp Page +apply_ (Page nodes penv fp :| []) = do + env <- asks getEnv + let env' = merge penv env + nodes' <- evalNodes env' nodes `catchError` setVarNotInEnv fp + return $ Page nodes' env' fp +apply_ (Page nodes penv _ :| (headp : rest)) = do + -- Modify the current env (in the ReaderT) with the one in the page (penv) + -- Then call apply_ on the inner Pages to accumulate the inner Page + -- environments. + Page nodesInner envInner fpInner <- local (\c -> setEnv (merge penv (getEnv c)) c) + (apply_ (headp :| rest)) + + -- Render the inner nodes, and inject into this environment's "body" var. + let env' = insertEnv "body" (VText (renderNodes nodesInner)) envInner + + -- Evaluate this current Page's nodes with the accumualted environemnt of all + -- the inner Pages. + nodes' <- evalNodes env' nodes `catchError` setVarNotInEnv fpInner + + -- Use inner-most Page's file path, as this will be the destination of the + -- accumluated, final, rendered page. + return $ Page nodes' env' fpInner + +-- | Helper to inject a file path into a VarNotInEnv exception. Rethrow the +-- exception afterwards. +setVarNotInEnv :: FilePath -> PencilException -> PencilApp a +setVarNotInEnv fp (VarNotInEnv var _) = throwError $ VarNotInEnv var fp +setVarNotInEnv _ e = throwError e + +-- | 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 the IOError to a known 'PencilException'. +-- +-- How to test errors: +-- +-- @ +-- import Control.Exception +-- import qualified Data.Text.IO as TIO +-- +-- (\e -> print (ioe_description (e :: IOError)) >> return "") `handle` (TIO.readFile "foo") +-- @ +-- +toPencilException :: IOError -> Maybe PencilException +toPencilException e + | isInvalidByteSequence e = Just (NotTextFile 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 + +-- | 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 + case P.readMarkdown pandocReaderOptions (T.unpack content) of + Left _ -> return content + Right pandoc -> return $ T.pack $ P.writeHtmlString pandocWriterOptions pandoc + 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) + +-- | 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; throw exception. + throwError (VarNotInEnv var "") + 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; throw exception. + throwError (VarNotInEnv var "") + 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' + +-- | Sort given @Page@s by the specified 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 + (\(Page _ enva _) (Page _ envb _) -> + maybeOrdering ordering (H.lookup var enva) (H.lookup var envb)) + +-- | Filter 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 + (\(Page _ env _) -> M.fromMaybe includeMissing (H.lookup var env >>= (Just . f))) + +-- | Given a variable (whose value is assumed to be an array of VText) and list +-- of pages, group 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@(Page _ env _) -> + let x = H.lookup var env + 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) + +-- | Loads file in given directory as 'Resource's. +loadResources :: (FilePath -> FilePath) + -> Bool + -- ^ Recursive if @True@. + -> Bool + -- ^ Handle as pass-throughs (file copy) if @True@. + -> FilePath + -> PencilApp [Resource] +loadResources fpf recursive pass dir = do + fps <- listDir recursive dir + if pass + then return $ map (\fp -> Passthrough fp fp) fps + else mapM (loadResource fpf) fps + +-- | 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' = FP.addTrailingPathSeparator dir + fps <- listDir_ recursive dir' + return $ map (dir' ++) fps + +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 + +---------------------------------------------------------------------- +-- Environment modifications +---------------------------------------------------------------------- + +-- | Merges two @Env@s together, biased towards the left-hand @Env@ on duplicates. +merge :: Env -> Env -> Env +merge = H.union + +-- | Insert 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) + +-- | Insert @Page@s into the given @Env@. +-- +-- @ +-- posts <- 'Pencil.Blog.loadBlogPosts' "blog/" +-- env <- asks 'getEnv' +-- insertPages "posts" posts env +-- @ +insertPages :: T.Text + -- ^ Environment variable name. + -> [Page] + -- ^ @Page@s to insert. + -> Env + -- ^ Environment to modify. + -> Env +insertPages var posts = H.insert var (VEnvList (map getPageEnv posts)) + +-- | Modify a variable in the given environment. +updateEnvVal :: (Value -> Value) + -> T.Text + -- ^ Environment variable name. + -> Env + -> Env +updateEnvVal = H.adjust + +-- | Insert @Value@ into the given @Env@. +insertEnv :: T.Text + -- ^ Environment variable name. + -> Value + -- ^ @Value@ to insert. + -> Env + -- ^ Environment to modify. + -> Env +insertEnv = H.insert + +-- | Convert known Aeson types into known Env types. +maybeInsertIntoEnv :: Env -> T.Text -> A.Value -> Env +maybeInsertIntoEnv env k v = + case toValue v of + Nothing -> env + Just d -> H.insert k d env + +-- | Converts an Aeson Object to an Env. +aesonToEnv :: A.Object -> Env +aesonToEnv = H.foldlWithKey' maybeInsertIntoEnv H.empty + + +-- | Use @Resource@ to load and render files that don't need any manipulation +-- other than conversion (e.g. Sass to CSS), or for static files that you want +-- to copy as-is (e.g. binary files like images, or text files that require no +-- other processing). +-- +-- Use 'passthrough', 'loadResource' and '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 +-- loadResources id True True "images/" >> render +-- @ +-- +data Resource + = Single Page + | Passthrough FilePath FilePath + -- ^ in and out file paths + +-- | Copy file from source to output dir. +copyFile :: FilePath -> FilePath -> PencilApp () +copyFile fpIn fpOut = do + sitePrefix <- asks getSourceDir + outPrefix <- asks getOutputDir + liftIO $ D.createDirectoryIfMissing True (FP.takeDirectory (outPrefix ++ fpOut)) + liftIO $ D.copyFile (sitePrefix ++ fpIn) (outPrefix ++ fpOut) + +-- | Replaces the file path's extension with @.html@. +-- +-- @ +-- 'load' toHtml "about.markdown" +-- @ +-- +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 FilePath is rendered as an index file in that +-- directory. For example, the @pages/about.html@ is transformed into +-- @pages\/about\/@, which 'render' would render the 'Page' to the file path +-- @pages\/about\/index.html@. +-- +toDir :: FilePath -> FilePath +toDir fp = FP.replaceFileName fp (FP.takeBaseName fp) ++ "/" + +-- | Replaces the file path's extension with @.css@. +-- +-- @ +-- 'load' toCss "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. +-- +-- @ +-- -- Load everything inside the "assets/" folder, renaming converted files as +-- -- expected, and leaving everything else alone. +-- 'loadResources' toExpected True True "assets/" +-- @ +toExpected :: FilePath -> FilePath +toExpected fp = maybe fp ((FP.dropExtension fp ++ ".") ++) (toExtension (fileType fp)) + +-- | Loads a file as a 'Resource'. Use this for binary files (e.g. images) and +-- for files without template directives. Regular files are still converted to +-- their web page formats (e.g. Markdown to HTML, SASS to CSS). +-- +-- @ +-- -- Loads and renders the image as-is. Underneath the hood +-- -- this is just a file copy. +-- loadResource id "images/profile.jpg" >> render +-- +-- -- Loads and renders to about.index +-- loadResource toHtml "about.markdown" >> render +-- @ +loadResource :: (FilePath -> FilePath) -> FilePath -> PencilApp Resource +loadResource fpf 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). + liftM Single (load fpf fp) + `catchError` handle + -- 'handle' requires FlexibleContexts + where handle e = case e of + NotTextFile _ -> return (Passthrough fp (fpf fp)) + _ -> throwError e + +-- | 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 +-- @ +-- +passthrough :: FilePath -> PencilApp Resource +passthrough fp = return $ Passthrough fp fp + +-- | Loads a file into 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. The 'Page''s 'pageFilePath' is determined by the given +-- function, which expects the original file path, and returns the designated file +-- path. +-- +-- The Page's designated file path is calculated and stored in the Page's +-- environment in the variable @this.url@. This allows the template to use +-- @${this.url}@ to refer to the designated file path. +-- +-- Example: +-- +-- @ +-- -- Loads index.markdown with the designated file path of index.html +-- load 'toHtml' "index.markdown" +-- +-- -- Keep the file path as-is +-- load id "about.html" +-- @ +-- +load :: (FilePath -> FilePath) -> FilePath -> PencilApp Page +load fpf fp = do + (_, nodes) <- parseAndConvertTextFiles fp + let env = findEnv nodes + let fp' = "/" ++ fpf fp + let env' = H.insert "this.url" (VText (T.pack fp')) env + return $ Page nodes env' ("/" ++ fpf fp) + +-- | Find preamble node, and load as an Env. If no preamble is found, return a +-- blank Env. +findEnv :: [PNode] -> Env +findEnv nodes = + aesonToEnv $ M.fromMaybe H.empty (findPreambleText nodes >>= (A.decode . encodeUtf8 . T.strip)) + +-- | Loads and renders file as CSS. +-- +-- @ +-- -- Load, convert and render as style.css. +-- renderCss "style.sass" +-- @ +renderCss :: FilePath -> PencilApp () +renderCss fp = + -- Drop .scss/sass extension and replace with .css. + load toCss fp >>= render + +-- | 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 @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 'structure', '<||' and '<|'. +-- +-- @ +-- layout <- load toHtml "layout.html" +-- index <- load toHtml "index.markdown" +-- about <- load toHtml "about.markdown" +-- render (layout <|| index) +-- render (layout <|| about) +-- @ +-- +-- In the example above we load a layout @Page@, which can be an HTML page +-- defining the outer structures like @\\<\/html\>@. Assuming @layout.html@ +-- has the template directive @${body}@ (note that @body@ is a special variable +-- generated during structure-building), @layout <|| index@ +-- tells 'render' that you want the rendered body of @index@ to be injected into +-- the @${body}@ directive inside of @layout@. +-- +-- @Structure@s also control the closure of variables. Variables defined in a +-- @Page@s are accessible both by @Page@s above and below. This allows inner +-- @Page@s to define variables like the blog post title, which may be used in +-- the outer @Page@ to set the @\@ tag. +-- +-- In this way, @Structure@ allows efficient @Page@ reuse. See the private +-- function 'Pencil.Internal.apply' to learn more about how @Structure@s are +-- evaluated. +-- +-- Note that this differs than 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. The partial has has +-- the same environment as the parent context. +type Structure = NonEmpty Page + +-- | Creates a new @Structure@ from two @Page@s. +-- +-- @ +-- layout <- load toHtml "layout.html" +-- index <- load toHtml "index.markdown" +-- render (layout <|| index) +-- @ +(<||) :: Page -> Page -> Structure +(<||) x y = y :| [x] + +-- | Pushes @Page@ into @Structure@. +-- +-- @ +-- layout <- load toHtml "layout.html" +-- blogLayout <- load toHtml "blog-layout.html" +-- blogPost <- load toHtml "myblogpost.markdown" +-- render (layout <|| blogLayout <| blogPost) +-- @ +(<|) :: Structure -> Page -> Structure +(<|) ne x = NE.cons x ne + +-- | Converts a @Page@ into a @Structure@. +structure :: Page -> Structure +structure p = p :| [] + +-- | Runs the computation with the given environment. This is useful when you +-- want to render a 'Page' or 'Structure' with a modified environment. +-- +-- @ +-- withEnv ('insertText' "newvar" "newval" env) ('render' page) +-- @ +-- +withEnv :: Env -> PencilApp a -> PencilApp a +withEnv env = local (setEnv env) + +-- | To render something is to create the output web pages, rendering 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 [Resource] where + render resources = forM_ resources render + +-- This requires FlexibleInstances. +instance Render Structure where + render s = apply s >>= render + +instance Render Page where + render (Page nodes _ fpOut) = do + outPrefix <- asks getOutputDir + let noFileName = FP.takeBaseName fpOut == "" + let fpOut' = outPrefix ++ if noFileName then fpOut ++ "index.html" else fpOut + liftIO $ D.createDirectoryIfMissing True (FP.takeDirectory fpOut') + liftIO $ TIO.writeFile fpOut' (renderNodes nodes) + diff --git a/src/Pencil/Internal/Env.hs b/src/Pencil/Internal/Env.hs new file mode 100644 --- /dev/null +++ b/src/Pencil/Internal/Env.hs @@ -0,0 +1,92 @@ +{-# 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 + +-- We should use that hack that allows ppl to extend this with their own types? +-- Example: we want a "tags" type for a list of blog post tags +-- https://two-wrongs.com/dynamic-dispatch-in-haskell-how-to-make-code-extendable +-- +-- 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) + +type Env = H.HashMap T.Text 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 + +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 new file mode 100644 --- /dev/null +++ b/src/Pencil/Internal/Parser.hs @@ -0,0 +1,377 @@ +{-# 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) + +-- >>> 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"] +-- +-- | Convert Tokens to PNode AST. +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 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 wonderful life! ${truth}" +-- Right [TokVar "realvar",TokText " $.get(javascript) $$ $$$ $} $( $45.50 $$escape 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"] +-- +-- | Parse everything. +-- +parseEverything :: Parser [Token] +parseEverything = + -- Note that order matters here. We want "most general" to be last (variable + -- names). + many1 (try parsePreamble + <|> 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 "