diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 1.3 +Version: 1.4 Synopsis: A simple static site generator library. Description: @@ -33,6 +33,7 @@ network >= 2, mtl >= 1.1, old-locale >= 1, + old-time >= 1, time >= 1, binary >= 0.5, QuickCheck >= 2 @@ -49,6 +50,6 @@ Text.Hakyll.Util Text.Hakyll.Tags Text.Hakyll.Internal.Cache - Text.Hakyll.Internal.CompressCSS + Text.Hakyll.Internal.CompressCss Text.Hakyll.Internal.Render Text.Hakyll.Internal.Template diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs --- a/src/Text/Hakyll.hs +++ b/src/Text/Hakyll.hs @@ -1,38 +1,52 @@ +-- | This is the main Hakyll module, exporting the important @hakyl@ function. +-- +-- Most configurations would use this @hakyll@ function more or less as the +-- main function: +-- +-- > main = hakyll $ do +-- > directory css "css" +-- > directory static "images" +-- module Text.Hakyll ( defaultHakyllConfiguration , hakyll , hakyllWithConfiguration ) where -import Control.Monad.Reader (runReaderT, liftIO) +import Control.Monad.Reader (runReaderT, liftIO, ask) +import Control.Concurrent (forkIO, threadDelay) import Control.Monad (when) import qualified Data.Map as M import System.Environment (getArgs, getProgName) import System.Directory (doesDirectoryExist, removeDirectoryRecursive) +import System.Time (getClockTime) import Network.Hakyll.SimpleServer (simpleServer) import Text.Hakyll.Hakyll +import Text.Hakyll.File --- | Default hakyll configuration. +-- | The default hakyll configuration. defaultHakyllConfiguration :: HakyllConfiguration defaultHakyllConfiguration = HakyllConfiguration { additionalContext = M.empty , siteDirectory = "_site" , cacheDirectory = "_cache" + , enableIndexUrl = False + , previewPollDelay = 1000000 } --- | Hakyll with a default configuration. +-- | Main function to run Hakyll with the default configuration. hakyll :: Hakyll () -> IO () hakyll = hakyllWithConfiguration defaultHakyllConfiguration --- | Main function to run hakyll with a configuration. +-- | Main function to run hakyll with a custom configuration. hakyllWithConfiguration :: HakyllConfiguration -> Hakyll () -> IO () hakyllWithConfiguration configuration buildFunction = do args <- getArgs let f = case args of ["build"] -> buildFunction ["clean"] -> clean - ["preview", p] -> buildFunction >> server (read p) - ["preview"] -> buildFunction >> server 8000 + ["preview", p] -> preview buildFunction (read p) + ["preview"] -> preview buildFunction 8000 ["server", p] -> server (read p) ["server"] -> server 8000 _ -> help @@ -47,6 +61,23 @@ exists <- doesDirectoryExist dir when exists $ removeDirectoryRecursive dir +-- | Autocompile mode. +preview :: Hakyll () -> Integer -> Hakyll () +preview buildFunction port = do + buildFunction + _ <- startServer + liftIO getClockTime >>= run + where + startServer = do configuration <- ask + liftIO $ forkIO $ runReaderT (server port) configuration + run time = do delay <- askHakyll previewPollDelay + liftIO $ threadDelay delay + contents <- getRecursiveContents "." + valid <- isMoreRecent time contents + if valid then run time + else do buildFunction + liftIO getClockTime >>= run + -- | Show usage information. help :: Hakyll () help = liftIO $ do @@ -58,8 +89,9 @@ ++ name ++ " build Generate the site.\n" ++ name ++ " clean Clean up and remove cache.\n" ++ name ++ " help Show this message.\n" - ++ name ++ " preview [port] Generate site, then start a server.\n" + ++ name ++ " preview [port] Run a server and autocompile.\n" ++ name ++ " server [port] Run a local test server.\n" +-- | Start a server at the given port number. server :: Integer -> Hakyll () server p = askHakyll siteDirectory >>= liftIO . simpleServer (fromIntegral p) diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs --- a/src/Text/Hakyll/File.hs +++ b/src/Text/Hakyll/File.hs @@ -3,19 +3,21 @@ module Text.Hakyll.File ( toDestination , toCache - , toURL + , toUrl , toRoot , removeSpaces , makeDirectories , getRecursiveContents , sortByBaseName , havingExtension - , isMoreRecent , directory + , isMoreRecent + , isFileMoreRecent ) where import System.Directory import System.FilePath +import System.Time (ClockTime) import Control.Monad import Data.List (isPrefixOf, sortBy) import Control.Monad.Reader (liftIO) @@ -36,8 +38,15 @@ -- | Convert a relative filepath to a filepath in the destination -- (default: @_site@). toDestination :: FilePath -> Hakyll FilePath -toDestination path = do dir <- askHakyll siteDirectory - return $ dir removeLeadingSeparator path +toDestination url = do dir <- askHakyll siteDirectory + enableIndexUrl' <- askHakyll enableIndexUrl + let destination = if enableIndexUrl' && separatorEnd + then dir noSeparator "index.html" + else dir noSeparator + return destination + where + noSeparator = removeLeadingSeparator url + separatorEnd = not (null url) && last url == '/' -- | Convert a relative filepath to a filepath in the cache -- (default: @_cache@). @@ -45,22 +54,39 @@ toCache path = do dir <- askHakyll cacheDirectory return $ dir removeLeadingSeparator path --- | Get the url for a given page. -toURL :: FilePath -> FilePath -toURL path = if takeExtension path `elem` [ ".markdown" - , ".md" - , ".mdn" - , ".mdwn" - , ".mkd" - , ".mkdn" - , ".mkdwn" - , ".rst" - , ".text" - , ".tex" - , ".lhs" - ] - then flip addExtension ".html" $ dropExtension path - else path +-- | Get the url for a given page. For most extensions, this would be the path +-- itself. It's only for rendered extensions (@.markdown@, @.rst@, @.lhs@ this +-- function returns a path with a @.html@ extension instead. +toUrl :: FilePath -> Hakyll FilePath +toUrl path = do enableIndexUrl' <- askHakyll enableIndexUrl + -- If the file does not have a renderable extension, like for + -- example favicon.ico, we don't have to change it at all. + return $ if not hasRenderableExtension + then path + -- If index url's are enabled, we create pick it + -- unless the page is an index already. + else if enableIndexUrl' && not isIndex + then indexUrl + else withSimpleHtmlExtension + where + hasRenderableExtension = takeExtension path `elem` [ ".markdown" + , ".md" + , ".mdn" + , ".mdwn" + , ".mkd" + , ".mkdn" + , ".mkdwn" + , ".rst" + , ".text" + , ".tex" + , ".lhs" + , ".htm" + , ".html" + ] + isIndex = (dropExtension $ takeFileName path) == "index" + withSimpleHtmlExtension = flip addExtension ".html" $ dropExtension path + indexUrl = (dropExtension path) ++ "/" + -- | Get the relative url to the site root, for a given (absolute) url toRoot :: FilePath -> FilePath @@ -120,14 +146,22 @@ directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll () directory action dir = getRecursiveContents dir >>= mapM_ action --- | Check if a file is newer then a number of given files. -isMoreRecent :: FilePath -- ^ The cached file. +-- | Check if a timestamp is newer then a number of given files. +isMoreRecent :: ClockTime -- ^ The time to check. -> [FilePath] -- ^ Dependencies of the cached file. -> Hakyll Bool -isMoreRecent file depends = do +isMoreRecent _ [] = return True +isMoreRecent timeStamp depends = do + dependsModified <- liftIO $ mapM getModificationTime depends + return (timeStamp >= maximum dependsModified) + +-- | Check if a file is newer then a number of given files. +isFileMoreRecent :: FilePath -- ^ The cached file. + -> [FilePath] -- ^ Dependencies of the cached file. + -> Hakyll Bool +isFileMoreRecent file depends = do exists <- liftIO $ doesFileExist file if not exists then return False - else do dependsModified <- liftIO $ mapM getModificationTime depends - fileModified <- liftIO $ getModificationTime file - return (fileModified >= maximum dependsModified) + else do timeStamp <- liftIO $ getModificationTime file + isMoreRecent timeStamp depends diff --git a/src/Text/Hakyll/Hakyll.hs b/src/Text/Hakyll/Hakyll.hs --- a/src/Text/Hakyll/Hakyll.hs +++ b/src/Text/Hakyll/Hakyll.hs @@ -19,6 +19,10 @@ siteDirectory :: FilePath , -- | Directory for cache files. cacheDirectory :: FilePath + , -- | Enable index links. + enableIndexUrl :: Bool + , -- | Delay between polls in preview mode. + previewPollDelay :: Int } -- | Our custom monad stack. diff --git a/src/Text/Hakyll/Internal/Cache.hs b/src/Text/Hakyll/Internal/Cache.hs --- a/src/Text/Hakyll/Internal/Cache.hs +++ b/src/Text/Hakyll/Internal/Cache.hs @@ -27,4 +27,4 @@ -- | Check if a file in the cache is more recent than a number of other files. isCacheMoreRecent :: FilePath -> [FilePath] -> Hakyll Bool -isCacheMoreRecent file depends = toCache file >>= flip isMoreRecent depends +isCacheMoreRecent file depends = toCache file >>= flip isFileMoreRecent depends diff --git a/src/Text/Hakyll/Internal/CompressCSS.hs b/src/Text/Hakyll/Internal/CompressCSS.hs deleted file mode 100644 --- a/src/Text/Hakyll/Internal/CompressCSS.hs +++ /dev/null @@ -1,36 +0,0 @@ --- | Module used for CSS compression. The compression is currently in a simple --- state, but would typically reduce the number of bytes by about 25%. -module Text.Hakyll.Internal.CompressCSS - ( compressCSS - ) where - -import Data.List (isPrefixOf) - -import Text.Hakyll.Regex (substituteRegex) - --- | Compress CSS to speed up your site. -compressCSS :: String -> String -compressCSS = compressSeparators - . stripComments - . compressWhitespace - --- | Compresses certain forms of separators. -compressSeparators :: String -> String -compressSeparators = substituteRegex "; *}" "}" - . substituteRegex " *([{};:]) *" "\\1" - . substituteRegex ";;*" ";" - --- | Compresses all whitespace. -compressWhitespace :: String -> String -compressWhitespace = substituteRegex "[ \t\n][ \t\n]*" " " - --- | Function that strips CSS comments away. -stripComments :: String -> String -stripComments [] = [] -stripComments str - | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str - | otherwise = head str : stripComments (tail str) - where - eatComments str' | null str' = [] - | isPrefixOf "*/" str' = drop 2 str' - | otherwise = eatComments $ tail str' diff --git a/src/Text/Hakyll/Internal/CompressCss.hs b/src/Text/Hakyll/Internal/CompressCss.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hakyll/Internal/CompressCss.hs @@ -0,0 +1,36 @@ +-- | Module used for CSS compression. The compression is currently in a simple +-- state, but would typically reduce the number of bytes by about 25%. +module Text.Hakyll.Internal.CompressCss + ( compressCss + ) where + +import Data.List (isPrefixOf) + +import Text.Hakyll.Regex (substituteRegex) + +-- | Compress CSS to speed up your site. +compressCss :: String -> String +compressCss = compressSeparators + . stripComments + . compressWhitespace + +-- | Compresses certain forms of separators. +compressSeparators :: String -> String +compressSeparators = substituteRegex "; *}" "}" + . substituteRegex " *([{};:]) *" "\\1" + . substituteRegex ";;*" ";" + +-- | Compresses all whitespace. +compressWhitespace :: String -> String +compressWhitespace = substituteRegex "[ \t\n][ \t\n]*" " " + +-- | Function that strips CSS comments away. +stripComments :: String -> String +stripComments [] = [] +stripComments str + | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str + | otherwise = head str : stripComments (tail str) + where + eatComments str' | null str' = [] + | isPrefixOf "*/" str' = drop 2 str' + | otherwise = eatComments $ tail str' diff --git a/src/Text/Hakyll/Internal/Render.hs b/src/Text/Hakyll/Internal/Render.hs --- a/src/Text/Hakyll/Internal/Render.hs +++ b/src/Text/Hakyll/Internal/Render.hs @@ -58,11 +58,10 @@ writePage :: Page -> Hakyll () writePage page = do additionalContext' <- askHakyll additionalContext + url <- getUrl page destination <- toDestination url let context = additionalContext' `M.union` M.singleton "root" (toRoot url) makeDirectories destination     -- Substitute $root here, just before writing. liftIO $ writeFile destination $ finalSubstitute (fromString $ getBody page) context - where - url = getURL page diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs --- a/src/Text/Hakyll/Page.hs +++ b/src/Text/Hakyll/Page.hs @@ -30,7 +30,7 @@ -- | A Page is basically key-value mapping. Certain keys have special -- meanings, like for example url, body and title. data Page = Page Context - deriving (Show, Read, Eq) + deriving (Ord, Eq, Show, Read) -- | Create a Page from a key-value mapping. fromContext :: Context -> Page @@ -43,8 +43,8 @@ -- | Get the URL for a certain page. This should always be defined. If -- not, it will error. -getPageURL :: Page -> String -getPageURL (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page +getPageUrl :: Page -> String +getPageUrl (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page -- | Get the original page path. getPagePath :: Page -> String @@ -58,15 +58,24 @@ -- | The default reader options for pandoc parsing. readerOptions :: ParserState -readerOptions = defaultParserState { stateSmart = True } +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 :: String -> (String -> String) getRenderFunction ".html" = id +getRenderFunction ".htm" = id getRenderFunction ext = writeHtmlString writerOptions . readFunction ext (readOptions ext) where @@ -124,6 +133,7 @@ -- Read file. contents <- liftIO $ readFile path + url <- toUrl path let sections = splitAtDelimiters $ lines contents context = concat $ zipWith ($) sectionFunctions sections page = fromContext $ M.fromList $ @@ -134,7 +144,6 @@ return page where - url = toURL path category = let dirs = splitDirectories $ takeDirectory path in [("category", last dirs) | not (null dirs)] @@ -153,7 +162,7 @@ -- Make pages renderable. instance Renderable Page where getDependencies = (:[]) . getPagePath - getURL = getPageURL + getUrl = return . getPageUrl toContext (Page page) = return page -- Make pages serializable. diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -22,7 +22,7 @@ import Text.Hakyll.Renderable import Text.Hakyll.File import Text.Hakyll.Internal.Template (readTemplate) -import Text.Hakyll.Internal.CompressCSS +import Text.Hakyll.Internal.CompressCss import Text.Hakyll.Internal.Render -- | Execute an IO action only when the cache is invalid. @@ -32,7 +32,7 @@ -> Hakyll () depends file dependencies action = do destination <- toDestination file - valid <- isMoreRecent destination dependencies + valid <- isFileMoreRecent destination dependencies unless valid action -- | Render to a Page. @@ -100,8 +100,9 @@ -- @ContextManipulation@ which to apply on the context when it is read first. renderChainWith :: Renderable a => ContextManipulation -> [FilePath] -> a -> Hakyll () -renderChainWith manipulation templatePaths renderable = - depends (getURL renderable) dependencies render' +renderChainWith manipulation templatePaths renderable = do + url <- getUrl renderable + depends url dependencies render' where dependencies = getDependencies renderable ++ templatePaths render' = do @@ -126,4 +127,4 @@ where css' destination = do contents <- liftIO $ readFile source makeDirectories destination - liftIO $ writeFile destination (compressCSS contents) + liftIO $ writeFile destination (compressCss contents) diff --git a/src/Text/Hakyll/Renderable.hs b/src/Text/Hakyll/Renderable.hs --- a/src/Text/Hakyll/Renderable.hs +++ b/src/Text/Hakyll/Renderable.hs @@ -1,5 +1,5 @@ module Text.Hakyll.Renderable - ( Renderable(toContext, getDependencies, getURL) + ( Renderable(toContext, getDependencies, getUrl) ) where import Text.Hakyll.Hakyll (Hakyll) @@ -15,4 +15,4 @@ getDependencies :: a -> [FilePath] -- | Get the destination for the renderable. - getURL :: a -> FilePath + getUrl :: a -> Hakyll FilePath diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs --- a/src/Text/Hakyll/Renderables.hs +++ b/src/Text/Hakyll/Renderables.hs @@ -7,7 +7,7 @@ , createPagePath , CombinedRenderable , combine - , combineWithURL + , combineWithUrl ) where import qualified Data.Map as M @@ -25,7 +25,7 @@ -- | A custom page. data CustomPage = CustomPage - { customPageURL :: String, + { customPageUrl :: String, customPageDependencies :: [FilePath], customPageContext :: [(String, Either String (Hakyll String))] } @@ -85,15 +85,16 @@ instance Renderable CustomPage where getDependencies = customPageDependencies - getURL = customPageURL + getUrl = return . customPageUrl toContext page = do values <- mapM (either return id . snd) (customPageContext page) let pairs = zip (map fst $ customPageContext page) values - return $ M.fromList $ ("url", customPageURL page) : pairs + return $ M.fromList $ ("url", customPageUrl page) : pairs -- | PagePath is a class that wraps a FilePath. This is used to render Pages -- without reading them first through use of caching. data PagePath = PagePath FilePath + deriving (Ord, Eq, Read, Show) -- | Create a PagePath from a FilePath. createPagePath :: FilePath -> PagePath @@ -102,7 +103,7 @@ -- We can render filepaths instance Renderable PagePath where getDependencies (PagePath path) = return path - getURL (PagePath path) = toURL path + getUrl (PagePath path) = toUrl path toContext (PagePath path) = readPage path >>= toContext -- We can serialize filepaths @@ -112,7 +113,8 @@ -- | A combination of two other renderables. data CombinedRenderable a b = CombinedRenderable a b - | CombinedRenderableWithURL FilePath a b + | CombinedRenderableWithUrl FilePath a b + deriving (Ord, Eq, Read, Show) -- | Combine two renderables. The url will always be taken from the first -- @Renderable@. Also, if a `$key` is present in both renderables, the @@ -125,12 +127,12 @@ -- | Combine two renderables and set a custom URL. This behaves like @combine@, -- except that for the @url@ field, the given URL is always chosen. -combineWithURL :: (Renderable a, Renderable b) +combineWithUrl :: (Renderable a, Renderable b) => FilePath -> a -> b -> CombinedRenderable a b -combineWithURL = CombinedRenderableWithURL +combineWithUrl = CombinedRenderableWithUrl -- Render combinations. instance (Renderable a, Renderable b) @@ -139,18 +141,18 @@ -- Add the dependencies. getDependencies (CombinedRenderable a b) = getDependencies a ++ getDependencies b - getDependencies (CombinedRenderableWithURL _ a b) = + getDependencies (CombinedRenderableWithUrl _ a b) = getDependencies a ++ getDependencies b -- Take the url from the first renderable, or the specified URL. - getURL (CombinedRenderable a _) = getURL a - getURL (CombinedRenderableWithURL url _ _) = url + getUrl (CombinedRenderable a _) = getUrl a + getUrl (CombinedRenderableWithUrl url _ _) = return url -- Take a union of the contexts. toContext (CombinedRenderable a b) = do c1 <- toContext a c2 <- toContext b return $ c1 `M.union` c2 - toContext (CombinedRenderableWithURL url a b) = do + toContext (CombinedRenderableWithUrl url a b) = do c <- toContext (CombinedRenderable a b) return $ M.singleton "url" url `M.union` c diff --git a/src/Text/Hakyll/Util.hs b/src/Text/Hakyll/Util.hs --- a/src/Text/Hakyll/Util.hs +++ b/src/Text/Hakyll/Util.hs @@ -1,7 +1,7 @@ -- | Miscellaneous text manipulation functions. module Text.Hakyll.Util ( trim - , stripHTML + , stripHtml , link ) where @@ -14,11 +14,11 @@ trim' = dropWhile isSpace -- | Strip html tags from the given string. -stripHTML :: String -> String -stripHTML [] = [] -stripHTML str = let (beforeTag, rest) = break (== '<') str +stripHtml :: String -> String +stripHtml [] = [] +stripHtml str = let (beforeTag, rest) = break (== '<') str (_, afterTag) = break (== '>') rest - in beforeTag ++ stripHTML (tail' afterTag) + in beforeTag ++ stripHtml (tail' afterTag) where -- We need a failsafe tail function. tail' [] = []