hakyll 2.0 → 2.1

raw patch · 6 files changed

+77/−87 lines, 6 filesdep −QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies removed: QuickCheck

API changes (from Hackage documentation)

Files

• data/templates/rss.xml +1/−1
• hakyll.cabal +2/−3
• src/Text/Hakyll.hs +26/−6
• src/Text/Hakyll/HakyllMonad.hs +12/−6
• src/Text/Hakyll/Internal/Page.hs +34/−37
• src/Text/Hakyll/Internal/Template.hs +2/−34

@@ -1,4 +1,4 @@-<?xml version="1.0" encoding="utf8"?>+<?xml version="1.0" encoding="utf-8"?> <rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">     <channel>         <title>$title</title>

@@ -1,5 +1,5 @@ Name:               hakyll-Version:            2.0+Version:            2.1  Synopsis:           A simple static site generator library. Description:        A simple static site generator library, mainly aimed at@@ -39,8 +39,7 @@                     old-locale >= 1,                     old-time >= 1,                     time >= 1,-                    binary >= 0.5,-                    QuickCheck >= 2+                    binary >= 0.5   exposed-modules:  Network.Hakyll.SimpleServer                     Text.Hakyll                     Text.Hakyll.Context

@@ -21,19 +21,39 @@ import System.Directory (doesDirectoryExist, removeDirectoryRecursive) import System.Time (getClockTime) +import Text.Pandoc+ import Network.Hakyll.SimpleServer (simpleServer) import Text.Hakyll.HakyllMonad import Text.Hakyll.File +-- | The default reader options for pandoc parsing.+defaultPandocParserState :: ParserState+defaultPandocParserState = defaultParserState+    { -- The following option causes pandoc to read smart typography, a nice+      -- and free bonus.+      stateSmart = True+    }++-- | The default writer options for pandoc rendering.+defaultPandocWriterOptions :: WriterOptions+defaultPandocWriterOptions = defaultWriterOptions+    { -- This option causes literate haskell to be written using '>' marks in+      -- html, which I think is a good default.+      writerLiterateHaskell = True+    }+ -- | The default hakyll configuration. defaultHakyllConfiguration :: HakyllConfiguration defaultHakyllConfiguration = HakyllConfiguration-    { absoluteUrl       = ""-    , additionalContext = M.empty-    , siteDirectory     = "_site"-    , cacheDirectory    = "_cache"-    , enableIndexUrl    = False-    , previewPollDelay  = 1000000+    { absoluteUrl         = ""+    , additionalContext   = M.empty+    , siteDirectory       = "_site"+    , cacheDirectory      = "_cache"+    , enableIndexUrl      = False+    , previewPollDelay    = 1000000+    , pandocParserState   = defaultPandocParserState+    , pandocWriterOptions = defaultPandocWriterOptions     }  -- | Main function to run Hakyll with the default configuration. The

@@ -10,6 +10,8 @@ import Control.Monad (liftM) import qualified Data.Map as M +import Text.Pandoc (ParserState, WriterOptions)+ import Text.Hakyll.Context (Context)  -- | Our custom monad stack.@@ -18,18 +20,22 @@ -- | Hakyll global configuration type. data HakyllConfiguration = HakyllConfiguration     { -- | Absolute URL of the site.-      absoluteUrl       :: String+      absoluteUrl         :: String     , -- | An additional context to use when rendering. This additional context       --   is used globally.-      additionalContext :: Context+      additionalContext   :: Context     , -- | Directory where the site is placed.-      siteDirectory     :: FilePath+      siteDirectory       :: FilePath     , -- | Directory for cache files.-      cacheDirectory    :: FilePath+      cacheDirectory      :: FilePath     , -- | Enable index links.-      enableIndexUrl    :: Bool+      enableIndexUrl      :: Bool     , -- | Delay between polls in preview mode.-      previewPollDelay  :: Int+      previewPollDelay    :: Int+    , -- | Pandoc parsing options+      pandocParserState   :: ParserState+    , -- | Pandoc writer options+      pandocWriterOptions :: WriterOptions     }  -- | Simplified @ask@ function for the Hakyll monad stack.

@@ -1,5 +1,5 @@ -- | A module for dealing with @Page@s. This module is mostly internally used.-module Text.Hakyll.Internal.Page +module Text.Hakyll.Internal.Page     ( readPage     ) where @@ -8,6 +8,7 @@ import Data.Char (isSpace) import Control.Monad.Reader (liftIO) import System.FilePath+import Control.Monad.State (State, evalState, get, put)  import Text.Pandoc @@ -19,28 +20,15 @@ import Text.Hakyll.Internal.Cache import Text.Hakyll.Internal.FileType --- | The default reader options for pandoc parsing.-readerOptions :: ParserState-readerOptions = defaultParserState-    { -- The following option causes pandoc to read smart typography, a nice-      -- and free bonus.-      stateSmart = True-    }---- | The default writer options for pandoc rendering.-writerOptions :: WriterOptions-writerOptions = defaultWriterOptions-    { -- This option causes literate haskell to be written using '>' marks in-      -- html, which I think is a good default.-      writerLiterateHaskell = True-    }- -- | Get a render function for a given extension.-getRenderFunction :: FileType -> (String -> String)-getRenderFunction Html     = id-getRenderFunction Text     = id-getRenderFunction fileType = writeHtmlString writerOptions-                           . readFunction fileType (readOptions fileType)+getRenderFunction :: FileType -> Hakyll (String -> String)+getRenderFunction Html     = return id+getRenderFunction Text     = return id+getRenderFunction fileType = do+    parserState <- askHakyll pandocParserState+    writerOptions <- askHakyll pandocWriterOptions+    return $ writeHtmlString writerOptions+           . readFunction fileType (readOptions parserState fileType)   where     readFunction ReStructuredText        = readRST     readFunction LaTeX                   = readLaTeX@@ -48,21 +36,30 @@     readFunction LiterateHaskellMarkdown = readMarkdown     readFunction t                       = error $ "Cannot render " ++ show t -    readOptions LiterateHaskellMarkdown =-        readerOptions { stateLiterateHaskell = True }-    readOptions _                       = readerOptions+    readOptions options LiterateHaskellMarkdown = options+        { stateLiterateHaskell = True }+    readOptions options _                       = options  -- | Split a page into sections.-splitAtDelimiters :: [String] -> [[String]]-splitAtDelimiters [] = []-splitAtDelimiters ls@(x:xs)-    | isDelimiter x = let (content, rest) = break isDelimiter xs-                      in (x : content) : splitAtDelimiters rest-    | otherwise = [ls]+splitAtDelimiters :: [String] -> State (Maybe String) [[String]]+splitAtDelimiters [] = return []+splitAtDelimiters ls@(x:xs) = do+    delimiter <- get+    if not (isDelimiter delimiter x)+        then return [ls]+        else do let proper = takeWhile (== '-') x+                    (content, rest) = break (isDelimiter $ Just proper) xs+                put $ Just proper+                rest' <- splitAtDelimiters rest+                return $ (x : content) : rest'+  where+    isDelimiter old = case old of+        Nothing  -> isPossibleDelimiter+        (Just d) -> (== d) . takeWhile (== '-')  -- | Check if the given string is a metadata delimiter.-isDelimiter :: String -> Bool-isDelimiter = isPrefixOf "---"+isPossibleDelimiter :: String -> Bool+isPossibleDelimiter = isPrefixOf "---"  -- | Read one section of a page. readSection :: (String -> String) -- ^ Render function.@@ -76,7 +73,7 @@     | isFirst = readSimpleMetaData (tail ls)     | otherwise = body (tail ls)   where-    isDelimiter' = isDelimiter (head ls)+    isDelimiter' = isPossibleDelimiter (head ls)     isNamedDelimiter = head ls `matchesRegex` "^----*  *[a-zA-Z0-9][a-zA-Z0-9]*"     body ls' = [("body", renderFunction $ unlines ls')] @@ -93,14 +90,14 @@ --   has a @.markdown@ extension, it will be rendered using pandoc. readPageFromFile :: FilePath -> Hakyll Context readPageFromFile path = do-    let renderFunction = getRenderFunction $ getFileType path-        sectionFunctions = map (readSection renderFunction)+    renderFunction <- getRenderFunction $ getFileType path+    let sectionFunctions = map (readSection renderFunction)                                (True : repeat False)      -- Read file.     contents <- liftIO $ readFile path     url <- toUrl path-    let sections = splitAtDelimiters $ lines contents+    let sections = evalState (splitAtDelimiters $ lines contents) Nothing         sectionsData = concat $ zipWith ($) sectionFunctions sections         context = M.fromList $             ("url", url) : ("path", path) : category ++ sectionsData

