From 25b8c8b199082ebbc41d1af03fc19202b798f156 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <m@jaspervdj.be>
Date: Sun, 25 Nov 2012 10:45:55 +0100
Subject: A bit of cleanup
---
src/Hakyll/Core/Compiler/Internal.hs | 2 ++
src/Hakyll/Core/Compiler/Require.hs | 13 ++++++++++++-
src/Hakyll/Core/Configuration.hs | 12 +++++++-----
src/Hakyll/Core/Identifier.hs | 27 ++-------------------------
src/Hakyll/Core/Identifier/Pattern.hs | 3 ++-
src/Hakyll/Core/Rules/Internal.hs | 15 ++++++---------
src/Hakyll/Core/Runtime.hs | 3 ++-
src/Hakyll/Core/Util/File.hs | 33 +++++----------------------------
8 files changed, 38 insertions(+), 70 deletions(-)
(limited to 'src')
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 981ddda..8eb950c 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -82,6 +82,8 @@ data CompilerResult a where
--------------------------------------------------------------------------------
+-- | A monad which lets you compile items and takes care of dependency tracking
+-- for you.
newtype Compiler a = Compiler
{ unCompiler :: CompilerRead -> IO (CompilerResult a)
}
diff --git a/src/Hakyll/Core/Compiler/Require.hs b/src/Hakyll/Core/Compiler/Require.hs
index 3c6ddfc..f67bf2c 100644
--- a/src/Hakyll/Core/Compiler/Require.hs
+++ b/src/Hakyll/Core/Compiler/Require.hs
@@ -30,6 +30,8 @@ import qualified Hakyll.Core.Store as Store
--------------------------------------------------------------------------------
+-- | Whilst compiling an item, it possible to save multiple snapshots of it, and
+-- not just the final result.
type Snapshot = String
@@ -39,6 +41,8 @@ save store item = saveSnapshot store final item
--------------------------------------------------------------------------------
+-- | Save a specific snapshot of an item, so you can load it later using
+-- 'requireSnapshot'.
saveSnapshot :: (Binary a, Typeable a)
=> Store -> Snapshot -> Item a -> IO ()
saveSnapshot store snapshot item =
@@ -46,11 +50,14 @@ saveSnapshot store snapshot item =
--------------------------------------------------------------------------------
+-- | Load an item compiled elsewhere. If the required item is not yet compiled,
+-- the build system will take care of that automatically.
require :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)
require id' = requireSnapshot id' final
--------------------------------------------------------------------------------
+-- | Require a specific snapshot of an item.
requireSnapshot :: (Binary a, Typeable a)
=> Identifier -> Snapshot -> Compiler (Item a)
requireSnapshot id' snapshot = do
@@ -77,6 +84,9 @@ requireSnapshot id' snapshot = do
--------------------------------------------------------------------------------
+-- | A shortcut for only requiring the body of an item.
+--
+-- > requireBody = fmap itemBody . require
requireBody :: (Binary a, Typeable a) => Identifier -> Compiler a
requireBody id' = requireSnapshotBody id' final
@@ -88,6 +98,7 @@ requireSnapshotBody id' snapshot = fmap itemBody $ requireSnapshot id' snapshot
--------------------------------------------------------------------------------
+-- | This function allows you to 'require' a dynamic list of items
requireAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]
requireAll pattern = requireAllSnapshots pattern final
@@ -108,4 +119,4 @@ key identifier snapshot =
--------------------------------------------------------------------------------
final :: Snapshot
-final = "final"
+final = "_final"
diff --git a/src/Hakyll/Core/Configuration.hs b/src/Hakyll/Core/Configuration.hs
index d57eb2e..c859585 100644
--- a/src/Hakyll/Core/Configuration.hs
+++ b/src/Hakyll/Core/Configuration.hs
@@ -9,7 +9,7 @@ module Hakyll.Core.Configuration
--------------------------------------------------------------------------------
import Data.List (isPrefixOf, isSuffixOf)
-import System.FilePath (takeFileName)
+import System.FilePath (normalise, takeFileName)
--------------------------------------------------------------------------------
@@ -79,7 +79,7 @@ defaultConfiguration = Configuration
| "#" `isPrefixOf` fileName = True
| "~" `isSuffixOf` fileName = True
| ".swp" `isSuffixOf` fileName = True
- | otherwise = False
+ | otherwise = False
where
fileName = takeFileName path
@@ -88,6 +88,8 @@ defaultConfiguration = Configuration
-- | Check if a file should be ignored
shouldIgnoreFile :: Configuration -> FilePath -> Bool
shouldIgnoreFile conf path =
- destinationDirectory conf `isPrefixOf` path ||
- storeDirectory conf `isPrefixOf` path ||
- ignoreFile conf path
+ destinationDirectory conf `isPrefixOf` path' ||
+ storeDirectory conf `isPrefixOf` path' ||
+ ignoreFile conf path'
+ where
+ path' = normalise path
diff --git a/src/Hakyll/Core/Identifier.hs b/src/Hakyll/Core/Identifier.hs
index 876d0fe..7ac06d8 100644
--- a/src/Hakyll/Core/Identifier.hs
+++ b/src/Hakyll/Core/Identifier.hs
@@ -1,34 +1,12 @@
--------------------------------------------------------------------------------
--- | An identifier is a type used to uniquely identify a resource, target...
---
--- One can think of an identifier as something similar to a file path. An
--- identifier is a path as well, with the different elements in the path
--- separated by @/@ characters. Examples of identifiers are:
+-- | An identifier is a type used to uniquely identify an item. An identifier is
+-- conceptually similar to a file path. Examples of identifiers are:
--
-- * @posts/foo.markdown@
--
-- * @index@
--
-- * @error/404@
---
--- The most important difference between an 'Identifier' and a file path is that
--- the identifier for an item is not necesserily the file path.
---
--- For example, we could have an @index@ identifier, generated by Hakyll. The
--- actual file path would be @index.html@, but we identify it using @index@.
---
--- @posts/foo.markdown@ could be an identifier of an item that is rendered to
--- @posts/foo.html@. In this case, the identifier is the name of the source
--- file of the page.
---
--- An `Identifier` carries the type of the value it identifies. This basically
--- means that an @Identifier (Page String)@ refers to a page.
---
--- It is a phantom type parameter, meaning you can safely change this if you
--- know what you are doing. You can change the type using the 'castIdentifier'
--- function.
---
--- If the @a@ type is not known, Hakyll traditionally uses @Identifier ()@.
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Core.Identifier
@@ -54,7 +32,6 @@ import GHC.Exts (IsString, fromString)
--------------------------------------------------------------------------------
--- | An identifier used to uniquely identify a value
data Identifier = Identifier
{ identifierVersion :: Maybe String
, identifierPath :: String
diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs
index 97806d5..61efc65 100644
--- a/src/Hakyll/Core/Identifier/Pattern.hs
+++ b/src/Hakyll/Core/Identifier/Pattern.hs
@@ -149,7 +149,7 @@ instance Monoid Pattern where
--------------------------------------------------------------------------------
--- | THis is necessary for good 'isLiteral' results
+-- | This is necessary for good 'isLiteral' results
optimize :: Pattern -> Pattern
optimize (Complement x) = Complement (optimize x)
optimize (And x Everything) = x
@@ -189,6 +189,7 @@ fromRegex = Regex
--------------------------------------------------------------------------------
+-- | Create a pattern which matches all items with the given version.
fromVersion :: Maybe String -> Pattern
fromVersion = Version
diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs
index df42d11..4f44bd6 100644
--- a/src/Hakyll/Core/Rules/Internal.hs
+++ b/src/Hakyll/Core/Rules/Internal.hs
@@ -1,10 +1,9 @@
--------------------------------------------------------------------------------
--- | Internal rules module for types which are not exposed to the user
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Rank2Types #-}
module Hakyll.Core.Rules.Internal
( RuleSet (..)
- , RuleEnvironment (..)
+ , RulesRead (..)
, Rules (..)
, runRules
) where
@@ -31,11 +30,10 @@ import Hakyll.Core.Routes
--------------------------------------------------------------------------------
--- | A collection of rules for the compilation process
data RuleSet = RuleSet
- { -- | Routes used in the compilation structure
+ { -- | Accumulated routes
rulesRoutes :: Routes
- , -- | Compilation rules
+ , -- | Accumulated compilers
rulesCompilers :: [(Identifier, Compiler SomeItem)]
, -- | A set of the actually used files
rulesResources :: Set Identifier
@@ -50,8 +48,7 @@ instance Monoid RuleSet where
--------------------------------------------------------------------------------
--- | Rule environment
-data RuleEnvironment = RuleEnvironment
+data RulesRead = RulesRead
{ rulesProvider :: Provider
, rulesPattern :: Pattern
, rulesVersion :: Maybe String
@@ -61,7 +58,7 @@ data RuleEnvironment = RuleEnvironment
--------------------------------------------------------------------------------
-- | The monad used to compose rules
newtype Rules a = Rules
- { unRules :: RWST RuleEnvironment RuleSet () IO a
+ { unRules :: RWST RulesRead RuleSet () IO a
} deriving (Monad, Functor, Applicative)
@@ -83,7 +80,7 @@ runRules rules provider = do
(_, _, ruleSet) <- runRWST (unRules rules) env ()
return $ nubCompilers ruleSet
where
- env = RuleEnvironment
+ env = RulesRead
{ rulesProvider = provider
, rulesPattern = mempty
, rulesVersion = Nothing
diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs
index cdc7fdb..46c7d1e 100644
--- a/src/Hakyll/Core/Runtime.hs
+++ b/src/Hakyll/Core/Runtime.hs
@@ -48,7 +48,8 @@ run config rules = do
Logger.message logger "Creating store..."
store <- Store.new (inMemoryCache config) $ storeDirectory config
Logger.message logger "Creating provider..."
- provider <- newProvider store (ignoreFile config) $ providerDirectory config
+ provider <- newProvider store (shouldIgnoreFile config) $
+ providerDirectory config
Logger.message logger "Running rules..."
ruleSet <- runRules rules provider
diff --git a/src/Hakyll/Core/Util/File.hs b/src/Hakyll/Core/Util/File.hs
index 85fbd76..6d6b5c2 100644
--- a/src/Hakyll/Core/Util/File.hs
+++ b/src/Hakyll/Core/Util/File.hs
@@ -3,23 +3,15 @@
module Hakyll.Core.Util.File
( makeDirectories
, getRecursiveContents
- , isFileInternal
) where
--------------------------------------------------------------------------------
-import Control.Applicative ((<$>))
-import Control.Monad (forM)
-import Data.List (isPrefixOf)
-import System.Directory (createDirectoryIfMissing,
- doesDirectoryExist,
- getDirectoryContents)
-import System.FilePath (dropTrailingPathSeparator,
- splitPath, takeDirectory, (</>))
-
-
---------------------------------------------------------------------------------
-import Hakyll.Core.Configuration
+import Control.Applicative ((<$>))
+import Control.Monad (forM)
+import System.Directory (createDirectoryIfMissing,
+ doesDirectoryExist, getDirectoryContents)
+import System.FilePath (takeDirectory, (</>))
--------------------------------------------------------------------------------
@@ -50,18 +42,3 @@ getRecursiveContents top = go ""
else return [rel]
return $ concat paths
-
-
---------------------------------------------------------------------------------
--- | Check if a file is meant for Hakyll internal use, i.e. if it is located in
--- the destination or store directory
-isFileInternal :: Configuration -- ^ Configuration
- -> FilePath -- ^ File to check
- -> Bool -- ^ If the given file is internal
-isFileInternal configuration file =
- any (`isPrefixOf` split file) dirs
- where
- split = map dropTrailingPathSeparator . splitPath
- dirs = map (split . ($ configuration)) [ destinationDirectory
- , storeDirectory
- ]
--
cgit v1.2.3