diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 3.1.2.2 +Version: 3.1.2.3 Synopsis: A simple static site generator library. Description: A simple static site generator library, mainly aimed at @@ -24,7 +24,7 @@ source-repository head type: git - location: git://github.com/jaspervdj/Hakyll.git + location: git://github.com/jaspervdj/hakyll.git flag inotify description: Use the inotify bindings for the preview server. Better, but diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -84,6 +84,10 @@ -- function. So, the 'require' function actually helps to reduce to complexity -- of Hakyll applications! -- +-- Note that require will fetch a previously compiled item: in our example of +-- the type @a@. It is /very/ important that the compiler which produced this +-- value, produced the right type as well! +-- {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hakyll.Core.Compiler ( Compiler @@ -213,12 +217,18 @@ store <- compilerStore <$> ask result <- liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" id' case result of - Nothing -> throwError error' - Just x -> return x + NotFound -> throwError notFound + WrongType e r -> throwError $ wrongType e r + Found x -> return x where - error' = "Hakyll.Core.Compiler.getDependency: " ++ show id' - ++ " not found in the cache, the cache might be corrupted or" - ++ " the item you are referring to might not exist" + notFound = + "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " not found " ++ + "not found in the cache, the cache might be corrupted or " ++ + "the item you are referring to might not exist" + wrongType e r = + "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was found " ++ + "in the cache, but does not have the right type: expected " ++ show e ++ + " but got " ++ show r -- | Variant of 'require' which drops the current value -- @@ -289,8 +299,8 @@ liftIO $ storeSet store name identifier v return v else do v <- liftIO $ storeGet store name identifier - case v of Just v' -> return v' - Nothing -> throwError error' + case v of Found v' -> return v' + _ -> throwError error' where error' = "Hakyll.Core.Compiler.cached: Cache corrupt!" diff --git a/src/Hakyll/Core/Resource/Provider.hs b/src/Hakyll/Core/Resource/Provider.hs --- a/src/Hakyll/Core/Resource/Provider.hs +++ b/src/Hakyll/Core/Resource/Provider.hs @@ -90,7 +90,7 @@ -- Calculate the digest for the resource newDigest <- resourceDigest provider resource -- Check digests - if Just newDigest == lastDigest + if Found newDigest == lastDigest -- All is fine, not modified then return False -- Resource modified; store new digest diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -14,7 +14,6 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Monoid (mempty, mappend) -import Data.Maybe (fromMaybe) import System.FilePath (()) import qualified Data.Set as S @@ -48,8 +47,9 @@ -- Fetch the old graph from the store. If we don't find it, we consider this -- to be the first run - (firstRun, oldGraph) <- fromMaybe (True, mempty) . fmap ((,) False) <$> - storeGet store "Hakyll.Core.Run.run" "dependencies" + graph <- storeGet store "Hakyll.Core.Run.run" "dependencies" + let (firstRun, oldGraph) = case graph of Found g -> (False, g) + _ -> (True, mempty) let ruleSet = runRules rules provider compilers = rulesCompilers ruleSet diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs --- a/src/Hakyll/Core/Store.hs +++ b/src/Hakyll/Core/Store.hs @@ -1,8 +1,9 @@ -- | A store for stroing and retreiving items -- -{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-} module Hakyll.Core.Store ( Store + , StoreGet (..) , makeStore , storeSet , storeGet @@ -16,7 +17,7 @@ import qualified Data.Map as M import Data.Binary (Binary, encodeFile, decodeFile) -import Data.Typeable (Typeable, cast) +import Data.Typeable (Typeable, TypeRep, cast, typeOf) import Hakyll.Core.Identifier import Hakyll.Core.Util.File @@ -25,6 +26,13 @@ -- data Storable = forall a. (Binary a, Typeable a) => Storable a +-- | Result when an item from the store +-- +data StoreGet a = Found a + | NotFound + | WrongType TypeRep TypeRep + deriving (Show, Eq) + -- | Data structure used for the store -- data Store = Store @@ -71,23 +79,25 @@ -- | Load an item -- -storeGet :: (Binary a, Typeable a) - => Store -> String -> Identifier -> IO (Maybe a) +storeGet :: forall a. (Binary a, Typeable a) + => Store -> String -> Identifier -> IO (StoreGet a) storeGet store name identifier = do -- First check the in-memory map map' <- readMVar $ storeMap store case M.lookup path map' of -- Found in the in-memory map - Just (Storable s) -> return $ cast s + Just (Storable s) -> return $ case cast s of + Nothing -> WrongType (typeOf s) $ typeOf (undefined :: a) + Just s' -> Found s' -- Not found in the map, try the filesystem Nothing -> do exists <- doesFileExist path if not exists -- Not found in the filesystem either - then return Nothing + then return NotFound -- Found in the filesystem else do v <- decodeFile path addToMap store path v - return $ Just v + return $ Found v where path = makePath store name identifier diff --git a/src/Hakyll/Web/Pandoc.hs b/src/Hakyll/Web/Pandoc.hs --- a/src/Hakyll/Web/Pandoc.hs +++ b/src/Hakyll/Web/Pandoc.hs @@ -22,34 +22,40 @@ import Control.Applicative ((<$>)) import Control.Arrow ((>>^), (&&&)) import Control.Category (id) +import Data.Maybe (fromMaybe) import Text.Pandoc import Hakyll.Core.Compiler +import Hakyll.Core.Identifier import Hakyll.Web.Pandoc.FileType import Hakyll.Web.Page.Internal -- | Read a string using pandoc, with the default options -- readPandoc :: FileType -- ^ File type, determines how parsing happens + -> Maybe Identifier -- ^ Optional, for better error messages -> String -- ^ String to read -> Pandoc -- ^ Resulting document readPandoc = readPandocWith defaultHakyllParserState -- | Read a string using pandoc, with the supplied options -- -readPandocWith :: ParserState -- ^ Parser options - -> FileType -- ^ File type, determines how parsing happens - -> String -- ^ String to read - -> Pandoc -- ^ Resulting document -readPandocWith state fileType' = case fileType' of +readPandocWith :: ParserState -- ^ Parser options + -> FileType -- ^ File type, determines parsing method + -> Maybe Identifier -- ^ Optional, for better error messages + -> String -- ^ String to read + -> Pandoc -- ^ Resulting document +readPandocWith state fileType' id' = case fileType' of Html -> readHtml state LaTeX -> readLaTeX state - LiterateHaskell t -> readPandocWith state {stateLiterateHaskell = True} t + LiterateHaskell t -> + readPandocWith state {stateLiterateHaskell = True} t id' Markdown -> readMarkdown state Rst -> readRST state t -> error $ - "Hakyll.Web.readPandocWith: I don't know how to read " ++ show t + "Hakyll.Web.readPandocWith: I don't know how to read a file of the " ++ + "type " ++ show t ++ fromMaybe "" (fmap ((" for: " ++) . show) id') -- | Write a document (as HTML) using pandoc, with the default options -- @@ -73,9 +79,9 @@ -- pageReadPandocWith :: ParserState -> Compiler (Page String) (Page Pandoc) pageReadPandocWith state = - id &&& getFileType >>^ pageReadPandocWith' + id &&& getIdentifier &&& getFileType >>^ pageReadPandocWith' where - pageReadPandocWith' (p, t) = readPandocWith state t <$> p + pageReadPandocWith' (p, (i, t)) = readPandocWith state t (Just i) <$> p -- | Render the resource using pandoc -- diff --git a/src/Hakyll/Web/Preview/Server.hs b/src/Hakyll/Web/Preview/Server.hs --- a/src/Hakyll/Web/Preview/Server.hs +++ b/src/Hakyll/Web/Preview/Server.hs @@ -37,7 +37,7 @@ static directory preServe = do -- Obtain the path uri <- rqURI <$> getRequest - let filePath = replaceAll "\\?$" (const "") -- Remove trailing ? + let filePath = replaceAll "\\?.*$" (const "") -- Remove trailing ? $ replaceAll "#[^#]*$" (const "") -- Remove #section $ replaceAll "^/" (const "") -- Remove leading / $ urlDecode $ decode $ SB.unpack uri