--------------------------------------------------------------------------------
-- | Internally used compiler module
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
module Hakyll.Core.Compiler.Internal
    ( -- * Types
      Snapshot
    , CompilerRead (..)
    , CompilerWrite (..)
    , CompilerErrors (..)
    , CompilerResult (..)
    , Compiler (..)
    , runCompiler

      -- * Core operations
    , compilerResult
    , compilerTell
    , compilerAsk
    , compilerUnsafeIO

      -- * Error operations
    , compilerThrow
    , compilerNoResult
    , compilerCatch
    , compilerTry
    , compilerErrorMessages

      -- * Utilities
    , compilerDebugEntries
    , compilerTellDependencies
    , compilerTellCacheHits
    ) where


--------------------------------------------------------------------------------
import           Control.Applicative            (Alternative (..))
import           Control.Exception              (SomeException, handle)
import           Control.Monad                  (forM_)
import qualified Control.Monad.Fail             as Fail
import           Control.Monad.Except           (MonadError (..))
import           Data.List.NonEmpty             (NonEmpty (..))
import qualified Data.List.NonEmpty             as NonEmpty
import           Data.Set                       (Set)
import qualified Data.Set                       as S


--------------------------------------------------------------------------------
import           Hakyll.Core.Configuration
import           Hakyll.Core.Dependencies
import           Hakyll.Core.Identifier
import           Hakyll.Core.Identifier.Pattern
import qualified Hakyll.Core.Logger             as Logger
import           Hakyll.Core.Metadata
import           Hakyll.Core.Provider
import           Hakyll.Core.Routes
import           Hakyll.Core.Store


--------------------------------------------------------------------------------
-- | Whilst compiling an item, it possible to save multiple snapshots of it, and
-- not just the final result.
type Snapshot = String


--------------------------------------------------------------------------------
-- | Environment in which a compiler runs
data CompilerRead = CompilerRead
    { -- | Main configuration
      CompilerRead -> Configuration
compilerConfig     :: Configuration
    , -- | Underlying identifier
      CompilerRead -> Identifier
compilerUnderlying :: Identifier
    , -- | Resource provider
      CompilerRead -> Provider
compilerProvider   :: Provider
    , -- | List of all known identifiers
      CompilerRead -> Set Identifier
compilerUniverse   :: Set Identifier
    , -- | Site routes
      CompilerRead -> Routes
compilerRoutes     :: Routes
    , -- | Compiler store
      CompilerRead -> Store
compilerStore      :: Store
    , -- | Logger
      CompilerRead -> Logger
compilerLogger     :: Logger.Logger
    }


--------------------------------------------------------------------------------
data CompilerWrite = CompilerWrite
    { CompilerWrite -> [Dependency]
compilerDependencies :: [Dependency]
    , CompilerWrite -> Int
compilerCacheHits    :: Int
    } deriving (Int -> CompilerWrite -> ShowS
[CompilerWrite] -> ShowS
CompilerWrite -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilerWrite] -> ShowS
$cshowList :: [CompilerWrite] -> ShowS
show :: CompilerWrite -> String
$cshow :: CompilerWrite -> String
showsPrec :: Int -> CompilerWrite -> ShowS
$cshowsPrec :: Int -> CompilerWrite -> ShowS
Show)


--------------------------------------------------------------------------------
instance Semigroup CompilerWrite where
    <> :: CompilerWrite -> CompilerWrite -> CompilerWrite
(<>) (CompilerWrite [Dependency]
d1 Int
h1) (CompilerWrite [Dependency]
d2 Int
h2) =
        [Dependency] -> Int -> CompilerWrite
CompilerWrite ([Dependency]
d1 forall a. [a] -> [a] -> [a]
++ [Dependency]
d2) (Int
h1 forall a. Num a => a -> a -> a
+ Int
h2)

instance Monoid CompilerWrite where
    mempty :: CompilerWrite
mempty  = [Dependency] -> Int -> CompilerWrite
CompilerWrite [] Int
0
    mappend :: CompilerWrite -> CompilerWrite -> CompilerWrite
mappend = forall a. Semigroup a => a -> a -> a
(<>)


--------------------------------------------------------------------------------
-- | Distinguishes reasons in a 'CompilerError'
data CompilerErrors a
    -- | One or more exceptions occured during compilation
    = CompilationFailure (NonEmpty a)
    -- | Absence of any result, most notably in template contexts.  May still
    -- have error messages.
    | CompilationNoResult [a]
    deriving forall a b. a -> CompilerErrors b -> CompilerErrors a
