c31f22c · hakyll · git.iko.soy

git.iko.soy/hakyll

Add possibility to change URL through Arrows.

commitc31f22c79adbd1bce7876aa9eb9cfcbb9f226623 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateSat 22 May 2010, 11:07 (16 years ago) parentf88a5ec

6 files changed+33−18

compare with master

unifiedsplit

src/Text/Hakyll/ContextManipulations.hs+11−1 src/Text/Hakyll/CreateContext.hs+5−5 src/Text/Hakyll/HakyllAction.hs+12−7 src/Text/Hakyll/Paginate.hs+2−2 src/Text/Hakyll/Render.hs+2−2 src/Text/Hakyll/Tags.hs+1−1

src/Text/Hakyll/ContextManipulations.hs+11−1

@@ -3,12 +3,14 @@

33module Text.Hakyll.ContextManipulations

44 ( renderValue

55 , changeValue

6+ , changeUrl

67 , copyValue

78 , renderDate

89 , changeExtension

910 , renderBody

1011 ) where

1112

13+import Control.Monad (liftM)

1214import Control.Arrow (arr)

1315import System.Locale (defaultTimeLocale)

1416import System.FilePath (takeFileName, addExtension, dropExtension)

@@ -18,7 +20,7 @@ import Data.Maybe (fromMaybe)

1820import qualified Data.Map as M

1921

2022import Text.Hakyll.Regex (substituteRegex)

21−import Text.Hakyll.HakyllAction (HakyllAction)

23+import Text.Hakyll.HakyllAction (HakyllAction (..))

2224import Text.Hakyll.Context (Context)

2325

2426-- | Do something with a value in a @Context@, but keep the old value as well.

@@ -43,6 +45,14 @@ changeValue :: String -- ^ Key to change.

4345 -> HakyllAction Context Context

4446changeValue key = renderValue key key

4547

48+-- | Change the URL of a page. This requires a special function, so dependency

49+-- handling can happen correctly.

50+--

51+changeUrl :: (String -> String) -- ^ Function to change URL with.

52+ -> HakyllAction Context Context -- ^ Resulting action.

53+changeUrl f = let action = changeValue "url" f

54+ in action {actionUrl = Right $ liftM f}

55+

4656-- | Copy a value from one key to another in a @Context@.

4757copyValue :: String -- ^ Source key.

4858 -> String -- ^ Destination key.

src/Text/Hakyll/CreateContext.hs+5−5

@@ -11,7 +11,7 @@ module Text.Hakyll.CreateContext

1111

1212import qualified Data.Map as M

1313import Control.Arrow (second)

14−import Control.Monad (liftM2, mplus)

14+import Control.Monad (liftM2)

1515import Control.Applicative ((<$>))

1616

1717import Text.Hakyll.File

@@ -25,7 +25,7 @@ import Text.Hakyll.Internal.Page

2525createPage :: FilePath -> HakyllAction () Context

2626createPage path = HakyllAction

2727 { actionDependencies = [path]

28− , actionUrl = Just $ toUrl path

28+ , actionUrl = Left $ toUrl path

2929 , actionFunction = const (readPage path)

3030 }

3131

@@ -41,7 +41,7 @@ createCustomPage :: FilePath

4141 -> HakyllAction () Context

4242createCustomPage url association = HakyllAction

4343 { actionDependencies = dataDependencies

44− , actionUrl = Just $ return url

44+ , actionUrl = Left $ return url

4545 , actionFunction = \_ -> M.fromList <$> assoc'

4646 }

4747 where

@@ -78,7 +78,7 @@ combine :: HakyllAction () Context -> HakyllAction () Context

7878 -> HakyllAction () Context

7979combine x y = HakyllAction

8080 { actionDependencies = actionDependencies x ++ actionDependencies y

81− , actionUrl = actionUrl x `mplus` actionUrl y

81+ , actionUrl = actionUrl x

8282 , actionFunction = \_ ->

8383 liftM2 M.union (runHakyllAction x) (runHakyllAction y)

8484 }

@@ -90,7 +90,7 @@ combineWithUrl :: FilePath

9090 -> HakyllAction () Context

9191 -> HakyllAction () Context

9292combineWithUrl url x y = combine'

