--------------------------------------------------------------------------------
{-# 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
    , recompilingUnsafeCompiler
    , unsafeCompiler
    , debugCompiler
    , noResult
    , withErrorMessage
    ) where


--------------------------------------------------------------------------------
import           Control.Monad                 (unless, when, (>=>))
import           Data.Binary                   (Binary)
import           Data.ByteString.Lazy          (ByteString)
import qualified Data.List.NonEmpty            as NonEmpty
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 :: Compiler Identifier
getUnderlying = CompilerRead -> Identifier
compilerUnderlying (CompilerRead -> Identifier)
-> Compiler CompilerRead -> Compiler Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk


--------------------------------------------------------------------------------
-- | Get the extension of the underlying identifier. Returns something like
-- @".html"@
getUnderlyingExtension :: Compiler String
getUnderlyingExtension :: Compiler String
getUnderlyingExtension = String -> String
takeExtension (String -> String)
-> (Identifier -> String) -> Identifier -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> String
toFilePath (Identifier -> String) -> Compiler Identifier -> Compiler String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler Identifier
getUnderlying


--------------------------------------------------------------------------------
-- | Create an item from the underlying identifier and a given value.
makeItem :: a -> Compiler (Item a)
makeItem :: a -> Compiler (Item a)
makeItem a
x = do
    Identifier
identifier <- Compiler Identifier
getUnderlying
    Item a -> Compiler (Item a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Item a -> Compiler (Item a)) -> Item a -> Compiler (Item a)
forall a b. (a -> b) -> a -> b
$ Identifier -> a -> Item a
forall a. Identifier -> a -> Item a
Item Identifier
identifier a
x


--------------------------------------------------------------------------------
-- | Get the route for a specified item
getRoute :: Identifier -> Compiler (Maybe FilePath)
getRoute :: Identifier -> Compiler (Maybe String)
getRoute Identifier
identifier = do
    Provider
provider <- CompilerRead -> Provider
compilerProvider (CompilerRead -> Provider)
-> Compiler CompilerRead -> Compiler Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Routes
routes   <- CompilerRead -> Routes
compilerRoutes (CompilerRead -> Routes)
-> Compiler CompilerRead -> Compiler Routes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
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
    (Maybe String
mfp, UsedMetadata
um) <- IO (Maybe String, UsedMetadata)
-> Compiler (Maybe String, UsedMetadata)
forall a. IO a -> Compiler a
compilerUnsafeIO (IO (Maybe String, UsedMetadata)
 -> Compiler (Maybe String, UsedMetadata))
-> IO (Maybe String, UsedMetadata)
-> Compiler (Maybe String, UsedMetadata)
forall a b. (a -> b) -> a -> b
$ Routes -> Provider -> Identifier -> IO (Maybe String, UsedMetadata)
runRoutes Routes
routes Provider
provider Identifier
identifier
    UsedMetadata -> Compiler () -> Compiler ()
forall (f :: * -> *). Applicative f => UsedMetadata -> f () -> f ()
when UsedMetadata
um (Compiler () -> Compiler ()) -> Compiler () -> Compiler ()
forall a b. (a -> b) -> a -> b
$ [Dependency] -> Compiler ()
compilerTellDependencies [Identifier -> Dependency
IdentifierDependency Identifier
identifier]
    Maybe String -> Compiler (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
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 :: Compiler (Item String)
getResourceBody = (Provider -> Identifier -> IO String) -> Compiler (Item String)
forall a. (Provider -> Identifier -> IO a) -> Compiler (Item a)
getResourceWith Provider -> Identifier -> IO String
resourceBody


--------------------------------------------------------------------------------
-- | Get the full contents of the matched source file as a string.
getResourceString :: Compiler (Item String)
getResourceString :: Compiler (Item String)
getResourceString = (Provider -> Identifier -> IO String) -> Compiler (Item String)
forall a. (Provider -> Identifier -> IO a) -> Compiler (Item a)
getResourceWith Provider -> Identifier -> IO String
resourceString


--------------------------------------------------------------------------------
-- | Get the full contents of the matched source file as a lazy bytestring.
getResourceLBS :: Compiler (Item ByteString)
getResourceLBS :: Compiler (Item ByteString)
getResourceLBS = (Provider -> Identifier -> IO ByteString)
-> Compiler (Item ByteString)
forall a. (Provider -> Identifier -> IO a) -> Compiler (Item a)
getResourceWith Provider -> Identifier -> IO ByteString
resourceLBS


--------------------------------------------------------------------------------
-- | Get the file path of the resource we are compiling
getResourceFilePath :: Compiler FilePath
getResourceFilePath :: Compiler String
getResourceFilePath = do
    Provider
provider <- CompilerRead -> Provider
compilerProvider   (CompilerRead -> Provider)
-> Compiler CompilerRead -> Compiler Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Identifier
id'      <- CompilerRead -> Identifier
compilerUnderlying (CompilerRead -> Identifier)
-> Compiler CompilerRead -> Compiler Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    String -> Compiler String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Compiler String) -> String -> Compiler String
forall a b. (a -> b) -> a -> b
$ Provider -> Identifier -> String
resourceFilePath Provider
provider Identifier
id'