forall a b. (a -> b) -> CompilerErrors a -> CompilerErrors b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CompilerErrors b -> CompilerErrors a
$c<$ :: forall a b. a -> CompilerErrors b -> CompilerErrors a
fmap :: forall a b. (a -> b) -> CompilerErrors a -> CompilerErrors b
$cfmap :: forall a b. (a -> b) -> CompilerErrors a -> CompilerErrors b
Functor


-- | Unwrap a `CompilerErrors`
compilerErrorMessages :: CompilerErrors a -> [a]
compilerErrorMessages :: forall a. CompilerErrors a -> [a]
compilerErrorMessages (CompilationFailure NonEmpty a
x)  = forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty a
x
compilerErrorMessages (CompilationNoResult [a]
x) = [a]
x


--------------------------------------------------------------------------------
-- | An intermediate result of a compilation step
data CompilerResult a
    = CompilerDone a CompilerWrite
    | CompilerSnapshot Snapshot (Compiler a)
    | CompilerRequire [(Identifier, Snapshot)] (Compiler a)
    | CompilerError (CompilerErrors String)


--------------------------------------------------------------------------------
-- | A monad which lets you compile items and takes care of dependency tracking
-- for you.
newtype Compiler a = Compiler
    { forall a. Compiler a -> CompilerRead -> IO (CompilerResult a)
unCompiler :: CompilerRead -> IO (CompilerResult a)
    }


--------------------------------------------------------------------------------
instance Functor Compiler where
    fmap :: forall a b. (a -> b) -> Compiler a -> Compiler b
fmap a -> b
f (Compiler CompilerRead -> IO (CompilerResult a)
c) = forall a. (CompilerRead -> IO (CompilerResult a)) -> Compiler a
Compiler forall a b. (a -> b) -> a -> b
$ \CompilerRead
r -> do
        CompilerResult a
res <- CompilerRead -> IO (CompilerResult a)
c CompilerRead
r
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case CompilerResult a
res of
            CompilerDone a
x CompilerWrite
w      -> forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone (a -> b
f a
x) CompilerWrite
w
            CompilerSnapshot String
