Work on migration to arrows. Compulation fails.

- Update readPage to produce a Hakyll Context.
- Update createPagePath to produce a Context Arrow.
- Move Page to internal modules.
This commit is contained in:
Jasper Van der Jeugt 2010-03-04 09:50:25 +01:00
parent 76ebcf97b4
commit 192c4a16ea
5 changed files with 19 additions and 30 deletions

View file

@ -47,11 +47,11 @@ library
Text.Hakyll.RenderAction
Text.Hakyll.Renderable
Text.Hakyll.Renderables
Text.Hakyll.Page
Text.Hakyll.Paginate
Text.Hakyll.Util
Text.Hakyll.Tags
Text.Hakyll.Internal.Cache
Text.Hakyll.Internal.CompressCss
Text.Hakyll.Internal.Page
Text.Hakyll.Internal.Render
Text.Hakyll.Internal.Template

View file

@ -1,5 +1,5 @@
-- | A module for dealing with @Page@s. This module is mostly internally used.
module Text.Hakyll.Page
module Text.Hakyll.Internal.Page
( Page
, fromContext
, getValue
@ -25,6 +25,7 @@ import Text.Hakyll.File
import Text.Hakyll.Util (trim)
import Text.Hakyll.Context (Context)
import Text.Hakyll.Renderable
import Text.Hakyll.RenderAction
import Text.Hakyll.Regex (substituteRegex, matchesRegex)
-- | A Page is basically key-value mapping. Certain keys have special
@ -125,7 +126,7 @@ readSection renderFunction isFirst ls
-- | Read a page from a file. Metadata is supported, and if the filename
-- has a @.markdown@ extension, it will be rendered using pandoc.
readPageFromFile :: FilePath -> Hakyll Page
readPageFromFile :: FilePath -> Hakyll Context
readPageFromFile path = do
let renderFunction = getRenderFunction $ takeExtension path
sectionFunctions = map (readSection renderFunction)
@ -133,23 +134,18 @@ readPageFromFile path = do
-- Read file.
contents <- liftIO $ readFile path
url <- toUrl path
let sections = splitAtDelimiters $ lines contents
context = concat $ zipWith ($) sectionFunctions sections
page = fromContext $ M.fromList $
category ++
[ ("url", url)
, ("path", path)
] ++ context
sectionsData = concat $ zipWith ($) sectionFunctions sections
context = M.fromList $ category ++ sectionsData
return page
return context
where
category = let dirs = splitDirectories $ takeDirectory path
in [("category", last dirs) | not (null dirs)]
-- | Read a page. Might fetch it from the cache if available. Otherwise, it will
-- read it from the file given and store it in the cache.
readPage :: FilePath -> Hakyll Page
readPage :: FilePath -> Hakyll Context
readPage path = do
isCacheMoreRecent' <- isCacheMoreRecent fileName [path]
if isCacheMoreRecent' then getFromCache fileName

View file

@ -16,9 +16,9 @@ import Data.Maybe (fromMaybe)
import Text.Hakyll.Context (Context, ContextManipulation)
import Text.Hakyll.Renderable
import Text.Hakyll.Page
import Text.Hakyll.File
import Text.Hakyll.Hakyll
import Text.Hakyll.Internal.Page
import Text.Hakyll.Internal.Template
-- | A pure render function.

View file

@ -18,12 +18,12 @@ import System.Directory (copyFile)
import Text.Hakyll.Hakyll (Hakyll)
import Text.Hakyll.Context (ContextManipulation)
import Text.Hakyll.Page
import Text.Hakyll.Renderable
import Text.Hakyll.File
import Text.Hakyll.Internal.Template (readTemplate)
import Text.Hakyll.Internal.CompressCss
import Text.Hakyll.Internal.Page
import Text.Hakyll.Internal.Render
import Text.Hakyll.Internal.Template (readTemplate)
-- | Execute an IO action only when the cache is invalid.
depends :: FilePath -- ^ File to be rendered or created.

View file

@ -11,18 +11,18 @@ module Text.Hakyll.Renderables
import qualified Data.Map as M
import Control.Arrow (second)
import Control.Monad (liftM, liftM2, mplus)
import Control.Monad (liftM2, mplus)
import Control.Applicative ((<$>))
import Data.Binary
import Text.Hakyll.Hakyll (Hakyll)
import Text.Hakyll.Page
import Text.Hakyll.Renderable
import Text.Hakyll.File
import Text.Hakyll.Context
import Text.Hakyll.Render
import Text.Hakyll.RenderAction
import Text.Hakyll.Internal.Page
-- | Create a custom page.
--
@ -90,19 +90,12 @@ newtype PagePath = PagePath FilePath
deriving (Ord, Eq, Read, Show)
-- | Create a PagePath from a FilePath.
createPagePath :: FilePath -> PagePath
createPagePath = PagePath
-- We can render filepaths
instance Renderable PagePath where
getDependencies (PagePath path) = return path
getUrl (PagePath path) = toUrl path
toContext (PagePath path) = readPage path >>= toContext
-- We can serialize filepaths
instance Binary PagePath where
put (PagePath path) = put path
get = liftM PagePath get
createPagePath :: FilePath -> RenderAction () Context
createPagePath path = RenderAction
{ actionDependencies = [path]
, actionDestination = Just $ toUrl path
, actionFunction = const (readPage path)
}
-- | A combination of two other renderables.
data CombinedRenderable a b = CombinedRenderable a b