--------------------------------------------------------------------------------
{-# 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> String
toFilePath 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 :: forall a. a -> Compiler (Item a)
makeItem a
x = do
    Identifier
identifier <- Compiler Identifier
getUnderlying
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Routes
routes   <- CompilerRead -> Routes
compilerRoutes 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) <- forall a. IO a -> Compiler a
compilerUnsafeIO forall a b. (a -> b) -> a -> b
$ Routes -> Provider -> Identifier -> IO (Maybe String, UsedMetadata)
runRoutes Routes
routes Provider
provider Identifier
identifier
    forall (f :: * -> *). Applicative f => UsedMetadata -> f () -> f ()
when UsedMetadata
um forall a b. (a -> b) -> a -> b
$ [Dependency] -> Compiler ()
compilerTellDependencies [Identifier -> Dependency
IdentifierDependency Identifier
identifier]
    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 = 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 = 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 = 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   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Identifier
id'      <- CompilerRead -> Identifier
compilerUnderlying forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall a. (Provider -> Identifier -> IO a) -> Compiler (Item a)
getResourceWith Provider -> Identifier -> IO a
reader = do
    Provider
provider <- CompilerRead -> Provider
compilerProvider   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Identifier
id'      <- CompilerRead -> Identifier
compilerUnderlying 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 forall a. IO a -> Compiler a
compilerUnsafeIO forall a b. (a -> b) -> a -> b
$ forall a. Identifier -> a -> Item a
Item Identifier
id' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Provider -> Identifier -> IO a
reader Provider
provider Identifier
id'
        else forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => a -> String
error' String
filePath
  where
    error' :: a -> String
error' a
fp = String
"Hakyll.Core.Compiler.getResourceWith: resource " forall a. [a] -> [a] -> [a]
++
        forall {a}. Show a => a -> String
show a
fp 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 :: forall a.
(Binary a, Typeable a) =>
String -> Item a -> Compiler (Item a)
saveSnapshot String
snapshot Item a
item = do
    Store
store  <- CompilerRead -> Store
compilerStore forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Logger
logger <- CompilerRead -> Logger
compilerLogger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    forall a. IO a -> Compiler a
compilerUnsafeIO forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger forall a b. (a -> b) -> a -> b
$ String
"Storing snapshot: " forall a. [a] -> [a] -> [a]
++ String
snapshot
        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.
    forall a. (CompilerRead -> IO (CompilerResult a)) -> Compiler a
Compiler forall a b. (a -> b) -> a -> b
$ \CompilerRead
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. String -> Compiler a -> CompilerResult a
CompilerSnapshot String
snapshot (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 :: forall a.
(Binary a, Typeable a) =>
String -> Compiler a -> Compiler a
cached String
name Compiler a
compiler = do
    Identifier
id'      <- CompilerRead -> Identifier
compilerUnderlying forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Store
store    <- CompilerRead -> Store
compilerStore      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Provider
provider <- CompilerRead -> Provider
compilerProvider   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.
    forall (f :: * -> *). Applicative f => UsedMetadata -> f () -> f ()
unless (Provider -> Identifier -> UsedMetadata
resourceExists Provider
provider Identifier
id') forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ 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, forall {a}. Show a => a -> String
show Identifier
id']
        go :: Compiler a
go = Compiler a
compiler forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
v -> a
v forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. IO a -> Compiler a
compilerUnsafeIO (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 forall a. IO a -> Compiler a
compilerUnsafeIO (forall a.
(Binary a, Typeable a) =>
Store -> [String] -> IO (Result a)
Store.get Store
store [String]
k) 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 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
_               -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
error' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO a -> Compiler a
compilerUnsafeIO IO String
getProgName
  where
    error' :: String -> String
error' String
progName =
        String
"Hakyll.Core.Compiler.cached: Cache corrupt! " forall a. [a] -> [a] -> [a]
++
         String
"Try running: " forall a. [a] -> [a] -> [a]
++ String
progName forall a. [a] -> [a] -> [a]
++ String
" clean"

    itDoesntEvenExist :: a -> String
itDoesntEvenExist a
id' =
        String
"Hakyll.Core.Compiler.cached: You are trying to (perhaps "    forall a. [a] -> [a] -> [a]
++
        String
"indirectly) use `cached` on a non-existing resource: there " forall a. [a] -> [a] -> [a]
++
        String
"is no file backing " forall a. [a] -> [a] -> [a]
++ 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 :: forall a. IO a -> Compiler a
unsafeCompiler = 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 :: forall a. IO a -> Compiler a
recompilingUnsafeCompiler IO a
io = forall a. (CompilerRead -> IO (CompilerResult a)) -> Compiler a
Compiler forall a b. (a -> b) -> a -> b
$ \CompilerRead
_ -> do
  a
a <- IO a
io
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone a
a 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 :: forall a. String -> Compiler a
noResult = forall a. [String] -> Compiler a
compilerNoResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. String -> Compiler a -> Compiler a
withErrorMessage String
x = do
    forall a. Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. CompilerResult a -> Compiler a
compilerResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CompilerErrors String -> CompilerResult a
CompilerError forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerErrors String -> CompilerErrors String
prepend) forall (m :: * -> *) a. Monad m => a -> m a
return
  where
    prepend :: CompilerErrors String -> CompilerErrors String
prepend (CompilationFailure  NonEmpty String
es) = forall a. NonEmpty a -> CompilerErrors a
CompilationFailure  (String
x forall a. a -> NonEmpty a -> NonEmpty a
`NonEmpty.cons` NonEmpty String
es)
    prepend (CompilationNoResult [String]
es) = forall a. [a] -> CompilerErrors a
CompilationNoResult (String
x 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    forall a. IO a -> Compiler a
compilerUnsafeIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger String
msg