From 67ecff7ad383640bc73d64edc2506c7cc648a134 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 19 Jun 2017 11:57:23 +0200 Subject: Move src/ to lib/, put Init.hs in src/ --- lib/Hakyll/Core/Compiler.hs | 189 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 189 insertions(+) create mode 100644 lib/Hakyll/Core/Compiler.hs (limited to 'lib/Hakyll/Core/Compiler.hs') diff --git a/lib/Hakyll/Core/Compiler.hs b/lib/Hakyll/Core/Compiler.hs new file mode 100644 index 0000000..42b24d6 --- /dev/null +++ b/lib/Hakyll/Core/Compiler.hs @@ -0,0 +1,189 @@ +-------------------------------------------------------------------------------- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Hakyll.Core.Compiler + ( Compiler + , getUnderlying + , getUnderlyingExtension + , makeItem + , getRoute + , getResourceBody + , getResourceString + , getResourceLBS + , getResourceFilePath + + , Internal.Snapshot + , saveSnapshot + , Internal.load + , Internal.loadSnapshot + , Internal.loadBody + , Internal.loadSnapshotBody + , Internal.loadAll + , Internal.loadAllSnapshots + + , cached + , unsafeCompiler + , debugCompiler + ) where + + +-------------------------------------------------------------------------------- +import Control.Monad (when, unless) +import Data.Binary (Binary) +import Data.ByteString.Lazy (ByteString) +import Data.Typeable (Typeable) +import System.Environment (getProgName) +import System.FilePath (takeExtension) + + +-------------------------------------------------------------------------------- +import Hakyll.Core.Compiler.Internal +import qualified Hakyll.Core.Compiler.Require as Internal +import Hakyll.Core.Dependencies +import Hakyll.Core.Identifier +import Hakyll.Core.Item +import Hakyll.Core.Logger as Logger +import Hakyll.Core.Provider +import Hakyll.Core.Routes +import qualified Hakyll.Core.Store as Store + + +-------------------------------------------------------------------------------- +-- | Get the underlying identifier. +getUnderlying :: Compiler Identifier +getUnderlying = compilerUnderlying <$> compilerAsk + + +-------------------------------------------------------------------------------- +-- | Get the extension of the underlying identifier. Returns something like +-- @".html"@ +getUnderlyingExtension :: Compiler String +getUnderlyingExtension = takeExtension . toFilePath <$> getUnderlying + + +-------------------------------------------------------------------------------- +makeItem :: a -> Compiler (Item a) +makeItem x = do + identifier <- getUnderlying + return $ Item identifier x + + +-------------------------------------------------------------------------------- +-- | Get the route for a specified item +getRoute :: Identifier -> Compiler (Maybe FilePath) +getRoute identifier = do + provider <- compilerProvider <$> compilerAsk + routes <- compilerRoutes <$> compilerAsk + -- Note that this makes us dependend on that identifier: when the metadata + -- of that item changes, the route may change, hence we have to recompile + (mfp, um) <- compilerUnsafeIO $ runRoutes routes provider identifier + when um $ compilerTellDependencies [IdentifierDependency identifier] + return mfp + + +-------------------------------------------------------------------------------- +-- | Get the full contents of the matched source file as a string, +-- but without metadata preamble, if there was one. +getResourceBody :: Compiler (Item String) +getResourceBody = getResourceWith resourceBody + + +-------------------------------------------------------------------------------- +-- | Get the full contents of the matched source file as a string. +getResourceString :: Compiler (Item String) +getResourceString = getResourceWith resourceString + + +-------------------------------------------------------------------------------- +-- | Get the full contents of the matched source file as a lazy bytestring. +getResourceLBS :: Compiler (Item ByteString) +getResourceLBS = getResourceWith resourceLBS + + +-------------------------------------------------------------------------------- +-- | Get the file path of the resource we are compiling +getResourceFilePath :: Compiler FilePath +getResourceFilePath = do + provider <- compilerProvider <$> compilerAsk + id' <- compilerUnderlying <$> compilerAsk + return $ resourceFilePath provider id' + + +-------------------------------------------------------------------------------- +-- | Overloadable function for 'getResourceString' and 'getResourceLBS' +getResourceWith :: (Provider -> Identifier -> IO a) -> Compiler (Item a) +getResourceWith reader = do + provider <- compilerProvider <$> compilerAsk + id' <- compilerUnderlying <$> compilerAsk + let filePath = toFilePath id' + if resourceExists provider id' + then compilerUnsafeIO $ Item id' <$> reader provider id' + else fail $ error' filePath + where + error' fp = "Hakyll.Core.Compiler.getResourceWith: resource " ++ + show fp ++ " not found" + + +-------------------------------------------------------------------------------- +-- | Save a snapshot of the item. This function returns the same item, which +-- convenient for building '>>=' chains. +saveSnapshot :: (Binary a, Typeable a) + => Internal.Snapshot -> Item a -> Compiler (Item a) +saveSnapshot snapshot item = do + store <- compilerStore <$> compilerAsk + logger <- compilerLogger <$> compilerAsk + compilerUnsafeIO $ do + Logger.debug logger $ "Storing snapshot: " ++ snapshot + Internal.saveSnapshot store snapshot item + + -- Signal that we saved the snapshot. + Compiler $ \_ -> return $ CompilerSnapshot snapshot (return item) + + +-------------------------------------------------------------------------------- +cached :: (Binary a, Typeable a) + => String + -> Compiler a + -> Compiler a +cached name compiler = do + id' <- compilerUnderlying <$> compilerAsk + store <- compilerStore <$> compilerAsk + provider <- compilerProvider <$> compilerAsk + + -- Give a better error message when the resource is not there at all. + unless (resourceExists provider id') $ fail $ itDoesntEvenExist id' + + let modified = resourceModified provider id' + if modified + then do + x <- compiler + compilerUnsafeIO $ Store.set store [name, show id'] x + return x + else do + compilerTellCacheHits 1 + x <- compilerUnsafeIO $ Store.get store [name, show id'] + progName <- compilerUnsafeIO getProgName + case x of Store.Found x' -> return x' + _ -> fail $ error' progName + where + error' progName = + "Hakyll.Core.Compiler.cached: Cache corrupt! " ++ + "Try running: " ++ progName ++ " clean" + + itDoesntEvenExist id' = + "Hakyll.Core.Compiler.cached: You are trying to (perhaps " ++ + "indirectly) use `cached` on a non-existing resource: there " ++ + "is no file backing " ++ show id' + + +-------------------------------------------------------------------------------- +unsafeCompiler :: IO a -> Compiler a +unsafeCompiler = compilerUnsafeIO + + +-------------------------------------------------------------------------------- +-- | Compiler for debugging purposes +debugCompiler :: String -> Compiler () +debugCompiler msg = do + logger <- compilerLogger <$> compilerAsk + compilerUnsafeIO $ Logger.debug logger msg -- cgit v1.2.3