--------------------------------------------------------------------------------
-- | Overloadable function for 'getResourceString' and 'getResourceLBS'
getResourceWith :: (Provider -> Identifier -> IO a) -> Compiler (Item a)
getResourceWith :: (Provider -> Identifier -> IO a) -> Compiler (Item a)
getResourceWith Provider -> Identifier -> IO a
reader = do
    Provider
provider <- CompilerRead -> Provider
compilerProvider   (CompilerRead -> Provider)
-> Compiler CompilerRead -> Compiler Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Identifier
id'      <- CompilerRead -> Identifier
compilerUnderlying (CompilerRead -> Identifier)
-> Compiler CompilerRead -> Compiler Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    let filePath :: String
filePath = Identifier -> String
toFilePath Identifier
id'
    if Provider -> Identifier -> UsedMetadata
resourceExists Provider
provider Identifier
id'
        then IO (Item a) -> Compiler (Item a)
forall a. IO a -> Compiler a
compilerUnsafeIO (IO (Item a) -> Compiler (Item a))
-> IO (Item a) -> Compiler (Item a)
forall a b. (a -> b) -> a -> b
$ Identifier -> a -> Item a
forall a. Identifier -> a -> Item a
Item Identifier
id' (a -> Item a) -> IO a -> IO (Item a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Provider -> Identifier -> IO a
reader Provider
provider Identifier
id'
        else String -> Compiler (Item a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Compiler (Item a)) -> String -> Compiler (Item a)
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
error' String
filePath
  where
    error' :: a -> String
error' a
fp = String
"Hakyll.Core.Compiler.getResourceWith: resource " String -> String -> String
forall a. [a] -> [a] -> [a]
++
        a -> String
forall a. Show a => a -> String
show a
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" 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 :: String -> Item a -> Compiler (Item a)
saveSnapshot String
snapshot Item a
item = do
    Store
store  <- CompilerRead -> Store
compilerStore (CompilerRead -> Store) -> Compiler CompilerRead -> Compiler Store
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Logger
logger <- CompilerRead -> Logger
compilerLogger (CompilerRead -> Logger)
-> Compiler CompilerRead -> Compiler Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    IO () -> Compiler ()
forall a. IO a -> Compiler a
compilerUnsafeIO (IO () -> Compiler ()) -> IO () -> Compiler ()
forall a b. (a -> b) -> a -> b
$ do
        Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Storing snapshot: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
snapshot
        Store -> String -> Item a -> IO ()
forall a.
(Binary a, Typeable a) =>
Store -> String -> Item a -> IO ()
Internal.saveSnapshot Store
store String
snapshot Item a
item

    -- Signal that we saved the snapshot.
    (CompilerRead -> IO (CompilerResult (Item a))) -> Compiler (Item a)
forall a. (CompilerRead -> IO (CompilerResult a)) -> Compiler a
Compiler ((CompilerRead -> IO (CompilerResult (Item a)))
 -> Compiler (Item a))
-> (CompilerRead -> IO (CompilerResult (Item a)))
-> Compiler (Item a)
forall a b. (a -> b) -> a -> b
$ \CompilerRead
_ -> CompilerResult (Item a) -> IO (CompilerResult (Item a))
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerResult (Item a) -> IO (CompilerResult (Item a)))
-> CompilerResult (Item a) -> IO (CompilerResult (Item a))
forall a b. (a -> b) -> a -> b
$ String -> Compiler (Item a) -> CompilerResult (Item a)
forall a. String -> Compiler a -> CompilerResult a
CompilerSnapshot String
snapshot (Item a -> Compiler (Item a)
forall (m :: * -> *) a. Monad m => a -> m a
return Item a
item)


