hakyll 4.5.3.0 → 4.5.4.0

raw patch · 6 files changed

+162/−96 lines, 6 filesdep ~mtldep ~networkdep ~pandocPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: mtl, network, pandoc, pandoc-citeproc

API changes (from Hackage documentation)

Files

• hakyll.cabal +9/−9
• src/Hakyll/Init.hs +52/−8
• src/Hakyll/Web/Html.hs +12/−2
• src/Hakyll/Web/Paginate.hs +66/−74
• src/Hakyll/Web/Pandoc/Biblio.hs +1/−1
• src/Hakyll/Web/Template/List.hs +22/−2

@@ -1,5 +1,5 @@ Name:    hakyll-Version: 4.5.3.0+Version: 4.5.4.0  Synopsis: A static website compiler library Description:@@ -153,12 +153,12 @@     directory       >= 1.0    && < 1.3,     filepath        >= 1.0    && < 1.4,     lrucache        >= 1.1.1  && < 1.2,-    mtl             >= 1      && < 2.2,-    network         >= 2.4    && < 2.6,+    mtl             >= 1      && < 2.3,+    network         >= 2.4    && < 2.7,     old-locale      >= 1.0    && < 1.1,     old-time        >= 1.0    && < 1.2,-    pandoc          >= 1.12.4 && < 1.13,-    pandoc-citeproc >= 0.1    && < 0.4,+    pandoc          >= 1.12.4 && < 1.14,+    pandoc-citeproc >= 0.4    && < 0.5,     parsec          >= 3.0    && < 3.2,     process         >= 1.0    && < 1.3,     random          >= 1.0    && < 1.1,@@ -239,12 +239,12 @@     directory       >= 1.0    && < 1.3,     filepath        >= 1.0    && < 1.4,     lrucache        >= 1.1.1  && < 1.2,-    mtl             >= 1      && < 2.2,-    network         >= 2.4    && < 2.6,+    mtl             >= 1      && < 2.3,+    network         >= 2.4    && < 2.7,     old-locale      >= 1.0    && < 1.1,     old-time        >= 1.0    && < 1.2,-    pandoc          >= 1.12.4 && < 1.13,-    pandoc-citeproc >= 0.1    && < 0.4,+    pandoc          >= 1.12.4 && < 1.14,+    pandoc-citeproc >= 0.4    && < 0.5,     parsec          >= 3.0    && < 3.2,     process         >= 1.0    && < 1.3,     random          >= 1.0    && < 1.1,

