diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for sitepipe-shake + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Chris Penner (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 Chris Penner 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,96 @@ +# Slick + +Slick is a static site generator written and configured using Haskell. It's the spiritual successor to my previous +static-site generator project [SitePipe](https://github.com/chrispenner/SitePipe/); but is faster, simpler, and more +easily used in combination with other tools. + +Slick provides a small set of tools and combinators for building static +websites on top of the [Shake](https://shakebuild.com/) build system. Shake is +adaptable, fast, reliable, and caches aggressively so it's a sensible tool for +static-site builds, but figuring out how to get started can be a bit abstract. Slick aims to answer the question of +'how do I get a site building?' while giving you the necessary tools and examples to figure out how to accomplish your +goals. + +See the [hackage docs](https://hackage.haskell.org/package/slick) for in depth help on available combinators. + +Also check out the [example site](https://github.com/ChrisPenner/Slick/blob/master/example-site/app/Main.hs)! + +# Overview + +Here's a quick overview of what Slick can do: + +- Slick provides helpers for loading in blog-post-like things using Pandoc + under the hood; + - This means that if Pandoc can read it, you can use it with Slick! + - Write your blog posts in Markdown or LaTeX and render it to + syntax-highlighted HTML! + - Slick processes Pandoc (and LaTeX) metadata into a usable form (as an + Aeson Value object) which you can manipulate as you please. +- Slick provides combinators for rendering [Mustache templates](https://mustache.github.io/) + - Slick wraps Justus Adam's [Mustache](http://hackage.haskell.org/package/mustache-2.3.0/docs/Text-Mustache.html) + library and provides cached template rendering with awareness of changes to templates, partials, and Mustache + objects. + - It's a thin wrapper so you can still use things like Mustache functions, etc. if you like! +- Provides only the individual tools without opinions about how to wire them up; if you want to load blog posts from + a database and render them out using Blaze html; well go ahead, we can help with that! +- Provides caching of arbitrary (JSON serializable) objects using Shake resulting in super-fast rebuild times! + + +# Example Site: + +Here's an example of using slick to render out the posts for a pretty simple blog; + +```haskell +module Main where + +import qualified Data.Text as T +import Development.Shake +import Development.Shake.FilePath +import Data.Foldable +import Slick + + +-- convert a source filepath to a build filepath +-- e.g. site/css/style.css -> build/css/style.css +srcToBuild :: FilePath -> FilePath +srcToBuild path = "build" dropDirectory1 path + +main' :: IO () +main' = + shakeArgs shakeOptions $ do + -- Require all the things we need to build the site + -- For this simplified example we'll just copy static assets and build a page for each post + "site" ~> need ["static", "posts"] + -- Require all static assets + "static" ~> do + staticFiles <- getDirectoryFiles "." ["site/css//*", "site/js//*", "site/images//*"] + let copyStaticFile path = copyFileChanged path (srcToBuild path) + traverse_ copyStaticFile staticFiles + -- Find and require every post to be built + -- this uses the `~>` 'phony' rule because it doesn't actually write any files on its own + "posts" ~> do + postPaths <- getDirectoryFiles "site/posts" ["*.md"] + -- We tell shake we need to build each individual post + -- We require each post separately so that Shake can cache them individually + need (((-<.> "html") . srcToBuild) <$> postPaths) + -- rule for actually building posts + "build/posts//*.html" %> \out -> do + -- Recover the path where the source file for the post should be + let srcPath = (dropDirectory1 out) -<.> "md" + fileContents <- readFile' srcPath + -- Load a markdown source file into an Aeson Value + -- The 'content' key contains an html-rendered string + -- Any metadata from a yaml block is loaded into the appropriate keys in the Aeson object + -- e.g. author, date, tags, etc. + postData <- markdownToHTML . T.pack $ fileContents + -- Load a mustache template using using cache if available + template <- compileTemplate' "site/templates/post.html" + -- Fill in the template using the post metadata/content + writeFile' out . T.unpack $ substitute template postData +``` + +Not pictured above is: + +- Deserializing post metadata into an object which implements `FromJSON` +- Using custom Pandoc readers to load other document types +- Using `jsonCache`s to cache intermediate JSON results to improve build times and simplify logic. 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/slick.cabal b/slick.cabal new file mode 100644 --- /dev/null +++ b/slick.cabal @@ -0,0 +1,74 @@ +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: dc5df4fc0324f77bdfe61afb25a8a9c15a6d83dd8ca550837de78247854108dc + +name: slick +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/ChrisPenner/slick#readme +bug-reports: https://github.com/ChrisPenner/slick/issues +author: Chris Penner +maintainer: example@example.com +copyright: 2018 Chris Penner +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/ChrisPenner/slick + +library + exposed-modules: + Slick + Slick.Caching + Slick.Mustache + Slick.Pandoc + other-modules: + Paths_slick + hs-source-dirs: + src + build-depends: + aeson + , base >=4.7 && <5 + , binary + , bytestring + , containers + , lens + , lens-aeson + , mustache + , pandoc + , shake + , text + , time + default-language: Haskell2010 + +test-suite slick-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_slick + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson + , base >=4.7 && <5 + , binary + , bytestring + , containers + , lens + , lens-aeson + , mustache + , pandoc + , shake + , slick + , text + , time + default-language: Haskell2010 diff --git a/src/Slick.hs b/src/Slick.hs new file mode 100644 --- /dev/null +++ b/src/Slick.hs @@ -0,0 +1,31 @@ +module Slick + ( + -- * Slick + -- | This module re-exports everything you need to use Slick + + -- ** Mustache + compileTemplate' + , module Text.Mustache + + -- ** Pandoc + , markdownToHTML + , markdownToHTML' + , makePandocReader + , makePandocReader' + , loadUsing + , loadUsing' + + -- ** Aeson + , convert + + -- ** Shake + , simpleJsonCache + , simpleJsonCache' + , jsonCache + , jsonCache' + ) where + +import Slick.Caching +import Slick.Mustache +import Slick.Pandoc +import Text.Mustache hiding ((~>)) diff --git a/src/Slick/Caching.hs b/src/Slick/Caching.hs new file mode 100644 --- /dev/null +++ b/src/Slick/Caching.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Slick.Caching + ( simpleJsonCache + , simpleJsonCache' + , jsonCache + , jsonCache' + ) where + +import Data.Aeson as A +import Data.ByteString.Lazy +import Development.Shake hiding (Resource) +import Development.Shake.Classes +import GHC.Generics (Generic) + +newtype CacheQuery q = + CacheQuery q + deriving (Show, Eq, Generic, Binary, NFData, Hashable) + +type instance RuleResult (CacheQuery q) = ByteString + +-- | A wrapper around 'addOracleCache' which given a @q@ which is a 'ShakeValue' +-- allows caching and retrieving 'Value's within Shake. See documentation on +-- 'addOracleCache' or see Slick examples for more info. +jsonCache :: + ShakeValue q + => (q -> Action Value) + -> Rules (q -> Action Value) +jsonCache = jsonCache' + +-- | Like 'jsonCache' but allows caching/retrieving any JSON serializable +-- objects. +jsonCache' :: + forall a q. (ToJSON a, FromJSON a, ShakeValue q) + => (q -> Action a) + -> Rules (q -> Action a) +jsonCache' loader = + unpackJSON <$> addOracleCache (\(CacheQuery q) -> A.encode <$> loader q) + where + unpackJSON :: + FromJSON a => (CacheQuery q -> Action ByteString) -> q -> Action a + unpackJSON runCacheQuery = + \q -> do + bytes <- runCacheQuery $ CacheQuery q + case A.eitherDecode bytes of + Left err -> fail err + Right res -> pure res + +-- | A wrapper around 'jsonCache' which simplifies caching of values which do NOT +-- depend on an input parameter. Unfortunately Shake still requires that the +-- key type implement several typeclasses, however this is easily accomplished +-- using @GeneralizedNewtypeDeriving@ and a wrapper around @()@. +-- example usage: +-- +-- > {-# LANGUAGE GeneralizedNewtypeDeriving #-} +-- > module Main where +-- > newtype ProjectList = ProjectList () +-- > deriving (Show, Eq, Hashable, Binary, NFData) +-- Within your shake Rules: +-- +-- > projectCache = simpleJsonCache (ProjectList ()) $ do +-- > -- load your project list here; returning it as a Value +simpleJsonCache :: ShakeValue q + => q + -> Action Value + -> Rules (Action Value) +simpleJsonCache = simpleJsonCache' + +-- | Like 'simpleJsonCache' but allows caching any JSON serializable object. +simpleJsonCache' :: + forall q a. (ToJSON a, FromJSON a, ShakeValue q) + => q + -> Action a + -> Rules (Action a) +simpleJsonCache' q loader = do + cacheGetter <- jsonCache' (const loader) + return $ cacheGetter q diff --git a/src/Slick/Mustache.hs b/src/Slick/Mustache.hs new file mode 100644 --- /dev/null +++ b/src/Slick/Mustache.hs @@ -0,0 +1,19 @@ +module Slick.Mustache + ( compileTemplate' + ) where + +import Development.Shake +import Text.Mustache +import Text.Mustache.Compile + +-- | Like 'compileTemplate' but tracks changes to template files and partials +-- within Shake. +compileTemplate' :: FilePath -> Action Template +compileTemplate' fp = do + need [fp] + result <- liftIO $ localAutomaticCompile fp + case result of + Right templ -> do + need (getPartials . ast $ templ) + return templ + Left err -> fail $ show err diff --git a/src/Slick/Pandoc.hs b/src/Slick/Pandoc.hs new file mode 100644 --- /dev/null +++ b/src/Slick/Pandoc.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE OverloadedStrings #-} + +module Slick.Pandoc + ( markdownToHTML + , markdownToHTML' + , makePandocReader + , makePandocReader' + , loadUsing + , loadUsing' + , convert + ) where + +import Control.Lens +import Control.Monad +import Data.Aeson +import Data.Aeson.Lens +import qualified Data.Text as T +import Development.Shake hiding (Resource) +import Text.Pandoc +import Text.Pandoc.Highlighting +import Text.Pandoc.Shared + +-- | Reasonable options for reading a markdown file +markdownOptions :: ReaderOptions +markdownOptions = def {readerExtensions = exts} + where + exts = + mconcat + [extensionsFromList [Ext_yaml_metadata_block], githubMarkdownExtensions] + +-- | Reasonable options for rendering to HTML +html5Options :: WriterOptions +html5Options = def {writerHighlightStyle = Just tango} + +-- | Handle possible pandoc failure within the Action Monad +unPandocM :: PandocPure a -> Action a +unPandocM = either (fail . show) return . runPure + +-- | Convert markdown text into a 'Value'; +-- The 'Value' has a "content" key containing rendered HTML +-- Metadata is assigned on the respective keys in the 'Value' +markdownToHTML :: T.Text -> Action Value +markdownToHTML = + loadUsing (readMarkdown markdownOptions) (writeHtml5String html5Options) + +-- | Like 'markdownToHTML' but allows returning any JSON serializable object +markdownToHTML' :: (FromJSON a) => T.Text -> Action a +markdownToHTML' = markdownToHTML >=> convert + +type PandocReader textType = textType -> PandocPure Pandoc + +type PandocWriter = Pandoc -> PandocPure T.Text + +-- | Given a reader from 'Text.Pandoc.Readers' this creates a loader which +-- given the source document will read its metadata into a 'Value' +-- returning both the 'Pandoc' object and the metadata within an 'Action' +makePandocReader :: PandocReader textType -> textType -> Action (Pandoc, Value) +makePandocReader readerFunc text = do + pdoc@(Pandoc meta _) <- unPandocM $ readerFunc text + return (pdoc, flattenMeta meta) + +-- | Like 'makePandocReader' but will deserialize the metadata into any object +-- which implements 'FromJSON'. Failure to deserialize will fail the Shake +-- build. +makePandocReader' :: + (FromJSON a) + => PandocReader textType + -> textType + -> Action (Pandoc, a) +makePandocReader' readerFunc text = do + (pdoc, meta) <- makePandocReader readerFunc text + convertedMeta <- convert meta + return (pdoc, convertedMeta) + +-- | Load in a source document using the given 'PandocReader', then render the 'Pandoc' +-- into text using the given 'PandocWriter'. +-- Returns a 'Value' wherein the rendered text is set to the "content" key and +-- any metadata is set to its respective key in the 'Value' +loadUsing :: PandocReader textType -> PandocWriter -> textType -> Action Value +loadUsing reader writer text = do + (pdoc, meta) <- makePandocReader reader text + outText <- unPandocM $ writer pdoc + let withContent = meta & _Object . at "content" ?~ String outText + return withContent + +-- | Like 'loadUsing' but allows also deserializes the 'Value' into any object +-- which implements 'FromJSON'. Failure to deserialize will fail the Shake +-- build. +loadUsing' :: (FromJSON a) => PandocReader textType -> PandocWriter -> textType -> Action a +loadUsing' reader writer text = loadUsing reader writer text >>= convert + +-- | Attempt to convert between two JSON serializable objects (or 'Value's). +-- Failure to deserialize fails the Shake build. +convert :: (FromJSON a, ToJSON a, FromJSON b) => a -> Action b +convert a = + case fromJSON (toJSON a) of + Success r -> pure r + Error err -> fail $ "json conversion error:" ++ err + +-- | Flatten a Pandoc 'Meta' into a well-structured JSON object, rendering Pandoc +-- text objects into plain strings along the way. +flattenMeta :: Meta -> Value +flattenMeta (Meta meta) = toJSON $ fmap go meta + where + go :: MetaValue -> Value + go (MetaMap m) = toJSON $ fmap go m + go (MetaList m) = toJSONList $ fmap go m + go (MetaBool m) = toJSON m + go (MetaString m) = toJSON m + go (MetaInlines m) = toJSON $ stringify m + go (MetaBlocks m) = toJSON $ stringify m diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"