--------------------------------------------------------------------------------
-- | Turn on caching for a compilation value to avoid recomputing it
-- on subsequent Hakyll runs.
-- The storage key consists of the underlying identifier of the compiled
-- ressource and the given name.
cached :: (Binary a, Typeable a)
       => String
       -> Compiler a
       -> Compiler a
cached :: String -> Compiler a -> Compiler a
cached String
name Compiler a
compiler = do
    Identifier
id'      <- CompilerRead -> Identifier
compilerUnderlying (CompilerRead -> Identifier)
-> Compiler CompilerRead -> Compiler Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Store
store    <- CompilerRead -> Store
compilerStore      (CompilerRead -> Store) -> Compiler CompilerRead -> Compiler Store
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Provider
provider <- CompilerRead -> Provider
compilerProvider   (CompilerRead -> Provider)
-> Compiler CompilerRead -> Compiler Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk

    -- Give a better error message when the resource is not there at all.
    UsedMetadata -> Compiler () -> Compiler ()
forall (f :: * -> *). Applicative f => UsedMetadata -> f () -> f ()
unless (Provider -> Identifier -> UsedMetadata
resourceExists Provider
provider Identifier
id') (Compiler () -> Compiler ()) -> Compiler () -> Compiler ()
forall a b. (a -> b) -> a -> b
$ String -> Compiler ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Compiler ()) -> String -> Compiler ()
forall a b. (a -> b) -> a -> b
$ Identifier -> String
forall a. Show a => a -> String
itDoesntEvenExist Identifier
id'

    let modified :: UsedMetadata
modified = Provider -> Identifier -> UsedMetadata
resourceModified Provider
provider Identifier
id'
        k :: [String]
k = [String
name, Identifier -> String
forall a. Show a => a -> String
show Identifier
id']
        go :: Compiler a
go = Compiler a
compiler Compiler a -> (a -> Compiler a) -> Compiler a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
v -> a
v a -> Compiler () -> Compiler a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO () -> Compiler ()
forall a. IO a -> Compiler a
compilerUnsafeIO (Store -> [String] -> a -> IO ()
forall a. (Binary a, Typeable a) => Store -> [String] -> a -> IO ()
Store.set Store
store [String]
k a
v)
    if UsedMetadata
modified
        then Compiler a
go
        else IO (Result a) -> Compiler (Result a)
forall a. IO a -> Compiler a
compilerUnsafeIO (Store -> [String] -> IO (Result a)
forall a.
(Binary a, Typeable a) =>
Store -> [String] -> IO (Result a)
Store.get Store
store [String]
k) Compiler (Result a) -> (Result a -> Compiler a) -> Compiler a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Result a
r -> case Result a
r of
            -- found: report cache hit and return value
            Store.Found a
v   -> a
v a -> Compiler () -> Compiler a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> Compiler ()
compilerTellCacheHits Int
1
            -- not found: unexpected, but recoverable
            Result a
Store.NotFound  -> Compiler a
go
            -- other results: unrecoverable error
            Result a
_               -> String -> Compiler a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Compiler a)
-> (String -> String) -> String -> Compiler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
error' (String -> Compiler a) -> Compiler String -> Compiler a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String -> Compiler String
forall a. IO a -> Compiler a
compilerUnsafeIO IO String
getProgName
  where
    error' :: String -> String
error' String
progName =
        String
"Hakyll.Core.Compiler.cached: Cache corrupt! " String -> String -> String
forall a. [a] -> [a] -> [a]
++
         String
"Try running: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
progName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" clean"

    itDoesntEvenExist :: a -> String
itDoesntEvenExist a
id' =
        String
"Hakyll.Core.Compiler.cached: You are trying to (perhaps "    String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
"indirectly) use `cached` on a non-existing resource: there " String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
"is no file backing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
id'


--------------------------------------------------------------------------------
-- | Run an IO computation without dependencies in a Compiler.
-- You probably want 'recompilingUnsafeCompiler' instead.
unsafeCompiler :: IO a -> Compiler a
unsafeCompiler :: IO a -> Compiler a
unsafeCompiler = IO a -> Compiler a
forall a. IO a -> Compiler a
compilerUnsafeIO

--------------------------------------------------------------------------------
-- | Run an IO computation in a Compiler.  Unlike 'unsafeCompiler',
-- this function will cause the item to be recompiled every time.
recompilingUnsafeCompiler :: IO a -> Compiler a
recompilingUnsafeCompiler :: IO a -> Compiler a
recompilingUnsafeCompiler IO a
io = (CompilerRead -> IO (CompilerResult a)) -> Compiler a
forall a. (CompilerRead -> IO (CompilerResult a)) -> Compiler a
Compiler ((CompilerRead -> IO (CompilerResult a)) -> Compiler a)
-> (CompilerRead -> IO (CompilerResult a)) -> Compiler a
forall a b. (a -> b) -> a -> b
$ \CompilerRead
_ -> do
  a
a <- IO a
io
  CompilerResult a -> IO (CompilerResult a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompilerResult a -> IO (CompilerResult a))
-> CompilerResult a -> IO (CompilerResult a)
forall a b. (a -> b) -> a -> b
$ a -> CompilerWrite -> CompilerResult a
forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone a
a CompilerWrite
forall a. Monoid a => a
mempty { compilerDependencies :: [Dependency]
compilerDependencies = [Dependency
AlwaysOutOfDate] }


--------------------------------------------------------------------------------
-- | Fail so that it is treated as non-defined in an @\$if()\$@ branching
-- "Hakyll.Web.Template" macro, and alternative
-- 'Hakyll.Web.Template.Context.Context's are tried
--
-- @since 4.13.0
noResult :: String -> Compiler a
noResult :: String -> Compiler a
noResult = [String] -> Compiler a
forall a. [String] -> Compiler a
compilerNoResult ([String] -> Compiler a)
-> (String -> [String]) -> String -> Compiler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return


--------------------------------------------------------------------------------
-- | Prepend an error line to the error, if there is one.  This allows you to
-- add helpful context to error messages.
--
-- @since 4.13.0
withErrorMessage :: String -> Compiler a -> Compiler a
withErrorMessage :: String -> Compiler a -> Compiler a
withErrorMessage String
x = do
    Compiler a -> Compiler (Either (CompilerErrors String) a)
forall a. Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry (Compiler a -> Compiler (Either (CompilerErrors String) a))
-> (Either (CompilerErrors String) a -> Compiler a)
-> Compiler a
-> Compiler a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (CompilerErrors String -> Compiler a)
-> (a -> Compiler a)
-> Either (CompilerErrors String) a
-> Compiler a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CompilerResult a -> Compiler a
forall a. CompilerResult a -> Compiler a
compilerResult (CompilerResult a -> Compiler a)
-> (CompilerErrors String -> CompilerResult a)
-> CompilerErrors String
-> Compiler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerErrors String -> CompilerResult a
forall a. CompilerErrors String -> CompilerResult a
CompilerError (CompilerErrors String -> CompilerResult a)
-> (CompilerErrors String -> CompilerErrors String)
-> CompilerErrors String
-> CompilerResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerErrors String -> CompilerErrors String
prepend) a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return
  where
    prepend :: CompilerErrors String -> CompilerErrors String
prepend (CompilationFailure  NonEmpty String
es) = NonEmpty String -> CompilerErrors String
forall a. NonEmpty a -> CompilerErrors a
CompilationFailure  (String
x String -> NonEmpty String -> NonEmpty String
forall a. a -> NonEmpty a -> NonEmpty a
`NonEmpty.cons` NonEmpty String
es)
    prepend (CompilationNoResult [String]
es) = [String] -> CompilerErrors String
forall a. [a] -> CompilerErrors a
CompilationNoResult (String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
es)


--------------------------------------------------------------------------------
-- | Compiler for debugging purposes.
-- Passes a message to the debug logger that is printed in verbose mode.
debugCompiler :: String -> Compiler ()
debugCompiler :: String -> Compiler ()
debugCompiler String
msg = do
    Logger
logger <- CompilerRead -> Logger
compilerLogger (CompilerRead -> Logger)
-> Compiler CompilerRead -> Compiler Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    IO () -> Compiler ()
forall a. IO a -> Compiler a
compilerUnsafeIO (IO () -> Compiler ()) -> IO () -> Compiler ()
forall a b. (a -> b) -> a -> b
$ Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger String
msg