--------------------------------------------------------------------------------
{-# 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 :: forall a. a -> Compiler (Item a)
makeItem a
x = do
    identifier <- Compiler Identifier
getUnderlying
    return $ Item identifier x


--------------------------------------------------------------------------------
-- | Get the route for a specified item
getRoute :: Identifier -> Compiler (Maybe FilePath)
getRoute :: Identifier -> Compiler (Maybe String)
getRoute Identifier
identifier = do
    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   <- 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 :: 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 <- CompilerRead -> Provider
compilerProvider   (CompilerRead -> Provider)
-> Compiler CompilerRead -> Compiler Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    id'      <- compilerUnderlying <$> compilerAsk
    return $ resourceFilePath provider 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 <- CompilerRead -> Provider
compilerProvider   (CompilerRead -> Provider)
-> Compiler CompilerRead -> Compiler Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    id'      <- compilerUnderlying <$> compilerAsk
    let filePath = Identifier -> String
toFilePath Identifier
id'
    if resourceExists provider id'
        then compilerUnsafeIO $ Item id' <$> reader provider id'
        else fail $ error' 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 :: forall a.
(Binary a, Typeable a) =>
String -> Item a -> Compiler (Item a)
saveSnapshot String
snapshot Item a
item = do
    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 <- compilerLogger <$> compilerAsk
    compilerUnsafeIO $ do
        Logger.debug logger $ "Storing snapshot: " ++ snapshot
        Internal.saveSnapshot store snapshot item

    -- Signal that we saved the snapshot.
    Compiler $ \CompilerRead
_ -> CompilerResult (Item a) -> IO (CompilerResult (Item a))
forall a. a -> IO 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 a. a -> Compiler 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 :: forall a.
(Binary a, Typeable a) =>
String -> Compiler a -> Compiler a
cached String
name Compiler a
compiler = do
    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    <- 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 = Provider -> Identifier -> UsedMetadata
resourceModified Provider
provider Identifier
id'
        k = [String
name, Identifier -> String
forall {a}. Show a => a -> String
show Identifier
id']
        go = Compiler a
compiler Compiler a -> (a -> Compiler a) -> Compiler a
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
v -> a
v a -> Compiler () -> Compiler a
forall a b. a -> Compiler b -> 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 modified
        then go
        else compilerUnsafeIO (Store.get store k) >>= \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 a b. a -> Compiler b -> 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 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 :: forall a. 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 :: forall a. 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 <- IO a
io
  pure $ CompilerDone a mempty { compilerDependencies = [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 = [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 a. a -> [a]
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
    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 a. 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 <- CompilerRead -> Logger
compilerLogger (CompilerRead -> Logger)
-> Compiler CompilerRead -> Compiler Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    compilerUnsafeIO $ Logger.debug logger msg