@@ -1,5 +1,5 @@ module Text.Hakyll.Internal.Template-    ( Template+    ( Template (..)     , fromString     , readTemplate     , substitute@@ -11,14 +11,11 @@ import Data.List (isPrefixOf) import Data.Char (isAlphaNum) import Data.Binary-import Control.Monad (liftM, liftM2, replicateM)-import Control.Applicative ((<$>))+import Control.Monad (liftM, liftM2) import Data.Maybe (fromMaybe) import System.FilePath ((</>)) import Control.Monad.Reader (liftIO) -import Test.QuickCheck- import Text.Hakyll.Context (Context) import Text.Hakyll.HakyllMonad (Hakyll) import Text.Hakyll.Internal.Cache@@ -91,32 +88,3 @@                          2 -> liftM EscapeCharacter get                          3 -> return End                          _ -> error "Error reading template"---- | Generate arbitrary templates from a given length.-arbitraryTemplate :: Int -> Gen Template-arbitraryTemplate 0 = return End-arbitraryTemplate length' = oneof [ do chunk <- chunk'-                                       Chunk chunk <$> template'-                                  , do key <- key'-                                       Identifier key <$> template'-                                  , EscapeCharacter <$> template'-                                  ]-  where-    template' = arbitraryTemplate (length' - 1)-    -- Generate keys.-    key' = do l <- choose (5, 10)-              replicateM l $ choose ('a', 'z')-    -- Generate non-empty chunks.-    chunk' = do string <- arbitrary-                let sanitized = filter (/= '$') string-                return $ if null sanitized then "foo"-                                           else sanitized---- | Make @Template@ testable.-instance Arbitrary Template where-    arbitrary = choose (0, 20) >>= arbitraryTemplate--    shrink (Chunk chunk template) = [template, Chunk chunk End]-    shrink (Identifier key template) = [template, Identifier key End]-    shrink (EscapeCharacter template) = [template, EscapeCharacter End]-    shrink End = []