summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Core/Compiler.hs408
-rw-r--r--src/Hakyll/Core/Compiler/Internal.hs33
-rw-r--r--src/Hakyll/Core/Compiler/Require.hs63
-rw-r--r--src/Hakyll/Core/Runtime.hs20
-rw-r--r--src/Hakyll/Core/UnixFilter.hs69
-rw-r--r--src/Hakyll/Core/Writable/CopyFile.hs21
-rw-r--r--src/Hakyll/Core/Writable/WritableTuple.hs37
-rw-r--r--src/Hakyll/Web/CompressCss.hs53
-rw-r--r--src/Hakyll/Web/Page.hs15
-rw-r--r--src/Hakyll/Web/Pandoc.hs51
-rw-r--r--src/Hakyll/Web/Pandoc/Biblio.hs59
-rw-r--r--src/Hakyll/Web/Pandoc/FileType.hs6
-rw-r--r--src/Hakyll/Web/Template/Context.hs14
-rw-r--r--src/Hakyll/Web/Urls/Relativize.hs14
14 files changed, 323 insertions, 540 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index ef9b03c..e59506f 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -1,97 +1,8 @@
--- | A Compiler manages targets and dependencies between targets
---
--- The most distinguishing property of a 'Compiler' is that it is an Arrow. A
--- compiler of the type @Compiler a b@ is simply a compilation phase which takes
--- an @a@ as input, and produces a @b@ as output.
---
--- Compilers are chained using the '>>>' arrow operation. If we have a compiler
---
--- > getResourceString :: Compiler Resource String
---
--- which reads the resource, and a compiler
---
--- > readPage :: Compiler String (Page String)
---
--- we can chain these two compilers to get a
---
--- > (getResourceString >>> readPage) :: Compiler Resource (Page String)
---
--- Most compilers can be created by combining smaller compilers using '>>>'.
---
--- More advanced constructions are also possible using arrow, and sometimes
--- these are needed. For a good introduction to arrow, you can refer to
---
--- <http://en.wikibooks.org/wiki/Haskell/Understanding_arrows>
---
--- A construction worth writing a few paragraphs about here are the 'require'
--- functions. Different variants of this function are exported here, but they
--- all serve more or less the same goal.
---
--- When you use only '>>>' to chain your compilers, you get a linear pipeline --
--- it is not possible to add extra items from other compilers along the way.
--- This is where the 'require' functions come in.
---
--- This function allows you to reference other items, which are then added to
--- the pipeline. Let's look at this crappy ASCII illustration which represents
--- a pretty common scenario:
---
--- > read resource >>> pandoc render >>> layout >>> relativize URL's
--- >
--- > @templates/fancy.html@
---
--- We want to construct a pipeline of compilers to go from our resource to a
--- proper webpage. However, the @layout@ compiler takes more than just the
--- rendered page as input: it needs the @templates/fancy.html@ template as well.
---
--- This is an example of where we need the @require@ function. We can solve
--- this using a construction that looks like:
---
--- > ... >>> pandoc render >>> require >>> layout >>> ...
--- > |
--- > @templates/fancy.html@ ------/
---
--- This illustration can help us understand the type signature of 'require'.
---
--- > require :: (Binary a, Typeable a, Writable a)
--- > => Identifier a
--- > -> (b -> a -> c)
--- > -> Compiler b c
---
--- Let's look at it in detail:
---
--- > (Binary a, Typeable a, Writable a)
---
--- These are constraints for the @a@ type. @a@ (the template) needs to have
--- certain properties for it to be required.
---
--- > Identifier a
---
--- This is simply @templates/fancy.html@: the 'Identifier' of the item we want
--- to 'require', in other words, the name of the item we want to add to the
--- pipeline somehow.
---
--- > (b -> a -> c)
---
--- This is a function given by the user, specifying /how/ the two items shall be
--- merged. @b@ is the output of the previous compiler, and @a@ is the item we
--- just required -- the template. This means @c@ will be the final output of the
--- 'require' combinator.
---
--- > Compiler b c
---
--- Indeed, we have now constructed a compiler which takes a @b@ and produces a
--- @c@. This means that we have a linear pipeline again, thanks to the 'require'
--- function. So, the 'require' function actually helps to reduce to complexity
--- of Hakyll applications!
---
--- Note that require will fetch a previously compiled item: in our example of
--- the type @a@. It is /very/ important that the compiler which produced this
--- value, produced the right type as well!
---
-{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
+--------------------------------------------------------------------------------
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Hakyll.Core.Compiler
( Compiler
- , runCompiler
, getIdentifier
, getRoute
, getRouteFor
@@ -99,95 +10,52 @@ module Hakyll.Core.Compiler
, getResourceString
, getResourceLBS
, getResourceWith
- , fromDependency
- , require_
, require
- , requireA
- , requireAll_
, requireAll
- , requireAllA
, cached
, unsafeCompiler
- , traceShowCompiler
+ , logCompiler
, timedCompiler
- , byPattern
- , byExtension
) where
-import Prelude hiding ((.), id)
-import Control.Arrow ((>>>), (&&&), arr, first)
-import Control.Applicative ((<$>), (*>))
-import Control.Exception (SomeException, handle)
-import Control.Monad.Reader (ask)
-import Control.Monad.Trans (liftIO)
-import Control.Monad.Error (throwError)
-import Control.Category (Category, (.), id)
-import Data.List (find)
-import System.Environment (getProgName)
-import System.FilePath (takeExtension)
-import Data.Binary (Binary)
-import Data.Typeable (Typeable)
-import Data.ByteString.Lazy (ByteString)
-
-import Hakyll.Core.Identifier
-import Hakyll.Core.Identifier.Pattern
-import Hakyll.Core.CompiledItem
-import Hakyll.Core.Writable
-import Hakyll.Core.ResourceProvider
-import Hakyll.Core.Compiler.Internal
-import Hakyll.Core.Store (Store)
-import Hakyll.Core.Routes
-import Hakyll.Core.Logger
-import qualified Hakyll.Core.Store as Store
-
--- | Run a compiler, yielding the resulting target and it's dependencies. This
--- version of 'runCompilerJob' also stores the result
---
-runCompiler :: Compiler CompiledItem -- ^ Compiler to run
- -> Identifier () -- ^ Target identifier
- -> ResourceProvider -- ^ Resource provider
- -> [Identifier ()] -- ^ Universe
- -> Routes -- ^ Route
- -> Store -- ^ Store
- -> Bool -- ^ Was the resource modified?
- -> Logger -- ^ Logger
- -> IO (Throwing CompiledItem) -- ^ Resulting item
-runCompiler compiler id' provider universe routes store modified logger = do
- -- Run the compiler job
- result <- handle (\(e :: SomeException) -> return $ Left $ show e) $
- runCompilerJob compiler id' provider universe routes store modified
- logger
+--------------------------------------------------------------------------------
+import Control.Applicative ((<$>))
+import Data.Binary (Binary)
+import Data.ByteString.Lazy (ByteString)
+import Data.Typeable (Typeable)
+import Prelude hiding (id, (.))
+import System.Environment (getProgName)
- -- Inspect the result
- case result of
- -- In case we compiled an item, we will store a copy in the cache first,
- -- before we return control. This makes sure the compiled item can later
- -- be accessed by e.g. require.
- Right (CompiledItem x) ->
- Store.set store ["Hakyll.Core.Compiler.runCompiler", show id'] x
- -- Otherwise, we do nothing here
- _ -> return ()
+--------------------------------------------------------------------------------
+import Hakyll.Core.Compiler.Internal
+import Hakyll.Core.Compiler.Require
+import Hakyll.Core.Identifier
+import Hakyll.Core.Logger
+import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Routes
+import qualified Hakyll.Core.Store as Store
+import Hakyll.Core.Writable
- return result
+--------------------------------------------------------------------------------
-- | Get the identifier of the item that is currently being compiled
---
-getIdentifier :: Compiler (Identifier b)
-getIdentifier = fromJob $ const $ CompilerM $
- castIdentifier . compilerIdentifier <$> ask
+getIdentifier :: Compiler Identifier
+getIdentifier = compilerIdentifier <$> compilerAsk
+
+--------------------------------------------------------------------------------
-- | Get the route we are using for this item
---
getRoute :: Compiler (Maybe FilePath)
-getRoute = getIdentifier >>> getRouteFor
+getRoute = getIdentifier >>= getRouteFor
+
+--------------------------------------------------------------------------------
-- | Get the route for a specified item
---
-getRouteFor :: Compiler (Identifier a -> Maybe FilePath)
-getRouteFor = fromJob $ \identifier -> CompilerM $ do
- routes <- compilerRoutes <$> ask
+getRouteFor :: Identifier -> Compiler (Maybe FilePath)
+getRouteFor identifier = do
+ routes <- compilerRoutes <$> compilerAsk
return $ runRoutes routes identifier
@@ -197,7 +65,6 @@ getResourceBody :: Compiler String
getResourceBody = getResourceWith resourceBody
-
--------------------------------------------------------------------------------
-- | Get the resource we are compiling as a string
getResourceString :: Compiler String
@@ -213,188 +80,65 @@ getResourceLBS = getResourceWith $ const resourceLBS
--------------------------------------------------------------------------------
-- | Overloadable function for 'getResourceString' and 'getResourceLBS'
-getResourceWith :: (ResourceProvider -> Identifier a -> IO b) -> Compiler b
-getResourceWith reader = fromJob $ \_ -> CompilerM $ do
- provider <- compilerResourceProvider <$> ask
- r <- compilerIdentifier <$> ask
- let filePath = toFilePath r
- if resourceExists provider r
- then liftIO $ reader provider $ castIdentifier r
- else throwError $ error' filePath
- where
- error' id' = "Hakyll.Core.Compiler.getResourceWith: resource "
- ++ show id' ++ " not found"
-
--- | Auxiliary: get a dependency
---
-getDependency :: (Binary a, Writable a, Typeable a)
- => Identifier a -> CompilerM a
-getDependency id' = CompilerM $ do
- store <- compilerStore <$> ask
- result <- liftIO $
- Store.get store ["Hakyll.Core.Compiler.runCompiler", show id']
- case result of
- Store.NotFound -> throwError notFound
- Store.WrongType e r -> throwError $ wrongType e r
- Store.Found x -> return x
- where
- notFound =
- "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was " ++
- "not found in the cache, the cache might be corrupted or " ++
- "the item you are referring to might not exist"
- wrongType e r =
- "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was found " ++
- "in the cache, but does not have the right type: expected " ++ show e ++
- " but got " ++ show r
-
--- | Variant of 'require' which drops the current value
---
-require_ :: (Binary a, Typeable a, Writable a)
- => Identifier a
- -> Compiler a
-require_ identifier =
- fromDependency identifier >>> fromJob (const $ getDependency identifier)
-
--- | Require another target. Using this function ensures automatic handling of
--- dependencies
---
-{-
-require :: (Binary a, Typeable a, Writable a)
- => Identifier a
- -> (b -> a -> c)
- -> Compiler b c
-require identifier = requireA identifier . arr . uncurry
-
--- | Arrow-based variant of 'require'
---
-requireA :: (Binary a, Typeable a, Writable a)
- => Identifier a
- -> Compiler (b, a) c
- -> Compiler b c
-requireA identifier = (id &&& require_ identifier >>>)
--}
-
--- | Variant of 'requireAll' which drops the current value
---
-requireAll_ :: (Binary a, Typeable a, Writable a)
- => Pattern a
- -> Compiler [a]
-requireAll_ pattern = fromDependencies (const getDeps) *> fromJob requireAll_'
+getResourceWith :: (ResourceProvider -> Identifier -> IO a) -> Compiler a
+getResourceWith reader = do
+ provider <- compilerProvider <$> compilerAsk
+ id' <- compilerIdentifier <$> compilerAsk
+ let filePath = toFilePath id'
+ if resourceExists provider id'
+ then compilerUnsafeIO $ reader provider id'
+ else compilerThrow $ error' filePath
where
- getDeps = map castIdentifier . filterMatches pattern . map castIdentifier
- requireAll_' = const $ CompilerM $ do
- deps <- getDeps . compilerUniverse <$> ask
- mapM (unCompilerM . getDependency) deps
+ error' fp = "Hakyll.Core.Compiler.getResourceWith: resource " ++
+ show fp ++ " not found"
--- | Require a number of targets. Using this function ensures automatic handling
--- of dependencies
---
-{-
-requireAll :: (Binary a, Typeable a, Writable a)
- => Pattern a
- -> (b -> [a] -> c)
- -> Compiler b c
-requireAll pattern = requireAllA pattern . arr . uncurry
-
--- | Arrow-based variant of 'requireAll'
---
-requireAllA :: (Binary a, Typeable a, Writable a)
- => Pattern a
- -> Compiler (b, [a]) c
- -> Compiler b c
-requireAllA pattern = (id &&& requireAll_ pattern >>>)
--}
+--------------------------------------------------------------------------------
cached :: (Binary a, Typeable a, Writable a)
=> String
-> Compiler a
-> Compiler a
-cached name (Compiler d j) = Compiler d $ CompilerM $ do
- logger <- compilerLogger <$> ask
- identifier <- castIdentifier . compilerIdentifier <$> ask
- store <- compilerStore <$> ask
- modified <- compilerResourceModified <$> ask
- progName <- liftIO getProgName
- report logger $ "Checking cache: " ++ if modified then "modified" else "OK"
+cached name compiler = do
+ logger <- compilerLogger <$> compilerAsk
+ id' <- compilerIdentifier <$> compilerAsk
+ store <- compilerStore <$> compilerAsk
+ provider <- compilerProvider <$> compilerAsk
+ modified <- compilerUnsafeIO $ resourceModified provider id'
+ compilerUnsafeIO $ report logger $
+ "Checking cache: " ++ if modified then "modified" else "OK"
if modified
- then do v <- unCompilerM $ j ()
- liftIO $ Store.set store [name, show identifier] v
- return v
- else do v <- liftIO $ Store.get store [name, show identifier]
- case v of Store.Found v' -> return v'
- _ -> throwError (error' progName)
+ then do
+ x <- compiler
+ compilerUnsafeIO $ Store.set store [name, show id'] x
+ return x
+ else do
+ x <- compilerUnsafeIO $ Store.get store [name, show id']
+ progName <- compilerUnsafeIO getProgName
+ case x of Store.Found x' -> return x'
+ _ -> compilerThrow (error' progName)
where
error' progName =
"Hakyll.Core.Compiler.cached: Cache corrupt! " ++
"Try running: " ++ progName ++ " clean"
--- | Create an unsafe compiler from a function in IO
---
-unsafeCompiler :: (a -> IO b) -- ^ Function to lift
- -> Compiler (a -> b) -- ^ Resulting compiler
-unsafeCompiler f = fromJob $ CompilerM . liftIO . f
--- | Compiler for debugging purposes
---
-traceShowCompiler :: Show a => Compiler a a
-traceShowCompiler = fromJob $ \x -> CompilerM $ do
- logger <- compilerLogger <$> ask
- report logger $ show x
- return x
+--------------------------------------------------------------------------------
+unsafeCompiler :: IO a -> Compiler a
+unsafeCompiler = compilerUnsafeIO
--- | Log and time a compiler
---
-timedCompiler :: String -- ^ Message
- -> Compiler a b -- ^ Compiler to time
- -> Compiler a b -- ^ Resulting compiler
-timedCompiler msg (Compiler d j) = Compiler d $ \x -> CompilerM $ do
- logger <- compilerLogger <$> ask
- timed logger msg $ unCompilerM $ j x
--- | Choose a compiler by identifier
---
--- For example, assume that most content files need to be compiled
--- normally, but a select few need an extra step in the pipeline:
---
--- > compile $ pageCompiler >>> byPattern id
--- > [ ("projects.md", addProjectListCompiler)
--- > , ("sitemap.md", addSiteMapCompiler)
--- > ]
---
-byPattern :: Compiler a b -- ^ Default compiler
- -> [(Pattern (), Compiler a b)] -- ^ Choices
- -> Compiler a b -- ^ Resulting compiler
-byPattern defaultCompiler choices = Compiler deps job
- where
- -- Lookup the compiler, give an error when it is not found
- lookup' identifier = maybe defaultCompiler snd $
- find (\(p, _) -> matches p identifier) choices
- -- Collect the dependencies of the choice
- deps = do
- identifier <- castIdentifier . dependencyIdentifier <$> ask
- compilerDependencies $ lookup' identifier
- -- Collect the job of the choice
- job x = CompilerM $ do
- identifier <- castIdentifier . compilerIdentifier <$> ask
- unCompilerM $ compilerJob (lookup' identifier) x
+--------------------------------------------------------------------------------
+-- | Compiler for debugging purposes
+logCompiler :: String -> Compiler ()
+logCompiler msg = do
+ logger <- compilerLogger <$> compilerAsk
+ compilerUnsafeIO $ report logger msg
--- | Choose a compiler by extension
---
--- Example:
---
--- > match "css/*" $ do
--- > route $ setExtension "css"
--- > compile $ byExtension (error "Not a (S)CSS file")
--- > [ (".css", compressCssCompiler)
--- > , (".scss", sass)
--- > ]
---
--- This piece of code will select the @compressCssCompiler@ for @.css@ files,
--- and the @sass@ compiler (defined elsewhere) for @.scss@ files.
---
-byExtension :: Compiler a b -- ^ Default compiler
- -> [(String, Compiler a b)] -- ^ Choices
- -> Compiler a b -- ^ Resulting compiler
-byExtension defaultCompiler = byPattern defaultCompiler . map (first extPattern)
- where
- extPattern c = predicate $ (== c) . takeExtension . toFilePath
+
+--------------------------------------------------------------------------------
+-- | Log and time a compiler
+timedCompiler :: String -- ^ Message
+ -> Compiler a -- ^ Compiler to time
+ -> Compiler a -- ^ Resulting compiler
+timedCompiler msg compiler = Compiler $ \r ->
+ timed (compilerLogger r) msg $ unCompiler compiler r
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index f211367..5b7fb51 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -5,19 +5,21 @@
module Hakyll.Core.Compiler.Internal
( CompilerRead (..)
, CompilerResult (..)
- , Compiler
+ , Compiler (..)
, runCompiler
, compilerTell
, compilerAsk
, compilerThrow
, compilerCatch
, compilerResult
+ , compilerUnsafeIO
) where
--------------------------------------------------------------------------------
import Control.Applicative (Alternative (..),
Applicative (..))
+import Control.Exception (SomeException, handle)
import Data.Monoid (mappend, mempty)
@@ -34,19 +36,17 @@ import Hakyll.Core.Store
-- | Environment in which a compiler runs
data CompilerRead = CompilerRead
{ -- | Target identifier
- compilerIdentifier :: Identifier
+ compilerIdentifier :: Identifier
, -- | Resource provider
- compilerResourceProvider :: ResourceProvider
+ compilerProvider :: ResourceProvider
, -- | List of all known identifiers
- compilerUniverse :: [Identifier]
+ compilerUniverse :: [Identifier]
, -- | Site routes
- compilerRoutes :: Routes
+ compilerRoutes :: Routes
, -- | Compiler store
- compilerStore :: Store
- , -- | Flag indicating if the underlying resource was modified
- compilerResourceModified :: Bool
+ compilerStore :: Store
, -- | Logger
- compilerLogger :: Logger
+ compilerLogger :: Logger
}
@@ -111,7 +111,10 @@ instance Applicative Compiler where
--------------------------------------------------------------------------------
runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)
-runCompiler = unCompiler
+runCompiler compiler read' = handle handler $ unCompiler compiler read'
+ where
+ handler :: SomeException -> IO (CompilerResult a)
+ handler e = return $ CompilerError $ show e
--------------------------------------------------------------------------------
@@ -128,7 +131,7 @@ compilerAsk = Compiler $ \r -> return $ CompilerDone r mempty
--------------------------------------------------------------------------------
-compilerTell :: [Dependency] -> Compiler ()
+compilerTell :: CompilerWrite -> Compiler ()
compilerTell deps = Compiler $ \_ -> return $ CompilerDone () deps
{-# INLINE compilerTell #-}
@@ -154,3 +157,11 @@ compilerCatch (Compiler x) f = Compiler $ \r -> do
compilerResult :: CompilerResult a -> Compiler a
compilerResult x = Compiler $ \_ -> return x
{-# INLINE compilerResult #-}
+
+
+--------------------------------------------------------------------------------
+compilerUnsafeIO :: IO a -> Compiler a
+compilerUnsafeIO io = Compiler $ \_ -> do
+ x <- io
+ return $ CompilerDone x mempty
+{-# INLINE compilerUnsafeIO #-}
diff --git a/src/Hakyll/Core/Compiler/Require.hs b/src/Hakyll/Core/Compiler/Require.hs
new file mode 100644
index 0000000..1dc96e7
--- /dev/null
+++ b/src/Hakyll/Core/Compiler/Require.hs
@@ -0,0 +1,63 @@
+--------------------------------------------------------------------------------
+module Hakyll.Core.Compiler.Require
+ ( save
+ , require
+ , requireAll
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Applicative ((<$>))
+import Data.Binary (Binary)
+import Data.Typeable
+
+
+--------------------------------------------------------------------------------
+import Hakyll.Core.Compiler.Internal
+import Hakyll.Core.Dependencies
+import Hakyll.Core.Identifier
+import Hakyll.Core.Identifier.Pattern
+import Hakyll.Core.Store (Store)
+import qualified Hakyll.Core.Store as Store
+
+
+--------------------------------------------------------------------------------
+save :: (Binary a, Typeable a) => Store -> Identifier -> a -> IO ()
+save store identifier x = Store.set store (key identifier) x
+
+
+--------------------------------------------------------------------------------
+require :: (Binary a, Typeable a) => Identifier -> Compiler a
+require id' = do
+ store <- compilerStore <$> compilerAsk
+
+ compilerTell [Identifier id']
+ compilerResult $ CompilerRequire id' $ do
+ result <- compilerUnsafeIO $ Store.get store (key id')
+ case result of
+ Store.NotFound -> compilerThrow notFound
+ Store.WrongType e r -> compilerThrow $ wrongType e r
+ Store.Found x -> return x
+ where
+ notFound =
+ "Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was " ++
+ "not found in the cache, the cache might be corrupted or " ++
+ "the item you are referring to might not exist"
+ wrongType e r =
+ "Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was found " ++
+ "in the cache, but does not have the right type: expected " ++ show e ++
+ " but got " ++ show r
+
+
+--------------------------------------------------------------------------------
+requireAll :: (Binary a, Typeable a) => Pattern -> Compiler [a]
+requireAll pattern = do
+ universe <- compilerUniverse <$> compilerAsk
+ let matching = filterMatches pattern universe
+ compilerTell [Pattern pattern matching]
+ mapM require matching
+
+
+--------------------------------------------------------------------------------
+key :: Identifier -> [String]
+key identifier = ["Hakyll.Core.Compiler.Require", show identifier]
diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs
index e9fb6cd..7354119 100644
--- a/src/Hakyll/Core/Runtime.hs
+++ b/src/Hakyll/Core/Runtime.hs
@@ -23,6 +23,7 @@ import System.FilePath ((</>))
--------------------------------------------------------------------------------
import Hakyll.Core.CompiledItem
import Hakyll.Core.Compiler.Internal
+import Hakyll.Core.Compiler.Require
import Hakyll.Core.Configuration
import Hakyll.Core.Dependencies
import Hakyll.Core.Identifier
@@ -159,16 +160,14 @@ chase trail id'
config <- runtimeConfiguration <$> ask
section logger $ "Processing " ++ show id'
- isModified <- liftIO $ resourceModified provider id'
let compiler = todo M.! id'
read' = CompilerRead
- { compilerIdentifier = id'
- , compilerResourceProvider = provider
- , compilerUniverse = map fst universe
- , compilerRoutes = routes
- , compilerStore = store
- , compilerResourceModified = isModified
- , compilerLogger = logger
+ { compilerIdentifier = id'
+ , compilerProvider = provider
+ , compilerUniverse = map fst universe
+ , compilerRoutes = routes
+ , compilerStore = store
+ , compilerLogger = logger
}
result <- timed logger "Compiling" $ liftIO $ runCompiler compiler read'
@@ -177,7 +176,7 @@ chase trail id'
CompilerError e -> throwError e
-- Huge success
- CompilerDone compiled facts -> do
+ CompilerDone (CompiledItem compiled) facts -> do
-- Write if necessary
case runRoutes routes id' of
Nothing -> return ()
@@ -186,6 +185,9 @@ chase trail id'
liftIO $ makeDirectories path
liftIO $ write path compiled
+ -- Save! (For require)
+ liftIO $ save store id' compiled
+
-- Update state
modify $ \s -> s
{ runtimeDone = S.insert id' (runtimeDone s)
diff --git a/src/Hakyll/Core/UnixFilter.hs b/src/Hakyll/Core/UnixFilter.hs
index dcbbaaf..e86c58a 100644
--- a/src/Hakyll/Core/UnixFilter.hs
+++ b/src/Hakyll/Core/UnixFilter.hs
@@ -1,29 +1,32 @@
+--------------------------------------------------------------------------------
-- | A Compiler that supports unix filters.
---
module Hakyll.Core.UnixFilter
( unixFilter
, unixFilterLBS
) where
-import Control.Concurrent (forkIO)
-import System.Posix.Process (executeFile, forkProcess)
-import System.Posix.IO ( dupTo, createPipe, stdInput
- , stdOutput, closeFd, fdToHandle
- )
-import System.IO ( Handle, hPutStr, hClose, hGetContents
- , hSetEncoding, localeEncoding
- )
-import Data.ByteString.Lazy (ByteString)
+--------------------------------------------------------------------------------
+import Control.Concurrent (forkIO)
+import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as LB
+import System.IO (Handle, hClose, hGetContents, hPutStr,
+ hSetEncoding, localeEncoding)
+import System.Posix.IO (closeFd, createPipe, dupTo, fdToHandle,
+ stdInput, stdOutput)
+import System.Posix.Process (executeFile, forkProcess)
+
+
+--------------------------------------------------------------------------------
+import Hakyll.Core.Compiler
-import Hakyll.Core.Compiler
+--------------------------------------------------------------------------------
-- | Use a unix filter as compiler. For example, we could use the 'rev' program
-- as a compiler.
--
--- > rev :: Compiler Resource String
--- > rev = getResourceString >>> unixFilter "rev" []
+-- > rev :: Compiler String
+-- > rev = getResourceString >>= unixFilter "rev" []
--
-- A more realistic example: one can use this to call, for example, the sass
-- compiler on CSS files. More information about sass can be found here:
@@ -34,12 +37,13 @@ import Hakyll.Core.Compiler
--
-- > match "style.scss" $ do
-- > route $ setExtension "css"
--- > compile $ getResourceString >>> unixFilter "sass" ["-s", "--scss"]
--- > >>> arr compressCss
---
-unixFilter :: String -- ^ Program name
- -> [String] -- ^ Program args
- -> Compiler String String -- ^ Resulting compiler
+-- > compile $ getResourceString >>=
+-- > unixFilter "sass" ["-s", "--scss"] >>=
+-- > compressCssCompiler
+unixFilter :: String -- ^ Program name
+ -> [String] -- ^ Program args
+ -> String -- ^ Program input
+ -> Compiler String -- ^ Program output
unixFilter = unixFilterWith writer reader
where
writer handle input = do
@@ -49,30 +53,35 @@ unixFilter = unixFilterWith writer reader
hSetEncoding handle localeEncoding
hGetContents handle
+
+--------------------------------------------------------------------------------
-- | Variant of 'unixFilter' that should be used for binary files
--
-- > match "music.wav" $ do
-- > route $ setExtension "ogg"
--- > compile $ getResourceLBS >>> unixFilter "oggenc" ["-"]
---
-unixFilterLBS :: String -- ^ Program name
- -> [String] -- ^ Program args
- -> Compiler ByteString ByteString -- ^ Resulting compiler
+-- > compile $ getResourceLBS >>= unixFilter "oggenc" ["-"]
+unixFilterLBS :: String -- ^ Program name
+ -> [String] -- ^ Program args
+ -> ByteString -- ^ Program input
+ -> Compiler ByteString -- ^ Program output
unixFilterLBS = unixFilterWith LB.hPutStr LB.hGetContents
+
+--------------------------------------------------------------------------------
-- | Overloaded compiler
---
unixFilterWith :: (Handle -> i -> IO ()) -- ^ Writer
-> (Handle -> IO o) -- ^ Reader
-> String -- ^ Program name
-> [String] -- ^ Program args
- -> Compiler i o -- ^ Resulting compiler
-unixFilterWith writer reader programName args =
+ -> i -- ^ Program input
+ -> Compiler o -- ^ Program output
+unixFilterWith writer reader programName args input =
timedCompiler ("Executing external program " ++ programName) $
- unsafeCompiler $ unixFilterIO writer reader programName args
+ unsafeCompiler $ unixFilterIO writer reader programName args input
+
+--------------------------------------------------------------------------------
-- | Internally used function
---
unixFilterIO :: (Handle -> i -> IO ())
-> (Handle -> IO o)
-> String
@@ -83,7 +92,7 @@ unixFilterIO writer reader programName args input = do
-- Create pipes
(stdinRead, stdinWrite) <- createPipe
(stdoutRead, stdoutWrite) <- createPipe
-
+
-- Fork the child
_ <- forkProcess $ do
-- Copy our pipes over the regular stdin/stdout
diff --git a/src/Hakyll/Core/Writable/CopyFile.hs b/src/Hakyll/Core/Writable/CopyFile.hs
index 6cc08f2..2d92891 100644
--- a/src/Hakyll/Core/Writable/CopyFile.hs
+++ b/src/Hakyll/Core/Writable/CopyFile.hs
@@ -1,6 +1,7 @@
--------------------------------------------------------------------------------
-- | Exports simple compilers to just copy files
-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Core.Writable.CopyFile
( CopyFile (..)
, copyFileCompiler
@@ -8,16 +9,16 @@ module Hakyll.Core.Writable.CopyFile
--------------------------------------------------------------------------------
-import Control.Arrow ((>>^))
-import System.Directory (copyFile)
-import Data.Typeable (Typeable)
-import Data.Binary (Binary)
+import Control.Applicative ((<$>))
+import Data.Binary (Binary)
+import Data.Typeable (Typeable)
+import System.Directory (copyFile)
--------------------------------------------------------------------------------
-import Hakyll.Core.Writable
-import Hakyll.Core.Compiler
-import Hakyll.Core.Identifier
+import Hakyll.Core.Compiler
+import Hakyll.Core.Identifier
+import Hakyll.Core.Writable
--------------------------------------------------------------------------------
@@ -32,5 +33,5 @@ instance Writable CopyFile where
--------------------------------------------------------------------------------
-copyFileCompiler :: Compiler a CopyFile
-copyFileCompiler = getIdentifier >>^ CopyFile . toFilePath
+copyFileCompiler :: Compiler CopyFile
+copyFileCompiler = CopyFile . toFilePath <$> getIdentifier
diff --git a/src/Hakyll/Core/Writable/WritableTuple.hs b/src/Hakyll/Core/Writable/WritableTuple.hs
deleted file mode 100644
index 741d2c7..0000000
--- a/src/Hakyll/Core/Writable/WritableTuple.hs
+++ /dev/null
@@ -1,37 +0,0 @@
--- | This module exposes a writable type 'WritableTuple' which is a simple
--- newtype wrapper around a tuple.
---
--- The idea is that, given a tuple @(a, b)@, @a@ is the value you actually want
--- to save to the disk, and @b@ is some additional info that you /don't/ want to
--- save, but that you need later, for example in a 'require' clause.
---
-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
-module Hakyll.Core.Writable.WritableTuple
- ( WritableTuple (..)
- , writableTupleFst
- , writableTupleSnd
- , writableTupleCompiler
- ) where
-
-import Control.Arrow (arr)
-
-import Data.Typeable (Typeable)
-import Data.Binary (Binary)
-
-import Hakyll.Core.Writable
-import Hakyll.Core.Compiler
-
-newtype WritableTuple a b = WritableTuple {unWritableTuple :: (a, b)}
- deriving (Show, Eq, Ord, Binary, Typeable)
-
-instance Writable a => Writable (WritableTuple a b) where
- write dst (WritableTuple (x, _)) = write dst x
-
-writableTupleFst :: WritableTuple a b -> a
-writableTupleFst = fst . unWritableTuple
-
-writableTupleSnd :: WritableTuple a b -> b
-writableTupleSnd = snd . unWritableTuple
-
-writableTupleCompiler :: Compiler (a, b) (WritableTuple a b)
-writableTupleCompiler = arr WritableTuple
diff --git a/src/Hakyll/Web/CompressCss.hs b/src/Hakyll/Web/CompressCss.hs
index d0ca8cd..133c7f0 100644
--- a/src/Hakyll/Web/CompressCss.hs
+++ b/src/Hakyll/Web/CompressCss.hs
@@ -1,50 +1,59 @@
+--------------------------------------------------------------------------------
-- | Module used for CSS compression. The compression is currently in a simple
-- state, but would typically reduce the number of bytes by about 25%.
---
module Hakyll.Web.CompressCss
( compressCssCompiler
, compressCss
) where
-import Data.Char (isSpace)
-import Data.List (isPrefixOf)
-import Control.Arrow ((>>^))
-import Hakyll.Core.Compiler
-import Hakyll.Core.Util.String
+--------------------------------------------------------------------------------
+import Control.Applicative ((<$>))
+import Data.Char (isSpace)
+import Data.List (isPrefixOf)
+
+--------------------------------------------------------------------------------
+import Hakyll.Core.Compiler
+import Hakyll.Core.Util.String
+
+
+--------------------------------------------------------------------------------
-- | Compiler form of 'compressCss'
---
-compressCssCompiler :: Compiler a String
-compressCssCompiler = getResourceString >>^ compressCss
+compressCssCompiler :: Compiler String
+compressCssCompiler = compressCss <$> getResourceString
+
+--------------------------------------------------------------------------------
-- | Compress CSS to speed up your site.
---
compressCss :: String -> String
-compressCss = compressSeparators
- . stripComments
- . compressWhitespace
+compressCss = compressSeparators . stripComments . compressWhitespace
+
+--------------------------------------------------------------------------------
-- | Compresses certain forms of separators.
---
compressSeparators :: String -> String
-compressSeparators = replaceAll "; *}" (const "}")
- . replaceAll " *([{};:]) *" (take 1 . dropWhile isSpace)
- . replaceAll ";+" (const ";")
+compressSeparators =
+ replaceAll "; *}" (const "}") .
+ replaceAll " *([{};:]) *" (take 1 . dropWhile isSpace) .
+ replaceAll ";+" (const ";")
+
+--------------------------------------------------------------------------------
-- | Compresses all whitespace.
---
compressWhitespace :: String -> String
compressWhitespace = replaceAll "[ \t\n\r]+" (const " ")
+
+--------------------------------------------------------------------------------
-- | Function that strips CSS comments away.
---
stripComments :: String -> String
stripComments [] = []
stripComments str
| isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str
| otherwise = head str : stripComments (drop 1 str)
where
- eatComments str' | null str' = []
- | isPrefixOf "*/" str' = drop 2 str'
- | otherwise = eatComments $ drop 1 str'
+ eatComments str'
+ | null str' = []
+ | isPrefixOf "*/" str' = drop 2 str'
+ | otherwise = eatComments $ drop 1 str'
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index fc17735..ca98042 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -58,9 +58,6 @@ module Hakyll.Web.Page
--------------------------------------------------------------------------------
-import Control.Arrow (arr, (>>>))
-import Control.Category (id)
-import Prelude hiding (id)
import Text.Pandoc (Pandoc, ParserState, WriterOptions)
@@ -72,14 +69,14 @@ import Hakyll.Web.Pandoc
--------------------------------------------------------------------------------
-- | Read a page (do not render it)
-readPageCompiler :: Compiler () Page
+readPageCompiler :: Compiler Page
readPageCompiler = getResourceBody
{-# DEPRECATED readPageCompiler "Use getResourceBody" #-}
--------------------------------------------------------------------------------
-- | Read a page render using pandoc
-pageCompiler :: Compiler () Page
+pageCompiler :: Compiler Page
pageCompiler =
pageCompilerWith defaultHakyllParserState defaultHakyllWriterOptions
@@ -87,7 +84,7 @@ pageCompiler =
--------------------------------------------------------------------------------
-- | A version of 'pageCompiler' which allows you to specify your own pandoc
-- options
-pageCompilerWith :: ParserState -> WriterOptions -> Compiler () Page
+pageCompilerWith :: ParserState -> WriterOptions -> Compiler Page
pageCompilerWith state options = pageCompilerWithPandoc state options id
@@ -96,9 +93,9 @@ pageCompilerWith state options = pageCompilerWithPandoc state options id
-- pandoc transformation for the content
pageCompilerWithPandoc :: ParserState -> WriterOptions
-> (Pandoc -> Pandoc)
- -> Compiler () Page
+ -> Compiler Page
pageCompilerWithPandoc state options f = cached cacheName $
- readPageCompiler >>> pageReadPandocWith state >>>
- arr (writePandocWith options . f)
+ readPageCompiler >>= pageReadPandocWith state >>=
+ return . writePandocWith options . f
where
cacheName = "Hakyll.Web.Page.pageCompilerWithPandoc"
diff --git a/src/Hakyll/Web/Pandoc.hs b/src/Hakyll/Web/Pandoc.hs
index 7ebf4a2..caada26 100644
--- a/src/Hakyll/Web/Pandoc.hs
+++ b/src/Hakyll/Web/Pandoc.hs
@@ -10,7 +10,6 @@ module Hakyll.Web.Pandoc
-- * Functions working on pages/compilers
, pageReadPandoc
, pageReadPandocWith
- , pageReadPandocWithA
, pageRenderPandoc
, pageRenderPandocWith
@@ -21,37 +20,34 @@ module Hakyll.Web.Pandoc
--------------------------------------------------------------------------------
-import Control.Arrow ((&&&), (***), (>>>), (>>^))
-import Control.Category (id)
+import Control.Applicative ((<$>))
import Data.Maybe (fromMaybe)
-import Prelude hiding (id)
import Text.Pandoc
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler
import Hakyll.Core.Identifier
-import Hakyll.Core.Util.Arrow
import Hakyll.Web.Page.Internal
import Hakyll.Web.Pandoc.FileType
--------------------------------------------------------------------------------
-- | Read a string using pandoc, with the default options
-readPandoc :: FileType -- ^ Determines how parsing happens
- -> Maybe (Identifier a) -- ^ Optional, for better error messages
- -> Page -- ^ String to read
- -> Pandoc -- ^ Resulting document
+readPandoc :: FileType -- ^ Determines how parsing happens
+ -> Maybe Identifier -- ^ Optional, for better error messages
+ -> Page -- ^ String to read
+ -> Pandoc -- ^ Resulting document
readPandoc = readPandocWith defaultHakyllParserState
--------------------------------------------------------------------------------
-- | Read a string using pandoc, with the supplied options
-readPandocWith :: ParserState -- ^ Parser options
- -> FileType -- ^ Determines parsing method
- -> Maybe (Identifier a) -- ^ Optional, for better error messages
- -> Page -- ^ String to read
- -> Pandoc -- ^ Resulting document
+readPandocWith :: ParserState -- ^ Parser options
+ -> FileType -- ^ Determines parsing method
+ -> Maybe Identifier -- ^ Optional, for better error messages
+ -> Page -- ^ String to read
+ -> Pandoc -- ^ Resulting document
readPandocWith state fileType' id' = case fileType' of
Html -> readHtml state
LaTeX -> readLaTeX state
@@ -82,38 +78,31 @@ writePandocWith = writeHtmlString
--------------------------------------------------------------------------------
-- | Read the resource using pandoc
-pageReadPandoc :: Compiler Page Pandoc
+pageReadPandoc :: Page -> Compiler Pandoc
pageReadPandoc = pageReadPandocWith defaultHakyllParserState
--------------------------------------------------------------------------------
-- | Read the resource using pandoc
-pageReadPandocWith :: ParserState -> Compiler Page Pandoc
-pageReadPandocWith state = constA state &&& id >>> pageReadPandocWithA
-
-
---------------------------------------------------------------------------------
--- | Read the resource using pandoc. This is a (rarely needed) variant, which
--- comes in very useful when the parser state is the result of some arrow.
-pageReadPandocWithA :: Compiler (ParserState, Page) Pandoc
-pageReadPandocWithA =
- id *** id &&& getIdentifier &&& getFileType >>^ pageReadPandocWithA'
- where
- pageReadPandocWithA' (s, (p, (i, t))) = readPandocWith s t (Just i) p
+pageReadPandocWith :: ParserState -> Page -> Compiler Pandoc
+pageReadPandocWith state page = do
+ identifier <- getIdentifier
+ fileType' <- getFileType
+ return $ readPandocWith state fileType' (Just identifier) page
--------------------------------------------------------------------------------
-- | Render the resource using pandoc
-pageRenderPandoc :: Compiler Page Page
+pageRenderPandoc :: Page -> Compiler Page
pageRenderPandoc =
pageRenderPandocWith defaultHakyllParserState defaultHakyllWriterOptions
--------------------------------------------------------------------------------
-- | Render the resource using pandoc
-pageRenderPandocWith :: ParserState -> WriterOptions -> Compiler Page Page
-pageRenderPandocWith state options =
- pageReadPandocWith state >>^ writePandocWith options
+pageRenderPandocWith :: ParserState -> WriterOptions -> Page -> Compiler Page
+pageRenderPandocWith state options page =
+ writePandocWith options <$> pageReadPandocWith state page
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Web/Pandoc/Biblio.hs b/src/Hakyll/Web/Pandoc/Biblio.hs
index 699ba31..ca8d10e 100644
--- a/src/Hakyll/Web/Pandoc/Biblio.hs
+++ b/src/Hakyll/Web/Pandoc/Biblio.hs
@@ -7,7 +7,9 @@
-- refer to these files when you use 'pageReadPandocBiblio'. This function also
-- takes a parser state for completeness -- you can use
-- 'defaultHakyllParserState' if you're unsure.
-{-# LANGUAGE Arrows, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Web.Pandoc.Biblio
( CSL
, cslCompiler
@@ -18,21 +20,20 @@ module Hakyll.Web.Pandoc.Biblio
--------------------------------------------------------------------------------
-import Control.Applicative ((<$>))
-import Control.Arrow (arr, returnA, (>>>))
-import Data.Typeable (Typeable)
-import Data.Binary (Binary (..))
-import Text.Pandoc (Pandoc, ParserState (..))
-import Text.Pandoc.Biblio (processBiblio)
-import qualified Text.CSL as CSL
+import Control.Applicative ((<$>))
+import Data.Binary (Binary (..))
+import Data.Typeable (Typeable)
+import qualified Text.CSL as CSL
+import Text.Pandoc (Pandoc, ParserState (..))
+import Text.Pandoc.Biblio (processBiblio)
--------------------------------------------------------------------------------
-import Hakyll.Core.Compiler
-import Hakyll.Core.Identifier
-import Hakyll.Core.Writable
-import Hakyll.Web.Page
-import Hakyll.Web.Pandoc
+import Hakyll.Core.Compiler
+import Hakyll.Core.Identifier
+import Hakyll.Core.Writable
+import Hakyll.Web.Page
+import Hakyll.Web.Pandoc
--------------------------------------------------------------------------------
@@ -41,8 +42,8 @@ newtype CSL = CSL FilePath
--------------------------------------------------------------------------------
-cslCompiler :: Compiler () CSL
-cslCompiler = getIdentifier >>> arr (CSL . toFilePath)
+cslCompiler :: Compiler CSL
+cslCompiler = CSL . toFilePath <$> getIdentifier
--------------------------------------------------------------------------------
@@ -61,26 +62,24 @@ instance Writable Biblio where
--------------------------------------------------------------------------------
-biblioCompiler :: Compiler () Biblio
-biblioCompiler = getIdentifier >>>
- arr toFilePath >>> unsafeCompiler CSL.readBiblioFile >>> arr Biblio
+biblioCompiler :: Compiler Biblio
+biblioCompiler = do
+ filePath <- toFilePath <$> getIdentifier
+ unsafeCompiler $ Biblio <$> CSL.readBiblioFile filePath
--------------------------------------------------------------------------------
pageReadPandocBiblio :: ParserState
- -> Identifier CSL
- -> Identifier Biblio
- -> Compiler Page Pandoc
-pageReadPandocBiblio state csl refs = proc page -> do
- CSL csl' <- require_ csl -< ()
- Biblio refs' <- require_ refs -< ()
+ -> CSL
+ -> Biblio
+ -> Page
+ -> Compiler Pandoc
+pageReadPandocBiblio state (CSL csl) (Biblio refs) page = do
-- We need to know the citation keys, add then *before* actually parsing the
-- actual page. If we don't do this, pandoc won't even consider them
-- citations!
- let cits = map CSL.refId refs'
+ let cits = map CSL.refId refs
state' = state {stateCitations = stateCitations state ++ cits}
- pandoc <- pageReadPandocWithA -< (state', page)
- pandoc' <- unsafeCompiler processBiblio' -< (csl', refs', pandoc)
- returnA -< pandoc'
- where
- processBiblio' (c, r, p) = processBiblio c Nothing r p
+ pandoc <- pageReadPandocWith state' page
+ pandoc' <- unsafeCompiler $ processBiblio csl Nothing refs pandoc
+ return pandoc'
diff --git a/src/Hakyll/Web/Pandoc/FileType.hs b/src/Hakyll/Web/Pandoc/FileType.hs
index db24da7..2d28edd 100644
--- a/src/Hakyll/Web/Pandoc/FileType.hs
+++ b/src/Hakyll/Web/Pandoc/FileType.hs
@@ -8,7 +8,7 @@ module Hakyll.Web.Pandoc.FileType
--------------------------------------------------------------------------------
-import Control.Arrow ((>>^))
+import Control.Applicative ((<$>))
import System.FilePath (takeExtension)
@@ -62,5 +62,5 @@ fileType = fileType' . takeExtension
--------------------------------------------------------------------------------
-- | Get the file type for the current file
-getFileType :: Compiler a FileType
-getFileType = getIdentifier >>^ fileType . toFilePath
+getFileType :: Compiler FileType
+getFileType = fileType . toFilePath <$> getIdentifier
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index 4273b79..6261a09 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -26,16 +26,14 @@ import Hakyll.Web.Urls
--------------------------------------------------------------------------------
-type Context a = Compiler (String, (Identifier a, a)) String
+type Context a = String -> Identifier -> a -> Compiler String
--------------------------------------------------------------------------------
-field :: String -> Compiler (Identifier a, a) String -> Context a
-field key value = arr checkKey >>> (empty ||| value)
- where
- checkKey (k, x)
- | k /= key = Left ()
- | otherwise = Right x
+field :: String -> (Identifier -> a -> Compiler String) -> Context a
+field key value k' id' x
+ | k' == key = value id' x
+ | otherwise = empty
--------------------------------------------------------------------------------
@@ -51,7 +49,7 @@ defaultContext =
--------------------------------------------------------------------------------
bodyField :: String -> Context Page
-bodyField key = field key $ arr snd
+bodyField key = field key $ \_ x -> return x
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Web/Urls/Relativize.hs b/src/Hakyll/Web/Urls/Relativize.hs
index 0251cfe..068ae09 100644
--- a/src/Hakyll/Web/Urls/Relativize.hs
+++ b/src/Hakyll/Web/Urls/Relativize.hs
@@ -21,10 +21,7 @@ module Hakyll.Web.Urls.Relativize
--------------------------------------------------------------------------------
-import Control.Arrow ((&&&), (>>^))
-import Control.Category (id)
import Data.List (isPrefixOf)
-import Prelude hiding (id)
--------------------------------------------------------------------------------
@@ -36,11 +33,12 @@ import Hakyll.Web.Urls
--------------------------------------------------------------------------------
-- | Compiler form of 'relativizeUrls' which automatically picks the right root
-- path
-relativizeUrlsCompiler :: Compiler Page Page
-relativizeUrlsCompiler = getRoute &&& id >>^ uncurry relativize
- where
- relativize Nothing = id
- relativize (Just r) = relativizeUrls $ toSiteRoot r
+relativizeUrlsCompiler :: Page -> Compiler Page
+relativizeUrlsCompiler page = do
+ route <- getRoute
+ return $ case route of
+ Nothing -> page
+ Just r -> relativizeUrls (toSiteRoot r) page
--------------------------------------------------------------------------------
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 21:26:41 +0000