pencil 0.1.0 → 0.1.1
raw patch · 9 files changed
+1155/−986 lines, 9 filesdep +semigroupsdep ~basedep ~directorydep ~pandocnew-component:exe:pencil-example-blog
Dependencies added: semigroups
Dependency ranges changed: base, directory, pandoc, text, time, unordered-containers
Files
- CHANGELOG.md +10/−0
- README.md +57/−2
- examples/Blog/Main.hs +65/−0
- pencil.cabal +21/−8
- src/Pencil.hs +2/−2
- src/Pencil/Blog.hs +59/−37
- src/Pencil/Internal.hs +0/−932
- src/Pencil/Internal/Env.hs +6/−5
- src/Pencil/Internal/Pencil.hs +935/−0
CHANGELOG.md view
@@ -4,6 +4,16 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/). +## [0.1.1](https://github.com/elben/pencil/)++### Added+- Blog example.+- Minor method changes.++### Changed+- Bounds changed for ghc 8.0.2 and 8.2.2 support.+- Improved documentation.+ ## [0.1.0](https://github.com/elben/pencil/) ### Added
README.md view
@@ -1,3 +1,5 @@+[](https://travis-ci.org/elben/pencil)+ # Pencil Pencil is a static site generator. Use it to generate your personal website!@@ -10,15 +12,24 @@ # 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:+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: ``` stack build stack exec pencil-example-simple ``` -Open the `examples/Simple/out/` folder to see the rendered web pages.+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: +```+cd examples/Simple/out/+python -m SimpleHTTPServer 8000+```++And go to [localhost:8000](http://localhost:8000).+ # Development ```bash@@ -38,4 +49,48 @@ ```bash stack install hasktags hasktags --ignore-close-implementation --ctags .+```++## Release++Make sure it builds, passes tests, and works:++```+stack build+stack test+stack exec pencil-example-simple+stack exec pencil-example-blog+stack haddock+```++Check that tutorials are updated.++Update the CHANGELOG.md.++Update the version number in `pencil.cabal`.++Commit the changes.++Tag the release:++```+git tag v0.1.0+git push --tags+```++Push to Hackage:++```+stack sdist+stack upload+```++## Travis CI++[travis-ci.org/elben/pencil](https://travis-ci.org/elben/pencil)++Note that `.travis.yml` was generated using [multi-ghc-travis](https://github.com/haskell-hvr/multi-ghc-travis) this:++```+stack exec runghc ~/code/multi-ghc-travis/make_travis_yml_2.hs pencil.cabal > .travis.yml ```
+ examples/Blog/Main.hs view
@@ -0,0 +1,65 @@+{-# 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+
pencil.cabal view
@@ -1,5 +1,5 @@ name: pencil-version: 0.1.0+version: 0.1.1 synopsis: Static site generator description: Pencil is a static site generator. Use it to generate your personal website!@@ -15,27 +15,30 @@ build-type: Simple extra-source-files: README.md, CHANGELOG.md cabal-version: >=1.10+tested-with: GHC == 8.0.2,+ GHC == 8.2.2 library hs-source-dirs: src exposed-modules: Pencil , Pencil.Blog- , Pencil.Internal+ , Pencil.Internal.Pencil , Pencil.Internal.Env , Pencil.Internal.Parser- build-depends: base >= 4.7 && < 5+ build-depends: base >= 4.8 && < 5 , data-default >= 0.7 && < 1- , directory >= 1.3 && < 1.4+ , directory >= 1.2.5.0 && < 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+ , pandoc >= 1.19.2.4 && < 2+ , semigroups >= 0.18.2 && < 0.19 , parsec >= 3.1 && < 3.2 , text >= 1.2.2 && < 1.3- , time >= 1.6 && < 1.7+ , time >= 1.5.0.1 && < 1.9 , unordered-containers >= 0.2.7.2 && < 0.3 , vector >= 0.12.0 && < 0.13 , xml >= 1.3.10 && < 1.4@@ -46,7 +49,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs- build-depends: base+ build-depends: base >= 4.8 && < 5 , pencil , doctest >= 0.11.4 && < 0.12 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N@@ -56,8 +59,18 @@ hs-source-dirs: examples/Simple main-is: Main.hs ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- build-depends: base+ build-depends: base >= 4.8 && < 5 , pencil+ default-language: Haskell2010++executable pencil-example-blog+ hs-source-dirs: examples/Blog+ main-is: Main.hs+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends: base >= 4.8 && < 5+ , pencil+ , unordered-containers+ , text default-language: Haskell2010 source-repository head
src/Pencil.hs view
@@ -76,7 +76,7 @@ ) where -import Pencil.Internal+import Pencil.Internal.Pencil import Control.Monad.Reader as Reader @@ -177,7 +177,7 @@ -- 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'.+-- a blog, look at the Pencil.Blog module. ----------------------------------------------------------------------
src/Pencil/Blog.hs view
@@ -9,6 +9,7 @@ loadBlogPosts , blogPostUrl , injectTitle+ , buildTagPagesWith , buildTagPages , injectTagsEnv ) where@@ -25,6 +26,9 @@ -- $gettingstarted -- -- This module provides a standard way of building and generating blog posts.+-- Check out the Blog example+-- <https://github.com/elben/pencil/blob/master/examples/Blog/ here>.+-- -- To generate a blog for your website, first create a @blog/@ directory in -- your web page source directory. --@@ -33,50 +37,38 @@ -- > 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:+-- least @postTitle@ and @date@ defined. The other ones are optional. -- -- > <!--PREAMBLE -- > postTitle: "Behind Python's unittest.main()" -- > date: 2010-01-30--- > -->------ 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@:------ > <!--PREAMBLE--- > ... -- > draft: true -- > tags: -- > - python -- > --> ----- Then, use 'loadBlogPosts' to load the entire @blog/@ directory.------ @--- posts <- 'loadBlogPosts' "blog/"--- forM_ posts render--- @+-- 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. ----- 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.+-- 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))+-- render (fmap (layout <|| postLayout <|) posts) -- @ -- --- | Loads the given directory as a series of blog 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. -- -- @ -- posts <- loadBlogPosts "blog/"--- forM_ posts render -- @ loadBlogPosts :: FilePath -> PencilApp [Page] loadBlogPosts fp = do@@ -119,19 +111,46 @@ 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.+-- | Helper of 'buildTagPagesWith' defaulting to the variable name @posts@, and+-- the tag index page file path @blog\/tags\/my-tag-name\/@.+--+-- @+-- tagPages <- buildTagPages pages+-- @+-- 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++buildTagPages tagPageFp =+ buildTagPagesWith+ tagPageFp+ "posts"+ (\tag _ -> "blog/tags/" ++ T.unpack tag ++ "/")++-- | Build the tag index pages.+--+-- Given blog post @Page@s with @tags@ variables in its PREAMBLE, builds @Page@s that+-- contain in its environment the list of @Page@s that were tagged with that+-- particular tag. Returns a map of tag of the tag index page.+--+-- @+-- tagPages <- buildTagPagesWith+-- "tag-list.html"+-- "posts"+-- (\tag _ -> "blog/tags/" ++ 'Data.Text.unpack' tag ++ "/")+-- posts+-- @+buildTagPagesWith :: 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)+buildTagPagesWith tagPageFp pagesVar fpf pages = do env <- asks getEnv let tagMap = groupByElements "tags" pages@@ -146,14 +165,15 @@ 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 = -- 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 =+ let envs = case H.lookup "tags" (getPageEnv page) of Just (VArray tags) ->- VEnvList $ L.foldl' (\acc envData -> case envData of@@ -163,11 +183,13 @@ _ -> 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)+ env' = if null envs+ then getPageEnv page+ else insertEnv "tags" (VEnvList envs) (getPageEnv page) in setPageEnv env' page
− src/Pencil/Internal.hs
@@ -1,932 +0,0 @@-{-# 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 <https://en.wikipedia.org/wiki/Matryoshka_doll Russian nesting dolls>.--- 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\>\<\/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 @\<title\>@ 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)-
src/Pencil/Internal/Env.hs view
@@ -9,12 +9,9 @@ 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. ----- Represents the data types found in an environment. This includes at least--- Data.Aeson Value type+-- 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 =@@ -26,8 +23,10 @@ | 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@@ -82,6 +81,8 @@ 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
+ src/Pencil/Internal/Pencil.hs view
@@ -0,0 +1,935 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}++module Pencil.Internal.Pencil 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. 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'++-- | 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' 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++----------------------------------------------------------------------+-- 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 <https://en.wikipedia.org/wiki/Matryoshka_doll Russian nesting dolls>.+-- 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\>\<\/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 @\<title\>@ tag.+--+-- In this way, @Structure@ allows efficient @Page@ reuse. See the private+-- function '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 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)++-- This requires FlexibleInstances.+instance Render r => Render [r] where+ render rs = forM_ rs render