summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Hakyll/Core/Compiler.hs13
-rw-r--r--src/Hakyll/Core/Compiler/Internal.hs13
-rw-r--r--src/Hakyll/Core/Run.hs5
-rw-r--r--src/Hakyll/Web/Page.hs31
-rw-r--r--src/Hakyll/Web/Page/Internal.hs31
-rw-r--r--src/Hakyll/Web/Page/Read.hs2
-rw-r--r--src/Hakyll/Web/Util/String.hs12
7 files changed, 76 insertions, 31 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index d0e219e..5678b0a 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -4,6 +4,7 @@
module Hakyll.Core.Compiler
( Compiler
, getIdentifier
+ , getRoute
, getResourceString
, require
, requireAll
@@ -26,10 +27,18 @@ import Hakyll.Core.Writable
import Hakyll.Core.ResourceProvider
import Hakyll.Core.Compiler.Internal
+-- | Get the identifier of the item that is currently being compiled
+--
getIdentifier :: Compiler a Identifier
-getIdentifier = fromJob $ const $ CompilerM $
- compilerIdentifier <$> ask
+getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask
+
+-- | Get the route we are using for this item
+--
+getRoute :: Compiler a (Maybe FilePath)
+getRoute = fromJob $ const $ CompilerM $ compilerRoute <$> ask
+-- | Get the resource we are compiling as a string
+--
getResourceString :: Compiler a String
getResourceString = getIdentifier >>> getResourceString'
where
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index fd37343..eee67ef 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -39,6 +39,7 @@ data CompilerEnvironment = CompilerEnvironment
{ compilerIdentifier :: Identifier -- ^ Target identifier
, compilerResourceProvider :: ResourceProvider -- ^ Resource provider
, compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup
+ , compilerRoute :: Maybe FilePath -- ^ Site route
}
-- | The compiler monad
@@ -67,18 +68,20 @@ instance Arrow Compiler where
-- | Run a compiler, yielding the resulting target and it's dependencies
--
-runCompilerJob :: Compiler () a
- -> Identifier
- -> ResourceProvider
- -> DependencyLookup
+runCompilerJob :: Compiler () a -- ^ Compiler to run
+ -> Identifier -- ^ Target identifier
+ -> ResourceProvider -- ^ Resource provider
+ -> DependencyLookup -- ^ Dependency lookup table
+ -> Maybe FilePath -- ^ Route
-> IO a
-runCompilerJob compiler identifier provider lookup' =
+runCompilerJob compiler identifier provider lookup' route =
runReaderT (unCompilerM $ compilerJob compiler ()) env
where
env = CompilerEnvironment
{ compilerIdentifier = identifier
, compilerResourceProvider = provider
, compilerDependencyLookup = lookup'
+ , compilerRoute = route
}
runCompilerDependencies :: Compiler () a
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index fa88458..ccb731c 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -66,10 +66,11 @@ hakyllWith rules provider store = do
putStrLn "DONE."
where
addTarget route' map' (id', comp) = do
- compiled <- runCompilerJob comp id' provider (dependencyLookup map')
+ let url = runRoute route' id'
+ compiled <- runCompilerJob comp id' provider (dependencyLookup map') url
putStrLn $ "Generated target: " ++ show id'
- case runRoute route' id' of
+ case url of
Nothing -> return ()
Just r -> do
putStrLn $ "Routing " ++ show id' ++ " to " ++ r
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index 78178cb..eea474c 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -6,35 +6,24 @@
module Hakyll.Web.Page
( Page (..)
, toMap
+ , pageRead
) where
-import Control.Applicative ((<$>), (<*>))
+import Control.Arrow ((>>^))
import Data.Map (Map)
import qualified Data.Map as M
-import Data.Binary (Binary, get, put)
-import Data.Typeable (Typeable)
-import Hakyll.Core.Writable
-
--- | Type used to represent pages
---
-data Page a = Page
- { pageMetadata :: Map String String
- , pageBody :: a
- } deriving (Show, Typeable)
-
-instance Functor Page where
- fmap f (Page m b) = Page m (f b)
-
-instance Binary a => Binary (Page a) where
- put (Page m b) = put m >> put b
- get = Page <$> get <*> get
-
-instance Writable a => Writable (Page a) where
- write p (Page _ b) = write p b
+import Hakyll.Core.Compiler
+import Hakyll.Web.Page.Internal
+import Hakyll.Web.Page.Read
-- | Convert a page to a map. The body will be placed in the @body@ key.
--
toMap :: Page String -> Map String String
toMap (Page m b) = M.insert "body" b m
+
+-- | Read a page (do not render it)
+--
+pageRead :: Compiler a (Page String)
+pageRead = getResourceString >>^ readPage
diff --git a/src/Hakyll/Web/Page/Internal.hs b/src/Hakyll/Web/Page/Internal.hs
new file mode 100644
index 0000000..bac4c51
--- /dev/null
+++ b/src/Hakyll/Web/Page/Internal.hs
@@ -0,0 +1,31 @@
+-- | Internal representation of the page datatype
+--
+{-# LANGUAGE DeriveDataTypeable #-}
+module Hakyll.Web.Page.Internal
+ ( Page (..)
+ ) where
+
+import Control.Applicative ((<$>), (<*>))
+
+import Data.Map (Map)
+import Data.Binary (Binary, get, put)
+import Data.Typeable (Typeable)
+
+import Hakyll.Core.Writable
+
+-- | Type used to represent pages
+--
+data Page a = Page
+ { pageMetadata :: Map String String
+ , pageBody :: a
+ } deriving (Show, Typeable)
+
+instance Functor Page where
+ fmap f (Page m b) = Page m (f b)
+
+instance Binary a => Binary (Page a) where
+ put (Page m b) = put m >> put b
+ get = Page <$> get <*> get
+
+instance Writable a => Writable (Page a) where
+ write p (Page _ b) = write p b
diff --git a/src/Hakyll/Web/Page/Read.hs b/src/Hakyll/Web/Page/Read.hs
index 82224a4..d72f32a 100644
--- a/src/Hakyll/Web/Page/Read.hs
+++ b/src/Hakyll/Web/Page/Read.hs
@@ -11,7 +11,7 @@ import Data.List (isPrefixOf)
import Data.Map (Map)
import qualified Data.Map as M
-import Hakyll.Web.Page
+import Hakyll.Web.Page.Internal
import Hakyll.Web.Util.String
-- | We're using a simple state monad as parser
diff --git a/src/Hakyll/Web/Util/String.hs b/src/Hakyll/Web/Util/String.hs
index 5a8c7c6..e48580b 100644
--- a/src/Hakyll/Web/Util/String.hs
+++ b/src/Hakyll/Web/Util/String.hs
@@ -2,13 +2,25 @@
--
module Hakyll.Web.Util.String
( trim
+ , toSiteRoot
) where
import Data.Char (isSpace)
+import System.FilePath (splitPath, takeDirectory, joinPath)
+
-- | Trim a string (drop spaces, tabs and newlines at both sides).
--
trim :: String -> String
trim = reverse . trim' . reverse . trim'
where
trim' = dropWhile isSpace
+
+-- | Get the relative url to the site root, for a given (absolute) url
+--
+toSiteRoot :: FilePath -> FilePath
+toSiteRoot = emptyException . joinPath . map parent . splitPath . takeDirectory
+ where
+ parent = const ".."
+ emptyException [] = "."
+ emptyException x = x
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-05 08:00:35 +0000