Add possibility to change URL through Arrows.
This commit is contained in:
parent
f88a5ec219
commit
c31f22c79a
6 changed files with 33 additions and 18 deletions
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue