Move src/ to lib/, put Init.hs in src/

1 files changed, 189 insertions, 0 deletions

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