s Compiler a
c' -> forall a. String -> Compiler a -> CompilerResult a
CompilerSnapshot String
s (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Compiler a
c')
            CompilerRequire [(Identifier, String)]
i Compiler a
c'  -> forall a. [(Identifier, String)] -> Compiler a -> CompilerResult a
CompilerRequire [(Identifier, String)]
i (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Compiler a
c')
            CompilerError CompilerErrors String
e       -> forall a. CompilerErrors String -> CompilerResult a
CompilerError CompilerErrors String
e
    {-# INLINE fmap #-}


--------------------------------------------------------------------------------
instance Monad Compiler where
    return :: forall a. a -> Compiler a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}

    Compiler CompilerRead -> IO (CompilerResult a)
c >>= :: forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
>>= a -> Compiler b
f = forall a. (CompilerRead -> IO (CompilerResult a)) -> Compiler a
Compiler forall a b. (a -> b) -> a -> b
$ \CompilerRead
r -> do
        CompilerResult a
res <- CompilerRead -> IO (CompilerResult a)
c CompilerRead
r
        case CompilerResult a
res of
            CompilerDone a
x CompilerWrite
w    -> do
                CompilerResult b
res' <- forall a. Compiler a -> CompilerRead -> IO (CompilerResult a)
unCompiler (a -> Compiler b
f a
x) CompilerRead
r
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case CompilerResult b
res' of
                    CompilerDone b
y CompilerWrite
w'     -> forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone b
y (CompilerWrite
w forall a. Monoid a => a -> a -> a
`mappend` CompilerWrite
w')
                    CompilerSnapshot String
s Compiler b
c' -> forall a. String -> Compiler a -> CompilerResult a
CompilerSnapshot String
s forall a b. (a -> b) -> a -> b
$ do
                        CompilerWrite -> Compiler ()
compilerTell CompilerWrite
w  -- Save dependencies!
                        Compiler b
c'
                    CompilerRequire [(Identifier, String)]
i Compiler b
c'  -> forall a. [(Identifier, String)] -> Compiler a -> CompilerResult a
CompilerRequire [(Identifier, String)]
i forall a b. (a -> b) -> a -> b
$ do
                        CompilerWrite -> Compiler ()
compilerTell CompilerWrite
w  -- Save dependencies!
                        Compiler b
c'
                    CompilerError CompilerErrors String
e       -> forall a. CompilerErrors String -> CompilerResult a
CompilerError CompilerErrors String
e

            CompilerSnapshot String
s Compiler a
c' -> 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
s (Compiler a
c' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Compiler b
f)
            CompilerRequire [(Identifier, String)]
i Compiler a
c'  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [(Identifier, String)] -> Compiler a -> CompilerResult a
CompilerRequire [(Identifier, String)]
i (Compiler a
c' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Compiler b
f)
            CompilerError CompilerErrors String
e       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. CompilerErrors String -> CompilerResult a
CompilerError CompilerErrors String
e
    {-# INLINE (>>=) #-}

#if !(MIN_VERSION_base(4,13,0))
    fail = Fail.fail
    {-# INLINE fail #-}
#endif

instance Fail.MonadFail Compiler where
    fail :: forall a. String -> Compiler a
fail = forall a. [String] -> Compiler a
compilerThrow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
    {-# INLINE fail #-}

--------------------------------------------------------------------------------
instance Applicative Compiler where
    pure :: forall a. a -> Compiler a
pure a
x = forall a. CompilerResult a -> Compiler a
compilerResult forall a b. (a -> b) -> a -> b
$ forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone a
x forall a. Monoid a => a
mempty
    {-# INLINE pure #-}

    Compiler (a -> b)
f <*> :: forall a b. Compiler (a -> b) -> Compiler a -> Compiler b
<*> Compiler a
x = Compiler (a -> b)
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a -> b
f' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f' Compiler a
x
    {-# INLINE (<*>) #-}


--------------------------------------------------------------------------------
-- | Access provided metadata from anywhere
instance MonadMetadata Compiler where
    getMetadata :: Identifier -> Compiler Metadata
getMetadata = Identifier -> Compiler Metadata
compilerGetMetadata
    getMatches :: Pattern -> Compiler [Identifier]
getMatches  = Pattern -> Compiler [Identifier]
compilerGetMatches


--------------------------------------------------------------------------------
-- | Compilation may fail with multiple error messages.
-- 'catchError' handles errors from 'throwError', 'fail' and 'Hakyll.Core.Compiler.noResult'
instance MonadError [String] Compiler where
    throwError :: forall a. [String] -> Compiler a
throwError = forall a. [String] -> Compiler a
compilerThrow
    catchError :: forall a. Compiler a -> ([String] -> Compiler a) -> Compiler a
catchError Compiler a
c = forall a.
Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
compilerCatch Compiler a
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CompilerErrors a -> [a]
compilerErrorMessages)


--------------------------------------------------------------------------------
-- | Like 'unCompiler' but treating IO exceptions as 'CompilerError's
runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)
runCompiler :: forall a. Compiler a -> CompilerRead -> IO (CompilerResult a)
runCompiler Compiler a
compiler CompilerRead
read' = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall a. SomeException -> IO (CompilerResult a)
handler forall a b. (a -> b) -> a -> b
$ forall a. Compiler a -> CompilerRead -> IO (CompilerResult a)
unCompiler Compiler a
compiler CompilerRead
read'
  where
    handler :: SomeException -> IO (CompilerResult a)
    handler :: forall a. SomeException -> IO (CompilerResult a)
handler SomeException
e = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. CompilerErrors String -> CompilerResult a
CompilerError forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> CompilerErrors a
CompilationFailure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show SomeException
e forall a. a -> [a] -> NonEmpty a
:| []


--------------------------------------------------------------------------------
-- | Trying alternative compilers if the first fails, regardless whether through
-- 'fail', 'throwError' or 'Hakyll.Core.Compiler.noResult'.
-- Aggregates error messages if all fail.
instance Alternative Compiler where
    empty :: forall a. Compiler a
empty   = forall a. [String] -> Compiler a
compilerNoResult []
    Compiler a
x <|> :: forall a. Compiler a -> Compiler a -> Compiler a
<|> Compiler a
y = Compiler a
x forall a.
Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
`compilerCatch` (\CompilerErrors String
rx -> Compiler a
y forall a.
Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
`compilerCatch` (\CompilerErrors String
ry ->
        case (CompilerErrors String
rx, CompilerErrors String
ry) of
          (CompilationFailure NonEmpty String
xs,  CompilationFailure NonEmpty String
ys)  ->
            forall a. [String] -> Compiler a
compilerThrow forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
xs forall a. [a] -> [a] -> [a]
++ forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
ys
          (CompilationFailure NonEmpty String
xs,  CompilationNoResult [String]
ys) ->
            [String] -> Compiler ()
debug [String]
ys forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. [String] -> Compiler a
compilerThrow (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
xs)
          (CompilationNoResult [String]
xs, CompilationFailure NonEmpty String
ys)  ->
            [String] -> Compiler ()
debug [String]
xs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. [String] -> Compiler a
compilerThrow (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
ys)
          (CompilationNoResult [String]
xs, CompilationNoResult [String]
ys) -> forall a. [String] -> Compiler a
compilerNoResult forall a b. (a -> b) -> a -> b
$ [String]
xs forall a. [a] -> [a] -> [a]
++ [String]
ys
        ))
      where
        debug :: [String] -> Compiler ()
debug = String -> [String] -> Compiler ()
compilerDebugEntries String
"Hakyll.Core.Compiler.Internal: Alternative fail suppressed"
    {-# INLINE (<|>) #-}


--------------------------------------------------------------------------------
-- | Put the result back in a compiler
compilerResult :: CompilerResult a -> Compiler a
compilerResult :: forall a. CompilerResult a -> Compiler a
compilerResult CompilerResult a
x = 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 CompilerResult a
x
{-# INLINE compilerResult #-}


--------------------------------------------------------------------------------
-- | Get the current environment
compilerAsk :: Compiler CompilerRead
compilerAsk :: Compiler CompilerRead
compilerAsk = forall a. (CompilerRead -> IO (CompilerResult a)) -> Compiler a
Compiler forall a b. (a -> b) -> a -> b
$ \CompilerRead
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone CompilerRead
r forall a. Monoid a => a
mempty
{-# INLINE compilerAsk #-}


--------------------------------------------------------------------------------
-- | Put a 'CompilerWrite'
compilerTell :: CompilerWrite -> Compiler ()
compilerTell :: CompilerWrite -> Compiler ()
compilerTell = forall a. CompilerResult a -> Compiler a
compilerResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone ()
{-# INLINE compilerTell #-}


--------------------------------------------------------------------------------
-- | Run an IO computation without dependencies in a Compiler
compilerUnsafeIO :: IO a -> Compiler a
compilerUnsafeIO :: forall a. IO a -> Compiler a
compilerUnsafeIO IO a
io = forall a. (CompilerRead -> IO (CompilerResult a)) -> Compiler a
Compiler forall a b. (a -> b) -> a -> b
$ \CompilerRead
_ -> do
    a
x <- IO a
io
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone a
x forall a. Monoid a => a
mempty
{-# INLINE compilerUnsafeIO #-}


--------------------------------------------------------------------------------
-- | Throw errors in the 'Compiler'.
--
-- If no messages are given, this is considered a 'CompilationNoResult' error.
-- Otherwise, it is treated as a proper compilation failure.
compilerThrow :: [String] -> Compiler a
compilerThrow :: forall a. [String] -> Compiler a
compilerThrow = 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
.
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. [a] -> CompilerErrors a
CompilationNoResult []) forall a. NonEmpty a -> CompilerErrors a
CompilationFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty

-- | Put a 'CompilerError' with  multiple messages as 'CompilationNoResult'
compilerNoResult :: [String] -> Compiler a
compilerNoResult :: forall a. [String] -> Compiler a
compilerNoResult = 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
. forall a. [a] -> CompilerErrors a
CompilationNoResult


--------------------------------------------------------------------------------
-- | Allows to distinguish 'CompilerError's and branch on them with 'Either'
--
-- prop> compilerTry = (`compilerCatch` return . Left) . fmap Right
compilerTry :: Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry :: forall a. Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry (Compiler CompilerRead -> IO (CompilerResult a)
x) = forall a. (CompilerRead -> IO (CompilerResult a)) -> Compiler a
Compiler forall a b. (a -> b) -> a -> b
$ \CompilerRead
r -> do
    CompilerResult a
res <- CompilerRead -> IO (CompilerResult a)
x CompilerRead
r
    case CompilerResult a
res of
        CompilerDone a
res' CompilerWrite
w  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone (forall a b. b -> Either a b
Right a
res') CompilerWrite
w)
        CompilerSnapshot String
s Compiler a
c -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. String -> Compiler a -> CompilerResult a
CompilerSnapshot String
s (forall a. Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry Compiler a
c))
        CompilerRequire [(Identifier, String)]
i Compiler a
c  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [(Identifier, String)] -> Compiler a -> CompilerResult a
CompilerRequire [(Identifier, String)]
i (forall a. Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry Compiler a
c))
        CompilerError CompilerErrors String
e      -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone (forall a b. a -> Either a b
Left CompilerErrors String
e) forall a. Monoid a => a
mempty)
{-# INLINE compilerTry #-}


--------------------------------------------------------------------------------
-- | Allows you to recover from 'CompilerError's.
-- Uses the same parameter order as 'catchError' so that it can be used infix.
--
-- prop> c `compilerCatch` f = compilerTry c >>= either f return
compilerCatch :: Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
compilerCatch :: forall a.
Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
compilerCatch (Compiler CompilerRead -> IO (CompilerResult a)
x) CompilerErrors String -> Compiler a
f = forall a. (CompilerRead -> IO (CompilerResult a)) -> Compiler a
Compiler forall a b. (a -> b) -> a -> b
$ \CompilerRead
r -> do
    CompilerResult a
res <- CompilerRead -> IO (CompilerResult a)
x CompilerRead
r
    case CompilerResult a
res of
        CompilerDone a
res' CompilerWrite
w  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone a
res' CompilerWrite
w)
        CompilerSnapshot String
s Compiler a
c -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. String -> Compiler a -> CompilerResult a
CompilerSnapshot String
s (forall a.
Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
compilerCatch Compiler a
c CompilerErrors String -> Compiler a
f))
        CompilerRequire [(Identifier, String)]
i Compiler a
c  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [(Identifier, String)] -> Compiler a -> CompilerResult a
CompilerRequire [(Identifier, String)]
i (forall a.
Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
compilerCatch Compiler a
c CompilerErrors String -> Compiler a
f))
        CompilerError CompilerErrors String
e      -> forall a. Compiler a -> CompilerRead -> IO (CompilerResult a)
unCompiler (CompilerErrors String -> Compiler a
f CompilerErrors String
e) CompilerRead
r
{-# INLINE compilerCatch #-}


--------------------------------------------------------------------------------
compilerDebugLog :: [String] -> Compiler ()
compilerDebugLog :: [String] -> Compiler ()
compilerDebugLog [String]
ms = 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 (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
ms forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger

--------------------------------------------------------------------------------
-- | Pass a list of messages with a heading to the debug logger
compilerDebugEntries :: String -> [String] -> Compiler ()
compilerDebugEntries :: String -> [String] -> Compiler ()
compilerDebugEntries String
msg = [String] -> Compiler ()
compilerDebugLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
msgforall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ShowS
indent
  where
    indent :: ShowS
indent = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String
"    "forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines


--------------------------------------------------------------------------------
compilerTellDependencies :: [Dependency] -> Compiler ()
compilerTellDependencies :: [Dependency] -> Compiler ()
compilerTellDependencies [Dependency]
ds = do
  [String] -> Compiler ()
compilerDebugLog forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Dependency
d ->
      String
"Hakyll.Core.Compiler.Internal: Adding dependency: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Dependency
d) [Dependency]
ds
  CompilerWrite -> Compiler ()
compilerTell forall a. Monoid a => a
mempty {compilerDependencies :: [Dependency]
compilerDependencies = [Dependency]
ds}
{-# INLINE compilerTellDependencies #-}


--------------------------------------------------------------------------------
compilerTellCacheHits :: Int -> Compiler ()
compilerTellCacheHits :: Int -> Compiler ()
compilerTellCacheHits Int
ch = CompilerWrite -> Compiler ()
compilerTell forall a. Monoid a => a
mempty {compilerCacheHits :: Int
compilerCacheHits = Int
ch}
{-# INLINE compilerTellCacheHits #-}


--------------------------------------------------------------------------------
compilerGetMetadata :: Identifier -> Compiler Metadata
compilerGetMetadata :: Identifier -> Compiler Metadata
compilerGetMetadata Identifier
identifier = do
    Provider
provider <- CompilerRead -> Provider
compilerProvider forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    [Dependency] -> Compiler ()
compilerTellDependencies [Identifier -> Dependency
IdentifierDependency Identifier
identifier]
    forall a. IO a -> Compiler a
compilerUnsafeIO forall a b. (a -> b) -> a -> b
$ Provider -> Identifier -> IO Metadata
resourceMetadata Provider
provider Identifier
identifier


--------------------------------------------------------------------------------
compilerGetMatches :: Pattern -> Compiler [Identifier]
compilerGetMatches :: Pattern -> Compiler [Identifier]
compilerGetMatches Pattern
pattern = do
    Set Identifier
universe <- CompilerRead -> Set Identifier
compilerUniverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    let matching :: Set Identifier
matching = forall a. (a -> Bool) -> Set a -> Set a
S.filter (Pattern -> Identifier -> Bool
matches Pattern
pattern) Set Identifier
universe
    [Dependency] -> Compiler ()
compilerTellDependencies [Pattern -> Set Identifier -> Dependency
PatternDependency Pattern
pattern Set Identifier
matching]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set Identifier
matching