summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Hakyll/ContextManipulations.hs12
-rw-r--r--src/Text/Hakyll/CreateContext.hs10
-rw-r--r--src/Text/Hakyll/HakyllAction.hs19
-rw-r--r--src/Text/Hakyll/Paginate.hs4
-rw-r--r--src/Text/Hakyll/Render.hs4
-rw-r--r--src/Text/Hakyll/Tags.hs2
6 files changed, 33 insertions, 18 deletions
diff --git a/src/Text/Hakyll/ContextManipulations.hs b/src/Text/Hakyll/ContextManipulations.hs
index 9409721..ff4d661 100644
--- a/src/Text/Hakyll/ContextManipulations.hs
+++ b/src/Text/Hakyll/ContextManipulations.hs
@@ -3,12 +3,14 @@
module Text.Hakyll.ContextManipulations
( renderValue
, changeValue
+ , changeUrl
, copyValue
, renderDate
, changeExtension
, renderBody
) where
+import Control.Monad (liftM)
import Control.Arrow (arr)
import System.Locale (defaultTimeLocale)
import System.FilePath (takeFileName, addExtension, dropExtension)
@@ -18,7 +20,7 @@ import Data.Maybe (fromMaybe)
import qualified Data.Map as M
import Text.Hakyll.Regex (substituteRegex)
-import Text.Hakyll.HakyllAction (HakyllAction)
+import Text.Hakyll.HakyllAction (HakyllAction (..))
import Text.Hakyll.Context (Context)
-- | Do something with a value in a @Context@, but keep the old value as well.
@@ -43,6 +45,14 @@ changeValue :: String -- ^ Key to change.
-> HakyllAction Context Context
changeValue key = renderValue key key
+-- | Change the URL of a page. This requires a special function, so dependency
+-- handling can happen correctly.
+--
+changeUrl :: (String -> String) -- ^ Function to change URL with.
+ -> HakyllAction Context Context -- ^ Resulting action.
+changeUrl f = let action = changeValue "url" f
+ in action {actionUrl = Right $ liftM f}
+
-- | Copy a value from one key to another in a @Context@.
copyValue :: String -- ^ Source key.
-> String -- ^ Destination key.
diff --git a/src/Text/Hakyll/CreateContext.hs b/src/Text/Hakyll/CreateContext.hs
index a23f213..1bfd00c 100644
--- a/src/Text/Hakyll/CreateContext.hs
+++ b/src/Text/Hakyll/CreateContext.hs
@@ -11,7 +11,7 @@ module Text.Hakyll.CreateContext
import qualified Data.Map as M
import Control.Arrow (second)
-import Control.Monad (liftM2, mplus)
+import Control.Monad (liftM2)
import Control.Applicative ((<$>))
import Text.Hakyll.File
@@ -25,7 +25,7 @@ import Text.Hakyll.Internal.Page
createPage :: FilePath -> HakyllAction () Context
createPage path = HakyllAction
{ actionDependencies = [path]
- , actionUrl = Just $ toUrl path
+ , actionUrl = Left $ toUrl path
, actionFunction = const (readPage path)
}
@@ -41,7 +41,7 @@ createCustomPage :: FilePath
-> HakyllAction () Context
createCustomPage url association = HakyllAction
{ actionDependencies = dataDependencies
- , actionUrl = Just $ return url
+ , actionUrl = Left $ return url
, actionFunction = \_ -> M.fromList <$> assoc'
}
where
@@ -78,7 +78,7 @@ combine :: HakyllAction () Context -> HakyllAction () Context
-> HakyllAction () Context
combine x y = HakyllAction
{ actionDependencies = actionDependencies x ++ actionDependencies y
- , actionUrl = actionUrl x `mplus` actionUrl y
+ , actionUrl = actionUrl x
, actionFunction = \_ ->
liftM2 M.union (runHakyllAction x) (runHakyllAction y)
}
@@ -90,7 +90,7 @@ combineWithUrl :: FilePath
-> HakyllAction () Context
-> HakyllAction () Context
combineWithUrl url x y = combine'
- { actionUrl = Just $ return url
+ { actionUrl = Left $ return url
, actionFunction = \_ -> M.insert "url" url <$> runHakyllAction combine'
}
where
diff --git a/src/Text/Hakyll/HakyllAction.hs b/src/Text/Hakyll/HakyllAction.hs
index 1310e28..be4df2d 100644
--- a/src/Text/Hakyll/HakyllAction.hs
+++ b/src/Text/Hakyll/HakyllAction.hs
@@ -11,7 +11,7 @@ module Text.Hakyll.HakyllAction
import Control.Arrow
import Control.Category
-import Control.Monad ((<=<), mplus, unless)
+import Control.Monad ((<=<), unless)
import Control.Monad.Reader (liftIO)
import Prelude hiding ((.), id)
import System.IO (hPutStrLn, stderr)
@@ -24,7 +24,8 @@ data HakyllAction a b = HakyllAction
{ -- | Dependencies of the @HakyllAction@.
actionDependencies :: [FilePath]
, -- | URL pointing to the result of this @HakyllAction@.
- actionUrl :: Maybe (Hakyll FilePath)
+ actionUrl :: Either (Hakyll FilePath)
+ (Hakyll FilePath -> Hakyll FilePath)
, -- | The actual render function.
actionFunction :: a -> Hakyll b
}
@@ -45,7 +46,7 @@ createFileHakyllAction :: FilePath -- ^ File to operate on.
-> HakyllAction () b -- ^ The resulting action.
createFileHakyllAction path action = HakyllAction
{ actionDependencies = [path]
- , actionUrl = Just $ return path
+ , actionUrl = Left $ return path
, actionFunction = const action
}
@@ -60,8 +61,8 @@ runHakyllActionIfNeeded :: HakyllAction () () -- ^ Action to run.
-> Hakyll () -- ^ Empty result.
runHakyllActionIfNeeded action = do
url <- case actionUrl action of
- (Just u) -> u
- Nothing -> error "No url when checking dependencies."
+ Left u -> u
+ Right _ -> error "No url when checking dependencies."
destination <- toDestination url
valid <- isFileMoreRecent destination $ actionDependencies action
unless valid $ do liftIO $ hPutStrLn stderr $ "Rendering " ++ destination
@@ -76,13 +77,17 @@ chain list = foldl1 (>>>) list
instance Category HakyllAction where
id = HakyllAction
{ actionDependencies = []
- , actionUrl = Nothing
+ , actionUrl = Right id
, actionFunction = return
}
x . y = HakyllAction
{ actionDependencies = actionDependencies x ++ actionDependencies y
- , actionUrl = actionUrl x `mplus` actionUrl y
+ , actionUrl = case actionUrl x of
+ Left ux -> Left ux
+ Right fx -> case actionUrl y of
+ Left uy -> Left (fx uy)
+ Right fy -> Right (fx . fy)
, actionFunction = actionFunction x <=< actionFunction y
}
diff --git a/src/Text/Hakyll/Paginate.hs b/src/Text/Hakyll/Paginate.hs
index a1a64e4..1b6c015 100644
--- a/src/Text/Hakyll/Paginate.hs
+++ b/src/Text/Hakyll/Paginate.hs
@@ -61,8 +61,8 @@ paginate configuration renderables = paginate' Nothing renderables (1 :: Int)
where
-- Create a link with a given label, taken from the configuration.
linkWithLabel f r = Right $ case actionUrl r of
- Just l -> createSimpleHakyllAction $ link (f configuration) <$> l
- Nothing -> error "No link found for pagination."
+ Left l -> createSimpleHakyllAction $ link (f configuration) <$> l
+ Right _ -> error "No link found for pagination."
-- The main function that creates combined renderables by recursing over
-- the list of items.
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index d0bd138..a3476b6 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -40,7 +40,7 @@ render :: FilePath -- ^ Template to use for rendering.
-> HakyllAction Context Context -- ^ The render computation.
render templatePath = HakyllAction
{ actionDependencies = [templatePath]
- , actionUrl = Nothing
+ , actionUrl = Right id
, actionFunction = \context ->
flip pureRender context <$> readTemplate templatePath
}
@@ -59,7 +59,7 @@ renderAndConcat :: [FilePath]
-> HakyllAction () String
renderAndConcat templatePaths renderables = HakyllAction
{ actionDependencies = renders >>= actionDependencies
- , actionUrl = Nothing
+ , actionUrl = Right id
, actionFunction = actionFunction'
}
where
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index 382c49c..8b7d96b 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -68,7 +68,7 @@ readMap :: (Context -> [String]) -- ^ Function to get tags from a context.
-> HakyllAction () TagMap
readMap getTagsFunction identifier paths = HakyllAction
{ actionDependencies = paths
- , actionUrl = Nothing
+ , actionUrl = Right id
, actionFunction = actionFunction'
}
where
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-01 12:42:55 +0000