summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Hakyll/Core/Compiler.hs36
-rw-r--r--src/Hakyll/Core/Compiler/Internal.hs24
-rw-r--r--src/Hakyll/Core/Identifier.hs32
-rw-r--r--src/Hakyll/Core/Identifier/Pattern.hs61
-rw-r--r--src/Hakyll/Core/Resource.hs4
-rw-r--r--src/Hakyll/Core/Routes.hs13
-rw-r--r--src/Hakyll/Core/Rules.hs45
-rw-r--r--src/Hakyll/Core/Rules/Internal.hs8
-rw-r--r--src/Hakyll/Core/Run.hs10
-rw-r--r--src/Hakyll/Core/Store.hs6
-rw-r--r--src/Hakyll/Core/Writable.hs4
-rw-r--r--src/Hakyll/Web/Pandoc.hs18
-rw-r--r--src/Hakyll/Web/Tags.hs12
-rw-r--r--src/Hakyll/Web/Template.hs2
14 files changed, 160 insertions, 115 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index 6960fd1..909f945 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -53,7 +53,7 @@
-- This illustration can help us understand the type signature of 'require'.
--
-- > require :: (Binary a, Typeable a, Writable a)
--- > => Identifier
+-- > => Identifier a
-- > -> (b -> a -> c)
-- > -> Compiler b c
--
@@ -64,7 +64,7 @@
-- These are constraints for the @a@ type. @a@ (the template) needs to have
-- certain properties for it to be required.
--
--- > Identifier
+-- > Identifier a
--
-- This is simply @templates/fancy.html@: the 'Identifier' of the item we want
-- to 'require', in other words, the name of the item we want to add to the
@@ -143,9 +143,9 @@ import Hakyll.Core.Logger
-- version of 'runCompilerJob' also stores the result
--
runCompiler :: Compiler () CompileRule -- ^ Compiler to run
- -> Identifier -- ^ Target identifier
+ -> Identifier () -- ^ Target identifier
-> ResourceProvider -- ^ Resource provider
- -> [Identifier] -- ^ Universe
+ -> [Identifier ()] -- ^ Universe
-> Routes -- ^ Route
-> Store -- ^ Store
-> Bool -- ^ Was the resource modified?
@@ -162,7 +162,8 @@ runCompiler compiler id' provider universe routes store modified logger = do
-- before we return control. This makes sure the compiled item can later
-- be accessed by e.g. require.
Right (CompileRule (CompiledItem x)) ->
- storeSet store "Hakyll.Core.Compiler.runCompiler" id' x
+ storeSet store "Hakyll.Core.Compiler.runCompiler"
+ (castIdentifier id') x
-- Otherwise, we do nothing here
_ -> return ()
@@ -171,8 +172,9 @@ runCompiler compiler id' provider universe routes store modified logger = do
-- | Get the identifier of the item that is currently being compiled
--
-getIdentifier :: Compiler a Identifier
-getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask
+getIdentifier :: Compiler a (Identifier b)
+getIdentifier = fromJob $ const $ CompilerM $
+ castIdentifier . compilerIdentifier <$> ask
-- | Get the resource that is currently being compiled
--
@@ -186,7 +188,7 @@ getRoute = getIdentifier >>> getRouteFor
-- | Get the route for a specified item
--
-getRouteFor :: Compiler Identifier (Maybe FilePath)
+getRouteFor :: Compiler (Identifier a) (Maybe FilePath)
getRouteFor = fromJob $ \identifier -> CompilerM $ do
routes <- compilerRoutes <$> ask
return $ runRoutes routes identifier
@@ -218,7 +220,7 @@ getResourceWith reader = fromJob $ \resource -> CompilerM $ do
-- | Auxiliary: get a dependency
--
getDependency :: (Binary a, Writable a, Typeable a)
- => Identifier -> CompilerM a
+ => Identifier a -> CompilerM a
getDependency id' = CompilerM $ do
store <- compilerStore <$> ask
result <- liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" id'
@@ -239,7 +241,7 @@ getDependency id' = CompilerM $ do
-- | Variant of 'require' which drops the current value
--
require_ :: (Binary a, Typeable a, Writable a)
- => Identifier
+ => Identifier a
-> Compiler b a
require_ identifier =
fromDependency identifier >>> fromJob (const $ getDependency identifier)
@@ -248,7 +250,7 @@ require_ identifier =
-- dependencies
--
require :: (Binary a, Typeable a, Writable a)
- => Identifier
+ => Identifier a
-> (b -> a -> c)
-> Compiler b c
require identifier = requireA identifier . arr . uncurry
@@ -256,7 +258,7 @@ require identifier = requireA identifier . arr . uncurry
-- | Arrow-based variant of 'require'
--
requireA :: (Binary a, Typeable a, Writable a)
- => Identifier
+ => Identifier a
-> Compiler (b, a) c
-> Compiler b c
requireA identifier = (id &&& require_ identifier >>>)
@@ -264,11 +266,11 @@ requireA identifier = (id &&& require_ identifier >>>)
-- | Variant of 'requireAll' which drops the current value
--
requireAll_ :: (Binary a, Typeable a, Writable a)
- => Pattern
+ => Pattern a
-> Compiler b [a]
requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'
where
- getDeps = filterMatches pattern
+ getDeps = map castIdentifier . filterMatches pattern . map castIdentifier
requireAll_' = const $ CompilerM $ do
deps <- getDeps . compilerUniverse <$> ask
mapM (unCompilerM . getDependency) deps
@@ -277,7 +279,7 @@ requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'
-- of dependencies
--
requireAll :: (Binary a, Typeable a, Writable a)
- => Pattern
+ => Pattern a
-> (b -> [a] -> c)
-> Compiler b c
requireAll pattern = requireAllA pattern . arr . uncurry
@@ -285,7 +287,7 @@ requireAll pattern = requireAllA pattern . arr . uncurry
-- | Arrow-based variant of 'requireAll'
--
requireAllA :: (Binary a, Typeable a, Writable a)
- => Pattern
+ => Pattern a
-> Compiler (b, [a]) c
-> Compiler b c
requireAllA pattern = (id &&& requireAll_ pattern >>>)
@@ -296,7 +298,7 @@ cached :: (Binary a, Typeable a, Writable a)
-> Compiler Resource a
cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
logger <- compilerLogger <$> ask
- identifier <- compilerIdentifier <$> ask
+ identifier <- castIdentifier . compilerIdentifier <$> ask
store <- compilerStore <$> ask
modified <- compilerResourceModified <$> ask
report logger $ "Checking cache: " ++ if modified then "modified" else "OK"
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 594c23e..8ed822d 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -33,26 +33,26 @@ import Hakyll.Core.Logger
-- | A set of dependencies
--
-type Dependencies = Set Identifier
+type Dependencies = Set (Identifier ())
-- | Environment in which the dependency analyzer runs
--
data DependencyEnvironment = DependencyEnvironment
{ -- | Target identifier
- dependencyIdentifier :: Identifier
+ dependencyIdentifier :: Identifier ()
, -- | List of available identifiers we can depend upon
- dependencyUniverse :: [Identifier]
+ dependencyUniverse :: [Identifier ()]
}
-- | Environment in which a compiler runs
--
data CompilerEnvironment = CompilerEnvironment
{ -- | Target identifier
- compilerIdentifier :: Identifier
+ compilerIdentifier :: Identifier ()
, -- | Resource provider
compilerResourceProvider :: ResourceProvider
, -- | List of all known identifiers
- compilerUniverse :: [Identifier]
+ compilerUniverse :: [Identifier ()]
, -- | Site routes
compilerRoutes :: Routes
, -- | Compiler store
@@ -107,9 +107,9 @@ instance ArrowChoice Compiler where
-- | Run a compiler, yielding the resulting target
--
runCompilerJob :: Compiler () a -- ^ Compiler to run
- -> Identifier -- ^ Target identifier
+ -> Identifier () -- ^ Target identifier
-> ResourceProvider -- ^ Resource provider
- -> [Identifier] -- ^ Universe
+ -> [Identifier ()] -- ^ Universe
-> Routes -- ^ Route
-> Store -- ^ Store
-> Bool -- ^ Was the resource modified?
@@ -129,8 +129,8 @@ runCompilerJob compiler id' provider universe route store modified logger =
}
runCompilerDependencies :: Compiler () a
- -> Identifier
- -> [Identifier]
+ -> Identifier ()
+ -> [Identifier ()]
-> Dependencies
runCompilerDependencies compiler identifier universe =
runReader (compilerDependencies compiler) env
@@ -144,7 +144,7 @@ fromJob :: (a -> CompilerM b)
-> Compiler a b
fromJob = Compiler (return S.empty)
-fromDependencies :: (Identifier -> [Identifier] -> [Identifier])
+fromDependencies :: (Identifier () -> [Identifier ()] -> [Identifier ()])
-> Compiler b b
fromDependencies collectDeps = flip Compiler return $ do
DependencyEnvironment identifier universe <- ask
@@ -152,5 +152,5 @@ fromDependencies collectDeps = flip Compiler return $ do
-- | Wait until another compiler has finished before running this compiler
--
-fromDependency :: Identifier -> Compiler a a
-fromDependency = fromDependencies . const . const . return
+fromDependency :: Identifier a -> Compiler b b
+fromDependency = fromDependencies . const . const . return . castIdentifier
diff --git a/src/Hakyll/Core/Identifier.hs b/src/Hakyll/Core/Identifier.hs
index c2455fc..3b67381 100644
--- a/src/Hakyll/Core/Identifier.hs
+++ b/src/Hakyll/Core/Identifier.hs
@@ -20,9 +20,19 @@
-- @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 GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
module Hakyll.Core.Identifier
( Identifier (..)
+ , castIdentifier
, parseIdentifier
, toFilePath
, setGroup
@@ -40,30 +50,36 @@ import Data.Typeable (Typeable)
-- | An identifier used to uniquely identify a value
--
-data Identifier = Identifier
+data Identifier a = Identifier
{ identifierGroup :: Maybe String
, identifierPath :: String
} deriving (Eq, Ord, Typeable)
-instance Monoid Identifier where
+instance Monoid (Identifier a) where
mempty = Identifier Nothing ""
Identifier g1 p1 `mappend` Identifier g2 p2 =
Identifier (g1 `mplus` g2) (p1 `mappend` p2)
-instance Binary Identifier where
+instance Binary (Identifier a) where
put (Identifier g p) = put g >> put p
get = Identifier <$> get <*> get
-instance Show Identifier where
+instance Show (Identifier a) where
show i@(Identifier Nothing _) = toFilePath i
show i@(Identifier (Just g) _) = toFilePath i ++ " (" ++ g ++ ")"
-instance IsString Identifier where
+instance IsString (Identifier a) where
fromString = parseIdentifier
+-- | Discard the phantom type parameter of an identifier
+--
+castIdentifier :: Identifier a -> Identifier b
+castIdentifier (Identifier g p) = Identifier g p
+{-# INLINE castIdentifier #-}
+
-- | Parse an identifier from a string
--
-parseIdentifier :: String -> Identifier
+parseIdentifier :: String -> Identifier a
parseIdentifier = Identifier Nothing
. intercalate "/" . filter (not . null) . split'
where
@@ -73,10 +89,10 @@ parseIdentifier = Identifier Nothing
-- | Convert an identifier to a relative 'FilePath'
--
-toFilePath :: Identifier -> FilePath
+toFilePath :: Identifier a -> FilePath
toFilePath = identifierPath
-- | Set the identifier group for some identifier
--
-setGroup :: Maybe String -> Identifier -> Identifier
+setGroup :: Maybe String -> Identifier a -> Identifier a
setGroup g (Identifier _ p) = Identifier g p
diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs
index cee4bbc..8263f29 100644
--- a/src/Hakyll/Core/Identifier/Pattern.hs
+++ b/src/Hakyll/Core/Identifier/Pattern.hs
@@ -31,10 +31,16 @@
-- The 'capture' function allows the user to get access to the elements captured
-- by the capture elements in the pattern.
--
+-- Like an 'Identifier', a 'Pattern' also has a type parameter. This is simply
+-- an extra layer of safety, and can be discarded using the 'castPattern'
+-- function.
+--
module Hakyll.Core.Identifier.Pattern
( Pattern
+ , castPattern
, parseGlob
, predicate
+ , list
, regex
, inGroup
, matches
@@ -64,21 +70,28 @@ data GlobComponent = Capture
-- | Type that allows matching on identifiers
--
-data Pattern = Glob [GlobComponent]
- | Predicate (Identifier -> Bool)
+data Pattern a = Glob [GlobComponent]
+ | Predicate (Identifier a -> Bool)
+ | List [Identifier a]
-instance IsString Pattern where
+instance IsString (Pattern a) where
fromString = parseGlob
-instance Monoid Pattern where
+instance Monoid (Pattern a) where
mempty = Predicate (const True)
- g@(Glob _) `mappend` x = Predicate (matches g) `mappend` x
- x `mappend` g@(Glob _) = x `mappend` Predicate (matches g)
- Predicate f `mappend` Predicate g = Predicate $ \i -> f i && g i
+ p1 `mappend` p2 = Predicate $ \i -> matches p1 i && matches p2 i
+
+-- | Discard the phantom type parameter
+--
+castPattern :: Pattern a -> Pattern b
+castPattern (Glob g) = Glob g
+castPattern (Predicate p) = Predicate $ p . castIdentifier
+castPattern (List l) = List $ map castIdentifier l
+{-# INLINE castPattern #-}
-- | Parse a pattern from a string
--
-parseGlob :: String -> Pattern
+parseGlob :: String -> Pattern a
parseGlob = Glob . parse'
where
parse' str =
@@ -95,33 +108,39 @@ parseGlob = Glob . parse'
--
-- > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i))
--
-predicate :: (Identifier -> Bool) -> Pattern
+predicate :: (Identifier a -> Bool) -> Pattern a
predicate = Predicate
+-- | Create a 'Pattern' from a list of 'Identifier's it should match
+--
+list :: [Identifier a] -> Pattern a
+list = List
+
-- | Create a 'Pattern' from a regex
--
-- Example:
--
-- > regex "^foo/[^x]*$
--
-regex :: String -> Pattern
+regex :: String -> Pattern a
regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath
-- | Create a 'Pattern' which matches if the identifier is in a certain group
-- (or in no group)
--
-inGroup :: Maybe String -> Pattern
+inGroup :: Maybe String -> Pattern a
inGroup group = predicate $ (== group) . identifierGroup
-- | Check if an identifier matches a pattern
--
-matches :: Pattern -> Identifier -> Bool
+matches :: Pattern a -> Identifier a -> Bool
matches (Glob p) = isJust . capture (Glob p)
matches (Predicate p) = (p $)
+matches (List l) = (`elem` l)
-- | Given a list of identifiers, retain only those who match the given pattern
--
-filterMatches :: Pattern -> [Identifier] -> [Identifier]
+filterMatches :: Pattern a -> [Identifier a] -> [Identifier a]
filterMatches = filter . matches
-- | Split a list at every possible point, generate a list of (init, tail)
@@ -132,9 +151,9 @@ splits = inits &&& tails >>> uncurry zip >>> reverse
-- | Match a glob against a pattern, generating a list of captures
--
-capture :: Pattern -> Identifier -> Maybe [String]
+capture :: Pattern a -> Identifier a -> Maybe [String]
capture (Glob p) (Identifier _ i) = capture' p i
-capture (Predicate _) _ = Nothing
+capture _ _ = Nothing
-- | Internal verion of 'capture'
--
@@ -164,17 +183,17 @@ capture' (CaptureMany : ms) str =
--
-- > "tags/foo"
--
-fromCapture :: Pattern -> String -> Identifier
+fromCapture :: Pattern a -> String -> Identifier a
fromCapture pattern = fromCaptures pattern . repeat
-- | Create an identifier from a pattern by filling in the captures with the
-- given list of strings
--
-fromCaptures :: Pattern -> [String] -> Identifier
-fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p
-fromCaptures (Predicate _) = error $
- "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures called on a " ++
- "predicate instead of a glob"
+fromCaptures :: Pattern a -> [String] -> Identifier a
+fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p
+fromCaptures _ = error $
+ "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++
+ "on simple globs!"
-- | Internally used version of 'fromCaptures'
--
diff --git a/src/Hakyll/Core/Resource.hs b/src/Hakyll/Core/Resource.hs
index 8154752..ce5da81 100644
--- a/src/Hakyll/Core/Resource.hs
+++ b/src/Hakyll/Core/Resource.hs
@@ -15,10 +15,10 @@ newtype Resource = Resource {unResource :: String}
-- | Create a resource from an identifier
--
-fromIdentifier :: Identifier -> Resource
+fromIdentifier :: Identifier a -> Resource
fromIdentifier = Resource . toFilePath
-- | Map the resource to an identifier. Note that the group will not be set!
--
-toIdentifier :: Resource -> Identifier
+toIdentifier :: Resource -> Identifier a
toIdentifier = parseIdentifier . unResource
diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs
index abbd0a7..f351447 100644
--- a/src/Hakyll/Core/Routes.hs
+++ b/src/Hakyll/Core/Routes.hs
@@ -25,6 +25,7 @@
--
-- * If an item matches multiple routes, the first rule will be chosen.
--
+{-# LANGUAGE Rank2Types #-}
module Hakyll.Core.Routes
( Routes
, runRoutes
@@ -46,7 +47,7 @@ import Hakyll.Core.Util.String
-- | Type used for a route
--
-newtype Routes = Routes {unRoutes :: Identifier -> Maybe FilePath}
+newtype Routes = Routes {unRoutes :: forall a. Identifier a -> Maybe FilePath}
instance Monoid Routes where
mempty = Routes $ const Nothing
@@ -54,7 +55,7 @@ instance Monoid Routes where
-- | Apply a route to an identifier
--
-runRoutes :: Routes -> Identifier -> Maybe FilePath
+runRoutes :: Routes -> Identifier a -> Maybe FilePath
runRoutes = unRoutes
-- | A route that uses the identifier as filepath. For example, the target with
@@ -88,15 +89,15 @@ setExtension extension = Routes $ fmap (`replaceExtension` extension)
-- | Apply the route if the identifier matches the given pattern, fail
-- otherwise
--
-matchRoute :: Pattern -> Routes -> Routes
+matchRoute :: Pattern a -> Routes -> Routes
matchRoute pattern (Routes route) = Routes $ \id' ->
- if matches pattern id' then route id' else Nothing
+ if matches pattern (castIdentifier id') then route id' else Nothing
-- | Create a custom route. This should almost always be used with
-- 'matchRoute'
--
-customRoute :: (Identifier -> FilePath) -> Routes
-customRoute f = Routes $ Just . f
+customRoute :: (Identifier a -> FilePath) -> Routes
+customRoute f = Routes $ Just . f . castIdentifier
-- | Create a gsub route
--
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index fe2c59c..eb75a2e 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -31,7 +31,7 @@ module Hakyll.Core.Rules
import Control.Applicative ((<$>))
import Control.Monad.Writer (tell)
import Control.Monad.Reader (ask, local)
-import Control.Arrow (second, (>>>), arr, (>>^), (***))
+import Control.Arrow ((>>>), arr, (>>^), (***))
import Control.Monad.State (get, put)
import Data.Monoid (mempty, mappend)
import qualified Data.Set as S
@@ -58,13 +58,11 @@ tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty
-- | Add a number of compilers
--
tellCompilers :: (Binary a, Typeable a, Writable a)
- => [(Identifier, Compiler () a)]
+ => [(Identifier a, Compiler () a)]
-> Rules
tellCompilers compilers = RulesM $ do
- -- We box the compilers so they have a more simple type, and we apply the
- -- current group to the corresponding identifiers
- group' <- rulesGroup <$> ask
- let compilers' = map (setGroup group' *** boxCompiler) compilers
+ -- We box the compilers so they have a more simple type
+ let compilers' = map (castIdentifier *** boxCompiler) compilers
tell $ RuleSet mempty compilers' mempty
where
boxCompiler = (>>> arr compiledItem >>> arr CompileRule)
@@ -78,11 +76,11 @@ tellResources resources' = RulesM $ tell $
-- | Only compile/route items satisfying the given predicate
--
-match :: Pattern -> Rules -> Rules
+match :: Pattern a -> RulesM b -> RulesM b
match pattern = RulesM . local addPredicate . unRulesM
where
addPredicate env = env
- { rulesPattern = rulesPattern env `mappend` pattern
+ { rulesPattern = rulesPattern env `mappend` castPattern pattern
}
-- | Greate a group of compilers
@@ -116,7 +114,7 @@ match pattern = RulesM . local addPredicate . unRulesM
-- This will put the compiler for the raw content in a separate group
-- (@\"raw\"@), which causes it to be compiled as well.
--
-group :: String -> Rules -> Rules
+group :: String -> RulesM a -> RulesM a
group g = RulesM . local setGroup' . unRulesM
where
setGroup' env = env { rulesGroup = Just g }
@@ -128,12 +126,13 @@ group g = RulesM . local setGroup' . unRulesM
-- you might want to have a look at 'create'.
--
compile :: (Binary a, Typeable a, Writable a)
- => Compiler Resource a -> Rules
+ => Compiler Resource a -> RulesM (Pattern a)
compile compiler = do
ids <- resources
tellCompilers $ flip map ids $ \identifier ->
(identifier, constA (fromIdentifier identifier) >>> compiler)
tellResources $ map fromIdentifier ids
+ return $ list ids
-- | Add a compilation rule
--
@@ -143,8 +142,12 @@ compile compiler = do
-- actual content itself.
--
create :: (Binary a, Typeable a, Writable a)
- => Identifier -> Compiler () a -> Rules
-create identifier compiler = tellCompilers [(identifier, compiler)]
+ => Identifier a -> Compiler () a -> RulesM (Identifier a)
+create id' compiler = RulesM $ do
+ group' <- rulesGroup <$> ask
+ let id'' = setGroup group' id'
+ unRulesM $ tellCompilers [(id'', compiler)]
+ return id''
-- | Add a route.
--
@@ -158,13 +161,17 @@ route route' = RulesM $ do
group' <- rulesGroup <$> ask
unRulesM $ tellRoute $ matchRoute (pattern `mappend` inGroup group') route'
--- | Get a list of resources matching the current pattern
+-- | Get a list of resources matching the current pattern. This will also set
+-- the correct group to the identifiers.
--
-resources :: RulesM [Identifier]
+resources :: RulesM [Identifier a]
resources = RulesM $ do
pattern <- rulesPattern <$> ask
provider <- rulesResourceProvider <$> ask
- return $ filterMatches pattern $ map toIdentifier $ resourceList provider
+ group' <- rulesGroup <$> ask
+ return $ filterMatches pattern $ map (toId group') $ resourceList provider
+ where
+ toId g = setGroup g . toIdentifier
-- | Apart from regular compilers, one is also able to specify metacompilers.
-- Metacompilers are a special class of compilers: they are compilers which
@@ -197,7 +204,7 @@ resources = RulesM $ do
-- which items must be rendered.
--
metaCompile :: (Binary a, Typeable a, Writable a)
- => Compiler () [(Identifier, Compiler () a)]
+ => Compiler () [(Identifier a, Compiler () a)]
-- ^ Compiler generating the other compilers
-> Rules
-- ^ Resulting rules
@@ -217,9 +224,9 @@ metaCompile compiler = RulesM $ do
-- the metacompiler.
--
metaCompileWith :: (Binary a, Typeable a, Writable a)
- => Identifier
+ => Identifier ()
-- ^ Identifier for this compiler
- -> Compiler () [(Identifier, Compiler () a)]
+ -> Compiler () [(Identifier a, Compiler () a)]
-- ^ Compiler generating the other compilers
-> Rules
-- ^ Resulting rules
@@ -229,7 +236,7 @@ metaCompileWith identifier compiler = RulesM $ do
let -- Set the correct group on the identifier
id' = setGroup group' identifier
-- Function to box an item into a rule
- makeRule = MetaCompileRule . map (second box)
+ makeRule = MetaCompileRule . map (castIdentifier *** box)
-- Entire boxing function
box = (>>> fromDependency id' >>^ CompileRule . compiledItem)
-- Resulting compiler list
diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs
index 83783b5..5a1ab8e 100644
--- a/src/Hakyll/Core/Rules/Internal.hs
+++ b/src/Hakyll/Core/Rules/Internal.hs
@@ -1,6 +1,6 @@
-- | Internal rules module for types which are not exposed to the user
--
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-}
module Hakyll.Core.Rules.Internal
( CompileRule (..)
, RuleSet (..)
@@ -35,7 +35,7 @@ import Hakyll.Core.CompiledItem
-- added to the runtime if possible, since other items might depend upon them.
--
data CompileRule = CompileRule CompiledItem
- | MetaCompileRule [(Identifier, Compiler () CompileRule)]
+ | MetaCompileRule [(Identifier (), Compiler () CompileRule)]
-- | A collection of rules for the compilation process
--
@@ -43,7 +43,7 @@ data RuleSet = RuleSet
{ -- | Routes used in the compilation structure
rulesRoutes :: Routes
, -- | Compilation rules
- rulesCompilers :: [(Identifier, Compiler () CompileRule)]
+ rulesCompilers :: [(Identifier (), Compiler () CompileRule)]
, -- | A list of the used resources
rulesResources :: Set Resource
}
@@ -63,7 +63,7 @@ data RuleState = RuleState
--
data RuleEnvironment = RuleEnvironment
{ rulesResourceProvider :: ResourceProvider
- , rulesPattern :: Pattern
+ , rulesPattern :: forall a. Pattern a
, rulesGroup :: Maybe String
}
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index 5e29953..9b27cf3 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -89,8 +89,8 @@ data RuntimeEnvironment = RuntimeEnvironment
}
data RuntimeState = RuntimeState
- { hakyllAnalyzer :: DependencyAnalyzer Identifier
- , hakyllCompilers :: Map Identifier (Compiler () CompileRule)
+ { hakyllAnalyzer :: DependencyAnalyzer (Identifier ())
+ , hakyllCompilers :: Map (Identifier ()) (Compiler () CompileRule)
}
newtype Runtime a = Runtime
@@ -99,7 +99,7 @@ newtype Runtime a = Runtime
-- | Add a number of compilers and continue using these compilers
--
-addNewCompilers :: [(Identifier, Compiler () CompileRule)]
+addNewCompilers :: [(Identifier (), Compiler () CompileRule)]
-- ^ Compilers to add
-> Runtime ()
addNewCompilers newCompilers = Runtime $ do
@@ -157,14 +157,14 @@ stepAnalyzer = Runtime $ do
-- | Dump cyclic error and quit
--
-dumpCycle :: [Identifier] -> Runtime ()
+dumpCycle :: [Identifier ()] -> Runtime ()
dumpCycle cycle' = Runtime $ do
logger <- hakyllLogger <$> ask
section logger "Dependency cycle detected! Conflict:"
forM_ (zip cycle' $ drop 1 cycle') $ \(x, y) ->
report logger $ show x ++ " -> " ++ show y
-build :: Identifier -> Runtime ()
+build :: Identifier () -> Runtime ()
build id' = Runtime $ do
logger <- hakyllLogger <$> ask
routes <- hakyllRoutes <$> ask
diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs
index 20e85d7..3000910 100644
--- a/src/Hakyll/Core/Store.hs
+++ b/src/Hakyll/Core/Store.hs
@@ -60,7 +60,7 @@ addToMap store path value =
-- | Create a path
--
-makePath :: Store -> String -> Identifier -> FilePath
+makePath :: Store -> String -> Identifier a -> FilePath
makePath store name identifier = storeDirectory store </> name
</> group </> toFilePath identifier </> "hakyllstore"
where
@@ -69,7 +69,7 @@ makePath store name identifier = storeDirectory store </> name
-- | Store an item
--
storeSet :: (Binary a, Typeable a)
- => Store -> String -> Identifier -> a -> IO ()
+ => Store -> String -> Identifier a -> a -> IO ()
storeSet store name identifier value = do
makeDirectories path
encodeFile path value
@@ -80,7 +80,7 @@ storeSet store name identifier value = do
-- | Load an item
--
storeGet :: forall a. (Binary a, Typeable a)
- => Store -> String -> Identifier -> IO (StoreGet a)
+ => Store -> String -> Identifier a -> IO (StoreGet a)
storeGet store name identifier = do
-- First check the in-memory map
map' <- readMVar $ storeMap store
diff --git a/src/Hakyll/Core/Writable.hs b/src/Hakyll/Core/Writable.hs
index b7a4116..d001f00 100644
--- a/src/Hakyll/Core/Writable.hs
+++ b/src/Hakyll/Core/Writable.hs
@@ -38,5 +38,5 @@ instance Writable [Word8] where
instance Writable Html where
write p html = write p $ renderHtml html
-instance Writable Identifier where
- write p i = write p $ show i
+instance Writable (Identifier a) where
+ write p = write p . show
diff --git a/src/Hakyll/Web/Pandoc.hs b/src/Hakyll/Web/Pandoc.hs
index d107702..a1bd09c 100644
--- a/src/Hakyll/Web/Pandoc.hs
+++ b/src/Hakyll/Web/Pandoc.hs
@@ -33,19 +33,19 @@ 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 :: FileType -- ^ Determines how parsing happens
+ -> Maybe (Identifier a) -- ^ 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 parsing method
- -> Maybe Identifier -- ^ Optional, for better error messages
- -> String -- ^ String to read
- -> Pandoc -- ^ Resulting document
+readPandocWith :: ParserState -- ^ Parser options
+ -> FileType -- ^ Determines parsing method
+ -> Maybe (Identifier a) -- ^ 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
diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs
index 32076a0..d05256e 100644
--- a/src/Hakyll/Web/Tags.hs
+++ b/src/Hakyll/Web/Tags.hs
@@ -111,7 +111,7 @@ readCategory = readTagsWith getCategory
-- | Render tags in HTML
--
-renderTags :: (String -> Identifier)
+renderTags :: (String -> Identifier a)
-- ^ Produce a link
-> (String -> String -> Int -> Int -> Int -> String)
-- ^ Produce a tag item: tag, url, count, min count, max count
@@ -141,7 +141,7 @@ renderTags makeUrl makeItem concatItems = proc (Tags tags) -> do
-- | Render a tag cloud in HTML
--
-renderTagCloud :: (String -> Identifier) -- ^ Produce a link for a tag
+renderTagCloud :: (String -> Identifier a) -- ^ Produce a link for a tag
-> Double -- ^ Smallest font size, in percent
-> Double -- ^ Biggest font size, in percent
-> Compiler (Tags a) String -- ^ Tag cloud renderer
@@ -162,7 +162,7 @@ renderTagCloud makeUrl minSize maxSize =
-- | Render a simple tag list in HTML, with the tag count next to the item
--
-renderTagList :: (String -> Identifier) -> Compiler (Tags a) (String)
+renderTagList :: (String -> Identifier a) -> Compiler (Tags a) (String)
renderTagList makeUrl = renderTags makeUrl makeLink (intercalate ", ")
where
makeLink tag url count _ _ = renderHtml $
@@ -172,7 +172,7 @@ renderTagList makeUrl = renderTags makeUrl makeLink (intercalate ", ")
--
renderTagsFieldWith :: (Page a -> [String]) -- ^ Function to get the tags
-> String -- ^ Destination key
- -> (String -> Identifier) -- ^ Create a link for a tag
+ -> (String -> Identifier a) -- ^ Create a link for a tag
-> Compiler (Page a) (Page a) -- ^ Resulting compiler
renderTagsFieldWith tags destination makeUrl =
id &&& arr tags >>> setFieldA destination renderTags'
@@ -192,13 +192,13 @@ renderTagsFieldWith tags destination makeUrl =
-- | Render tags with links
--
renderTagsField :: String -- ^ Destination key
- -> (String -> Identifier) -- ^ Create a link for a tag
+ -> (String -> Identifier a) -- ^ Create a link for a tag
-> Compiler (Page a) (Page a) -- ^ Resulting compiler
renderTagsField = renderTagsFieldWith getTags
-- | Render the category in a link
--
renderCategoryField :: String -- ^ Destination key
- -> (String -> Identifier) -- ^ Create a category link
+ -> (String -> Identifier a) -- ^ Create a category link
-> Compiler (Page a) (Page a) -- ^ Resulting compiler
renderCategoryField = renderTagsFieldWith getCategory
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index 33e7a9b..222ab23 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -104,6 +104,6 @@ templateCompilerWith settings =
-- Hakyll template
else readTemplate string
-applyTemplateCompiler :: Identifier -- ^ Template
+applyTemplateCompiler :: Identifier Template -- ^ Template
-> Compiler (Page String) (Page String) -- ^ Compiler
applyTemplateCompiler identifier = require identifier (flip applyTemplate)
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-30 11:05:31 +0000