diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 3.2.6.1 +Version: 3.2.6.2 Synopsis: A static website compiler library Description: @@ -37,7 +37,7 @@ License-File: LICENSE Category: Web -Cabal-Version: >= 1.6 +Cabal-Version: >= 1.8 Build-Type: Simple Data-Dir: data Data-Files: @@ -136,10 +136,46 @@ If flag(previewServer) Build-depends: - snap-core >= 0.6 && < 0.8, - snap-server >= 0.6 && < 0.8 + snap-core >= 0.6 && < 0.9, + snap-server >= 0.6 && < 0.9 Cpp-Options: -DPREVIEW_SERVER Other-Modules: Hakyll.Web.Preview.Poll Hakyll.Web.Preview.Server + +Test-suite hakyll-tests + Type: exitcode-stdio-1.0 + Hs-source-dirs: src tests + Main-is: TestSuite.hs + Ghc-options: -Wall + + Build-Depends: + HUnit >= 1.2 && < 1.3, + QuickCheck >= 2.4 && < 2.5, + test-framework >= 0.4 && < 0.7, + test-framework-hunit >= 0.2 && < 0.3, + test-framework-quickcheck2 >= 0.2 && < 0.3, + -- Copy pasted from hakyll dependencies: + base >= 4 && < 5, + binary >= 0.5 && < 0.6, + blaze-html >= 0.4 && < 0.6, + bytestring >= 0.9 && < 0.10, + citeproc-hs >= 0.3.2 && < 0.4, + containers >= 0.3 && < 0.5, + cryptohash >= 0.7 && < 0.8, + directory >= 1.0 && < 1.2, + filepath >= 1.0 && < 1.4, + hamlet >= 0.10.3 && < 0.11, + mtl >= 1 && < 2.1, + old-locale >= 1.0 && < 1.1, + old-time >= 1.0 && < 1.2, + pandoc >= 1.9 && < 1.10, + parsec >= 3.0 && < 3.2, + process >= 1.0 && < 1.2, + regex-base >= 0.93 && < 0.94, + regex-tdfa >= 1.1 && < 1.2, + tagsoup >= 0.12.6 && < 0.13, + text >= 0.11 && < 0.12, + time >= 1.1 && < 1.5, + unix >= 2.4 && < 2.6 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 @@ -88,7 +88,7 @@ -- the type @a@. It is /very/ important that the compiler which produced this -- value, produced the right type as well! -- -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-} module Hakyll.Core.Compiler ( Compiler , runCompiler @@ -111,17 +111,19 @@ , traceShowCompiler , mapCompiler , timedCompiler + , byPattern , byExtension ) where import Prelude hiding ((.), id) -import Control.Arrow ((>>>), (&&&), arr) +import Control.Arrow ((>>>), (&&&), arr, first) import Control.Applicative ((<$>)) +import Control.Exception (SomeException, handle) import Control.Monad.Reader (ask) import Control.Monad.Trans (liftIO) import Control.Monad.Error (throwError) import Control.Category (Category, (.), id) -import Data.Maybe (fromMaybe) +import Data.List (find) import System.FilePath (takeExtension) import Data.Binary (Binary) @@ -154,8 +156,9 @@ -> IO (Throwing CompileRule) -- ^ Resulting item runCompiler compiler id' provider universe routes store modified logger = do -- Run the compiler job - result <- runCompilerJob compiler id' provider universe - routes store modified logger + result <- handle (\(e :: SomeException) -> return $ Left $ show e) $ + runCompilerJob compiler id' provider universe routes store modified + logger -- Inspect the result case result of @@ -342,33 +345,50 @@ logger <- compilerLogger <$> ask timed logger msg $ unCompilerM $ j x --- | Choose a compiler by extension +-- | Choose a compiler by identifier -- --- Example: +-- For example, assume that most content files need to be compiled +-- normally, but a select few need an extra step in the pipeline: -- --- > route "css/*" $ setExtension "css" --- > compile "css/*" $ byExtension (error "Not a (S)CSS file") --- > [ (".css", compressCssCompiler) --- > , (".scss", sass) +-- > compile $ pageCompiler >>> byPattern id +-- > [ ("projects.md", addProjectListCompiler) +-- > , ("sitemap.md", addSiteMapCompiler) -- > ] -- --- This piece of code will select the @compressCssCompiler@ for @.css@ files, --- and the @sass@ compiler (defined elsewhere) for @.scss@ files. --- -byExtension :: Compiler a b -- ^ Default compiler - -> [(String, Compiler a b)] -- ^ Choices - -> Compiler a b -- ^ Resulting compiler -byExtension defaultCompiler choices = Compiler deps job +byPattern :: Compiler a b -- ^ Default compiler + -> [(Pattern (), Compiler a b)] -- ^ Choices + -> Compiler a b -- ^ Resulting compiler +byPattern defaultCompiler choices = Compiler deps job where -- Lookup the compiler, give an error when it is not found - lookup' identifier = - let extension = takeExtension $ toFilePath identifier - in fromMaybe defaultCompiler $ lookup extension choices + lookup' identifier = maybe defaultCompiler snd $ + find (\(p, _) -> matches p identifier) choices -- Collect the dependencies of the choice deps = do - identifier <- dependencyIdentifier <$> ask + identifier <- castIdentifier . dependencyIdentifier <$> ask compilerDependencies $ lookup' identifier -- Collect the job of the choice job x = CompilerM $ do - identifier <- compilerIdentifier <$> ask + identifier <- castIdentifier . compilerIdentifier <$> ask unCompilerM $ compilerJob (lookup' identifier) x + +-- | Choose a compiler by extension +-- +-- Example: +-- +-- > match "css/*" $ do +-- > route $ setExtension "css" +-- > compile $ byExtension (error "Not a (S)CSS file") +-- > [ (".css", compressCssCompiler) +-- > , (".scss", sass) +-- > ] +-- +-- This piece of code will select the @compressCssCompiler@ for @.css@ files, +-- and the @sass@ compiler (defined elsewhere) for @.scss@ files. +-- +byExtension :: Compiler a b -- ^ Default compiler + -> [(String, Compiler a b)] -- ^ Choices + -> Compiler a b -- ^ Resulting compiler +byExtension defaultCompiler = byPattern defaultCompiler . map (first extPattern) + where + extPattern c = predicate $ (== c) . takeExtension . toFilePath diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs --- a/src/Hakyll/Core/Identifier/Pattern.hs +++ b/src/Hakyll/Core/Identifier/Pattern.hs @@ -36,13 +36,19 @@ -- function. -- module Hakyll.Core.Identifier.Pattern - ( Pattern + ( -- * The pattern type + Pattern , castPattern + + -- * Creating patterns , parseGlob , predicate , list , regex , inGroup + , complement + + -- * Applying patterns , matches , filterMatches , capture @@ -130,6 +136,15 @@ -- inGroup :: Maybe String -> Pattern a inGroup group = predicate $ (== group) . identifierGroup + +-- | Inverts a pattern, e.g. +-- +-- > complement "foo/bar.html" +-- +-- will match /anything/ except @\"foo\/bar.html\"@ +-- +complement :: Pattern a -> Pattern a +complement p = predicate (not . matches p) -- | Check if an identifier matches a pattern -- diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -140,7 +140,9 @@ -- This sets a compiler for the given identifier. No resource is needed, since -- we are creating the item from scratch. This is useful if you want to create a -- page on your site that just takes content from other items -- but has no --- actual content itself. +-- actual content itself. Note that the group of the given identifier is +-- replaced by the group set via 'group' (or 'Nothing', if 'group' has not been +-- used). -- create :: (Binary a, Typeable a, Writable a) => Identifier a -> Compiler () a -> RulesM (Identifier a) 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 @@ -5,33 +5,34 @@ ( run ) where -import Prelude hiding (reverse) -import Control.Monad (filterM, forM_) -import Control.Monad.Trans (liftIO) import Control.Applicative (Applicative, (<$>)) +import Control.Monad (filterM, forM_) +import Control.Monad.Error (ErrorT, runErrorT, throwError) import Control.Monad.Reader (ReaderT, runReaderT, ask) import Control.Monad.State.Strict (StateT, runStateT, get, put) +import Control.Monad.Trans (liftIO) import Data.Map (Map) -import qualified Data.Map as M import Data.Monoid (mempty, mappend) +import Prelude hiding (reverse) import System.FilePath (()) +import qualified Data.Map as M import qualified Data.Set as S -import Hakyll.Core.Routes -import Hakyll.Core.Identifier -import Hakyll.Core.Util.File import Hakyll.Core.Compiler import Hakyll.Core.Compiler.Internal +import Hakyll.Core.Configuration +import Hakyll.Core.DependencyAnalyzer +import Hakyll.Core.DirectedGraph +import Hakyll.Core.Identifier +import Hakyll.Core.Logger import Hakyll.Core.Resource import Hakyll.Core.Resource.Provider import Hakyll.Core.Resource.Provider.File +import Hakyll.Core.Routes import Hakyll.Core.Rules.Internal -import Hakyll.Core.DirectedGraph -import Hakyll.Core.DependencyAnalyzer -import Hakyll.Core.Writable import Hakyll.Core.Store -import Hakyll.Core.Configuration -import Hakyll.Core.Logger +import Hakyll.Core.Util.File +import Hakyll.Core.Writable -- | Run all rules needed, return the rule set used -- @@ -66,14 +67,18 @@ } -- Run the program and fetch the resulting state - ((), state') <- runStateT stateT $ RuntimeState + result <- runErrorT $ runStateT stateT $ RuntimeState { hakyllAnalyzer = makeDependencyAnalyzer mempty (const False) oldGraph , hakyllCompilers = M.empty } - -- We want to save the final dependency graph for the next run - storeSet store "Hakyll.Core.Run.run" "dependencies" $ - analyzerGraph $ hakyllAnalyzer state' + case result of + Left e -> + thrown logger e + Right ((), state') -> + -- We want to save the final dependency graph for the next run + storeSet store "Hakyll.Core.Run.run" "dependencies" $ + analyzerGraph $ hakyllAnalyzer state' -- Flush and return flushLogger logger @@ -94,7 +99,8 @@ } newtype Runtime a = Runtime - { unRuntime :: ReaderT RuntimeEnvironment (StateT RuntimeState IO) a + { unRuntime :: ReaderT RuntimeEnvironment + (StateT RuntimeState (ErrorT String IO)) a } deriving (Functor, Applicative, Monad) -- | Add a number of compilers and continue using these compilers @@ -205,7 +211,5 @@ -- Actually I was just kidding, it's not hard at all unRuntime $ addNewCompilers newCompilers - -- Some error happened, log and continue - Left err -> do - thrown logger err - unRuntime stepAnalyzer + -- Some error happened, rethrow in Runtime monad + Left err -> throwError err diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs new file mode 100644 --- /dev/null +++ b/tests/TestSuite.hs @@ -0,0 +1,53 @@ +module Main where + +import Test.Framework (defaultMain, testGroup) + +import qualified Hakyll.Core.Compiler.Tests +import qualified Hakyll.Core.DependencyAnalyzer.Tests +import qualified Hakyll.Core.Identifier.Tests +import qualified Hakyll.Core.Routes.Tests +import qualified Hakyll.Core.Rules.Tests +import qualified Hakyll.Core.Store.Tests +import qualified Hakyll.Core.UnixFilter.Tests +import qualified Hakyll.Core.Util.Arrow.Tests +import qualified Hakyll.Core.Util.String.Tests +import qualified Hakyll.Web.Page.Tests +import qualified Hakyll.Web.Page.Metadata.Tests +import qualified Hakyll.Web.Template.Tests +import qualified Hakyll.Web.Urls.Tests +import qualified Hakyll.Web.Urls.Relativize.Tests +import qualified Hakyll.Web.Util.Html.Tests + +main :: IO () +main = defaultMain + [ testGroup "Hakyll.Core.Compiler.Tests" + Hakyll.Core.Compiler.Tests.tests + , testGroup "Hakyll.Core.DependencyAnalyzer.Tests" + Hakyll.Core.DependencyAnalyzer.Tests.tests + , testGroup "Hakyll.Core.Identifier.Tests" + Hakyll.Core.Identifier.Tests.tests + , testGroup "Hakyll.Core.Routes.Tests" + Hakyll.Core.Routes.Tests.tests + , testGroup "Hakyll.Core.Rules.Tests" + Hakyll.Core.Rules.Tests.tests + , testGroup "Hakyll.Core.Store.Tests" + Hakyll.Core.Store.Tests.tests + , testGroup "Hakyll.Core.UnixFilter.Tests" + Hakyll.Core.UnixFilter.Tests.tests + , testGroup "Hakyll.Core.Util.Arrow.Tests" + Hakyll.Core.Util.Arrow.Tests.tests + , testGroup "Hakyll.Core.Util.String.Tests" + Hakyll.Core.Util.String.Tests.tests + , testGroup "Hakyll.Web.Page.Tests" + Hakyll.Web.Page.Tests.tests + , testGroup "Hakyll.Web.Page.Metadata.Tests" + Hakyll.Web.Page.Metadata.Tests.tests + , testGroup "Hakyll.Web.Template.Tests" + Hakyll.Web.Template.Tests.tests + , testGroup "Hakyll.Web.Urls.Tests" + Hakyll.Web.Urls.Tests.tests + , testGroup "Hakyll.Web.Urls.Relativize.Tests" + Hakyll.Web.Urls.Relativize.Tests.tests + , testGroup "Hakyll.Web.Util.Html.Tests" + Hakyll.Web.Util.Html.Tests.tests + ]