93− { actionUrl = Just $ return url

93+ { actionUrl = Left $ return url

9494 , actionFunction = \_ -> M.insert "url" url <$> runHakyllAction combine'

9595 }

9696 where

src/Text/Hakyll/HakyllAction.hs+12−7

@@ -11,7 +11,7 @@ module Text.Hakyll.HakyllAction

1111

1212import Control.Arrow

1313import Control.Category

14−import Control.Monad ((<=<), mplus, unless)

14+import Control.Monad ((<=<), unless)

1515import Control.Monad.Reader (liftIO)

1616import Prelude hiding ((.), id)

1717import System.IO (hPutStrLn, stderr)

@@ -24,7 +24,8 @@ data HakyllAction a b = HakyllAction

2424 { -- | Dependencies of the @HakyllAction@.

2525 actionDependencies :: [FilePath]

2626 , -- | URL pointing to the result of this @HakyllAction@.

27− actionUrl :: Maybe (Hakyll FilePath)

27+ actionUrl :: Either (Hakyll FilePath)

28+ (Hakyll FilePath -> Hakyll FilePath)

2829 , -- | The actual render function.

2930 actionFunction :: a -> Hakyll b

3031 }

@@ -45,7 +46,7 @@ createFileHakyllAction :: FilePath -- ^ File to operate on.

4546 -> HakyllAction () b -- ^ The resulting action.

4647createFileHakyllAction path action = HakyllAction

4748 { actionDependencies = [path]

48− , actionUrl = Just $ return path

49+ , actionUrl = Left $ return path

4950 , actionFunction = const action

5051 }

5152

@@ -60,8 +61,8 @@ runHakyllActionIfNeeded :: HakyllAction () () -- ^ Action to run.

6061 -> Hakyll () -- ^ Empty result.

6162runHakyllActionIfNeeded action = do

6263 url <- case actionUrl action of

63− (Just u) -> u

64− Nothing -> error "No url when checking dependencies."

64+ Left u -> u

65+ Right _ -> error "No url when checking dependencies."

6566 destination <- toDestination url

6667 valid <- isFileMoreRecent destination $ actionDependencies action

6768 unless valid $ do liftIO $ hPutStrLn stderr $ "Rendering " ++ destination

@@ -76,13 +77,17 @@ chain list = foldl1 (>>>) list

7677instance Category HakyllAction where

7778 id = HakyllAction

7879 { actionDependencies = []

79− , actionUrl = Nothing

80+ , actionUrl = Right id

8081 , actionFunction = return

8182 }

8283

8384 x . y = HakyllAction

8485 { actionDependencies = actionDependencies x ++ actionDependencies y

85− , actionUrl = actionUrl x `mplus` actionUrl y

86+ , actionUrl = case actionUrl x of

87+ Left ux -> Left ux

88+ Right fx -> case actionUrl y of

89+ Left uy -> Left (fx uy)

90+ Right fy -> Right (fx . fy)

8691 , actionFunction = actionFunction x <=< actionFunction y

8792 }

8893

src/Text/Hakyll/Paginate.hs+2−2

@@ -61,8 +61,8 @@ paginate configuration renderables = paginate' Nothing renderables (1 :: Int)

6161 where

6262 -- Create a link with a given label, taken from the configuration.

6363 linkWithLabel f r = Right $ case actionUrl r of

64− Just l -> createSimpleHakyllAction $ link (f configuration) <$> l

65− Nothing -> error "No link found for pagination."

64+ Left l -> createSimpleHakyllAction $ link (f configuration) <$> l

65+ Right _ -> error "No link found for pagination."

6666

6767 -- The main function that creates combined renderables by recursing over

6868 -- the list of items.

src/Text/Hakyll/Render.hs+2−2

@@ -40,7 +40,7 @@ render :: FilePath -- ^ Template to use for rendering.

4040 -> HakyllAction Context Context -- ^ The render computation.

4141render templatePath = HakyllAction

4242 { actionDependencies = [templatePath]

43− , actionUrl = Nothing

43+ , actionUrl = Right id

4444 , actionFunction = \context ->

4545 flip pureRender context <$> readTemplate templatePath

4646 }

@@ -59,7 +59,7 @@ renderAndConcat :: [FilePath]

5959 -> HakyllAction () String

6060renderAndConcat templatePaths renderables = HakyllAction

6161 { actionDependencies = renders >>= actionDependencies

62− , actionUrl = Nothing

62+ , actionUrl = Right id

6363 , actionFunction = actionFunction'

6464 }

6565 where

src/Text/Hakyll/Tags.hs+1−1

@@ -68,7 +68,7 @@ readMap :: (Context -> [String]) -- ^ Function to get tags from a context.

6868 -> HakyllAction () TagMap

6969readMap getTagsFunction identifier paths = HakyllAction

7070 { actionDependencies = paths

71− , actionUrl = Nothing

71+ , actionUrl = Right id

7272 , actionFunction = actionFunction'

7373 }

7474 where