@@ -5,11 +5,15 @@   --------------------------------------------------------------------------------+import           Control.Arrow         (first) import           Control.Monad         (forM_)-import           System.Directory      (copyFile)+import           Data.Char             (isAlphaNum, isNumber)+import           Data.List             (intercalate)+import           Data.Version          (Version(..))+import           System.Directory      (copyFile, canonicalizePath) import           System.Environment    (getArgs, getProgName) import           System.Exit           (exitFailure)-import           System.FilePath       ((</>))+import           System.FilePath       ((</>), splitDirectories)   --------------------------------------------------------------------------------@@ -26,12 +30,52 @@     files    <- getRecursiveContents (const $ return False) srcDir      case args of-        [dstDir] -> forM_ files $ \file -> do-            let dst = dstDir </> file-                src = srcDir </> file-            putStrLn $ "Creating " ++ dst-            makeDirectories dst-            copyFile src dst+        [dstDir] -> do+            forM_ files $ \file -> do+                let dst = dstDir </> file+                    src = srcDir </> file+                putStrLn $ "Creating " ++ dst+                makeDirectories dst+                copyFile src dst+            -- canonicalizePath is safe because the destination+            -- directory should exist at this point+            canonicalizePath dstDir >>= createCabal         _ -> do             putStrLn $ "Usage: " ++ progName ++ " <directory>"             exitFailure+++createCabal :: FilePath -> IO ()+createCabal dstDir = do+        putStrLn $ "Creating " ++ name ++ ".cabal"+        writeFile (dstDir </> name ++ ".cabal") $ unlines [+            "name:               " ++ name+          , "version:            0.1.0.0"+          , "build-type:         Simple"+          , "cabal-version:      >= 1.10"+          , ""+          , "executable site"+          , "  main-is:          site.hs"+          , "  build-depends:    base == 4.*"+          , "                  , hakyll == " ++ version' ++ ".*"+          , "  ghc-options:      -threaded"+          , "  default-language: Haskell2010"+          ]+  where+    -- Major hakyll version+    version' = intercalate "." . take 2 . map show $ versionBranch version+    -- last is safe here as the path is canonicalised and "/" is just+    -- a very rare but possible corner case+    name = case last (splitDirectories  dstDir) of+        "/" -> fallbackName+        x   -> repair (fallbackName ++) id x+    -- Package name repair code comes from+    -- cabal-install.Distribution.Client.Init.Heuristics+    repair invalid valid x = case dropWhile (not . isAlphaNum) x of+        "" -> repairComponent ""+        x' -> let (c, r) = first repairComponent $ break (not . isAlphaNum) x'+              in c ++ repairRest r+      where repairComponent c | all isNumber c = invalid c+                              | otherwise = valid c+    repairRest = repair id ('-' :)+    fallbackName = "site"

@@ -36,7 +36,7 @@ -------------------------------------------------------------------------------- -- | Map over all tags in the document withTags :: (TS.Tag String -> TS.Tag String) -> String -> String-withTags f = renderTags' . map f . TS.parseTags+withTags f = renderTags' . map f . parseTags'   --------------------------------------------------------------------------------@@ -77,9 +77,10 @@ -- | Customized TagSoup renderer. The default TagSoup renderer escape CSS -- within style tags, and doesn't properly minimize. renderTags' :: [TS.Tag String] -> String-renderTags' = TS.renderTagsOptions TS.renderOptions+renderTags' = TS.renderTagsOptions TS.RenderOptions     { TS.optRawTag   = (`elem` ["script", "style"]) . map toLower     , TS.optMinimize = (`S.member` minimize) . map toLower+    , TS.optEscape   = id     }   where     -- A list of elements which must be minimized@@ -87,6 +88,15 @@         [ "area", "br", "col", "embed", "hr", "img", "input", "meta", "link"         , "param"         ]+++--------------------------------------------------------------------------------+-- | Customized TagSoup parser: do not decode any entities.+parseTags' :: String -> [TS.Tag String]+parseTags' = TS.parseTagsOptions (TS.parseOptions :: TS.ParseOptions String)+    { TS.optEntityData   = \(str, b) -> [TS.TagText $ "&" ++ str ++ [';' | b]]+    , TS.optEntityAttrib = \(str, b) -> ("&" ++ str ++ [';' | b], [])+    }   --------------------------------------------------------------------------------

@@ -3,8 +3,8 @@ module Hakyll.Web.Paginate     ( PageNumber     , Paginate (..)-    , buildPaginate     , buildPaginateWith+    , paginateEvery     , paginateRules     , paginateContext     ) where@@ -12,11 +12,9 @@  -------------------------------------------------------------------------------- import           Control.Monad                  (forM_)-import           Data.List                      (unfoldr) import qualified Data.Map                       as M import           Data.Monoid                    (mconcat) import qualified Data.Set                       as S-import           Text.Printf                    (printf)   --------------------------------------------------------------------------------@@ -37,99 +35,93 @@ -------------------------------------------------------------------------------- -- | Data about paginators data Paginate = Paginate-    { paginatePages      :: M.Map PageNumber [Identifier]-    , paginatePlaces     :: M.Map Identifier PageNumber+    { paginateMap        :: M.Map PageNumber [Identifier]     , paginateMakeId     :: PageNumber -> Identifier     , paginateDependency :: Dependency     } deriving (Show)   ---------------------------------------------------------------------------------buildPaginate :: MonadMetadata m-              => Pattern-              -> m Paginate-buildPaginate pattern = do-    idents <- getMatches pattern-    let pagPages  = M.fromList $ zip [1 ..] (map return idents)-        pagPlaces = M.fromList $ zip idents [1 ..]-        makeId pn = case M.lookup pn pagPages of-            Just [id'] -> id'-            _          -> error $-                "Hakyll.Web.Paginate.buildPaginate: " ++-                "invalid page number: " ++ show pn--    return $ Paginate pagPages pagPlaces makeId-        (PatternDependency pattern (S.fromList idents))+paginateNumPages :: Paginate -> Int+paginateNumPages = M.size . paginateMap   ---------------------------------------------------------------------------------buildPaginateWith :: MonadMetadata m-                  => Int-                  -> (PageNumber -> Identifier)-                  -> Pattern-                  -> m Paginate-buildPaginateWith n makeId pattern = do-    -- TODO: there is no sensible order for `ids` here, for now it's random;-    -- but it should be `resectFirst` order because most recent posts should-    -- correspond to 1st paginator page and oldest one to last page-    idents <- getMatches pattern-    let pages          = flip unfoldr idents $ \xs ->-            if null xs then Nothing else Just (splitAt n xs)-        nPages         = length pages-        paginatePages' = zip [1..] pages-        pagPlaces'     =-            [(ident, idx) | (idx,ids) <- paginatePages', ident <- ids] ++-            [(makeId i, i) | i <- [1 .. nPages]]+paginateEvery :: Int -> [a] -> [[a]]+paginateEvery n = go+  where+    go [] = []+    go xs = let (y, ys) = splitAt n xs in y : go ys -    return $ Paginate (M.fromList paginatePages') (M.fromList pagPlaces') makeId-        (PatternDependency pattern (S.fromList idents)) +--------------------------------------------------------------------------------+buildPaginateWith+    :: MonadMetadata m+    => ([Identifier] -> m [[Identifier]])  -- ^ Group items into pages+    -> Pattern                             -- ^ Select items to paginate+    -> (PageNumber -> Identifier)          -- ^ Identifiers for the pages+    -> m Paginate+buildPaginateWith grouper pattern makeId = do+    ids      <- getMatches pattern+    idGroups <- grouper ids+    let idsSet = S.fromList ids+    return Paginate+        { paginateMap        = M.fromList (zip [1 ..] idGroups)+        , paginateMakeId     = makeId+        , paginateDependency = PatternDependency pattern idsSet+        } + -------------------------------------------------------------------------------- paginateRules :: Paginate -> (PageNumber -> Pattern -> Rules ()) -> Rules () paginateRules paginator rules =-    forM_ (M.toList $ paginatePages paginator) $ \(idx, identifiers) ->-        create [paginateMakeId paginator idx] $-            rulesExtraDependencies [paginateDependency paginator] $+    forM_ (M.toList $ paginateMap paginator) $ \(idx, identifiers) ->+        rulesExtraDependencies [paginateDependency paginator] $+            create [paginateMakeId paginator idx] $                 rules idx $ fromList identifiers   ----------------------------------------------------------------------------------- | Takes first, current, last page and produces index of next page-type RelPage = PageNumber -> PageNumber -> PageNumber -> Maybe PageNumber+-- | Get the identifier for a certain page by passing in the page number.+paginatePage :: Paginate -> PageNumber -> Maybe Identifier+paginatePage pag pageNumber+    | pageNumber < 1                      = Nothing+    | pageNumber > (paginateNumPages pag) = Nothing+    | otherwise                           = Just $ paginateMakeId pag pageNumber   ---------------------------------------------------------------------------------paginateField :: Paginate -> String -> RelPage -> Context a-paginateField pag fieldName relPage = field fieldName $ \item ->-    let identifier = itemIdentifier item-    in case M.lookup identifier (paginatePlaces pag) of-        Nothing -> fail $ printf-            "Hakyll.Web.Paginate: there is no page %s in paginator map."-            (show identifier)-        Just pos -> case relPage 1 pos nPages of-            Nothing   -> fail "Hakyll.Web.Paginate: No page here."-            Just pos' -> do-                let nextId = paginateMakeId pag pos'-                mroute <- getRoute nextId-                case mroute of-                    Nothing -> fail $ printf-                        "Hakyll.Web.Paginate: unable to get route for %s."-                        (show nextId)-                    Just rt -> return $ toUrl rt+-- | A default paginate context which provides the following keys:+--+--+paginateContext :: Paginate -> PageNumber -> Context a+paginateContext pag currentPage = mconcat+    [ field "firstPageNum"    $ \_ -> otherPage 1                 >>= num+    , field "firstPageUrl"    $ \_ -> otherPage 1                 >>= url+    , field "previousPageNum" $ \_ -> otherPage (currentPage - 1) >>= num+    , field "previousPageUrl" $ \_ -> otherPage (currentPage - 1) >>= url+    , field "nextPageNum"     $ \_ -> otherPage (currentPage + 1) >>= num+    , field "nextPageUrl"     $ \_ -> otherPage (currentPage + 1) >>= url+    , field "lastPageNum"     $ \_ -> otherPage lastPage          >>= num+    , field "lastPageUrl"     $ \_ -> otherPage lastPage          >>= url+    , field "currentPageNum"  $ \i -> thisPage i                  >>= num+    , field "currentPageUrl"  $ \i -> thisPage i                  >>= url+    , constField "numPages"   $ show $ paginateNumPages pag+    ]   where-    nPages = M.size (paginatePages pag)+    lastPage = paginateNumPages pag +    thisPage i = return (currentPage, itemIdentifier i)+    otherPage n+        | n == currentPage = fail $ "This is the current page: " ++ show n+        | otherwise        = case paginatePage pag n of+            Nothing -> fail $ "No such page: " ++ show n+            Just i  -> return (n, i) ----------------------------------------------------------------------------------paginateContext :: Paginate -> Context a-paginateContext pag = mconcat-    [ paginateField pag "firstPage"-        (\f c _ -> if c <= f then Nothing else Just f)-    , paginateField pag "previousPage"-        (\f c _ -> if c <= f then Nothing else Just (c - 1))-    , paginateField pag "nextPage"-        (\_ c l -> if c >= l then Nothing else Just (c + 1))-    , paginateField pag "lastPage"-        (\_ c l -> if c >= l then Nothing else Just l)-    ]+    num :: (Int, Identifier) -> Compiler String+    num = return . show . fst++    url :: (Int, Identifier) -> Compiler String+    url (n, i) = getRoute i >>= \mbR -> case mbR of+        Just r  -> return $ toUrl r+        Nothing -> fail $ "No URL for page: " ++ show n

@@ -90,7 +90,7 @@                  -> Compiler (Item Pandoc) readPandocBiblio ropt csl biblio item = do     -- Parse CSL file, if given-    style <- unsafeCompiler $ CSL.readCSLFile . toFilePath . itemIdentifier $ csl+    style <- unsafeCompiler $ CSL.readCSLFile Nothing . toFilePath . itemIdentifier $ csl      -- We need to know the citation keys, add then *before* actually parsing the     -- actual page. If we don't do this, pandoc won't even consider them

@@ -13,6 +13,8 @@     , applyJoinTemplateList     , chronological     , recentFirst+    , sortChronological+    , sortRecentFirst     ) where  @@ -25,6 +27,7 @@  -------------------------------------------------------------------------------- import           Hakyll.Core.Compiler+import           Hakyll.Core.Identifier import           Hakyll.Core.Item import           Hakyll.Core.Metadata import           Hakyll.Web.Template@@ -65,7 +68,24 @@     sortByM f xs = liftM (map fst . sortBy (comparing snd)) $                    mapM (\x -> liftM (x,) (f x)) xs + -------------------------------------------------------------------------------- -- | The reverse of 'chronological'-recentFirst :: (MonadMetadata m, Functor m) => [Item a] -> m [Item a]-recentFirst = fmap reverse . chronological+recentFirst :: MonadMetadata m => [Item a] -> m [Item a]+recentFirst = liftM reverse . chronological+++--------------------------------------------------------------------------------+-- | Version of 'chronological' which doesn't need the actual items.+sortChronological+    :: MonadMetadata m => [Identifier] -> m [Identifier]+sortChronological ids =+    liftM (map itemIdentifier) $ chronological [Item i () | i <- ids]+++--------------------------------------------------------------------------------+-- | Version of 'recentFirst' which doesn't need the actual items.+sortRecentFirst+    :: MonadMetadata m => [Identifier] -> m [Identifier]+sortRecentFirst ids =+    liftM (map itemIdentifier) $ recentFirst [Item i () | i <- ids]