--------------------------------------------------------------------------------
-- | 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
#if MIN_VERSION_base(4,9,0)
import           Data.Semigroup                 (Semigroup (..))
#endif
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
(Int -> CompilerWrite -> ShowS)
-> (CompilerWrite -> String)
-> ([CompilerWrite] -> ShowS)
-> Show CompilerWrite
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)


--------------------------------------------------------------------------------
#if MIN_VERSION_base(4,9,0)
instance Semigroup CompilerWrite where
    <> :: CompilerWrite -> CompilerWrite -> CompilerWrite
(<>) (CompilerWrite [Dependency]
d1 Int
h1) (CompilerWrite [Dependency]
d2 Int
h2) =
        [Dependency] -> Int -> CompilerWrite
CompilerWrite ([Dependency]
d1 [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++ [Dependency]
d2) (Int
h1 Int -> Int -> Int
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 = CompilerWrite -> CompilerWrite -> CompilerWrite
forall a. Semigroup a => a -> a -> a
(<>)
#else
instance Monoid CompilerWrite where
    mempty = CompilerWrite [] 0
    mappend (CompilerWrite d1 h1) (CompilerWrite d2 h2) =
        CompilerWrite (d1 ++ d2) (h1 + h2)
#endif


--------------------------------------------------------------------------------
-- | 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 a -> CompilerErrors b -> CompilerErrors a
(a -> b) -> CompilerErrors a -> CompilerErrors b
(forall a b. (a -> b) -> CompilerErrors a -> CompilerErrors b)
-> (forall a b. a -> CompilerErrors b -> CompilerErrors a)
-> Functor CompilerErrors
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
<$ :: a -> CompilerErrors b -> CompilerErrors a
$c<$ :: forall a b. a -> CompilerErrors b -> CompilerErrors a
fmap :: (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 :: CompilerErrors a -> [a]
compilerErrorMessages (CompilationFailure NonEmpty a
x)  = NonEmpty a -> [a]
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
    { Compiler a -> CompilerRead -> IO (CompilerResult a)
unCompiler :: CompilerRead -> IO (CompilerResult a)
    }


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


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

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

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

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

    Compiler (a -> b)
f <*> :: Compiler (a -> b) -> Compiler a -> Compiler b
<*> Compiler a
x = Compiler (a -> b)
f Compiler (a -> b) -> ((a -> b) -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a -> b
f' -> (a -> b) -> Compiler a -> Compiler b
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 :: [String] -> Compiler a
throwError = [String] -> Compiler a
forall a. [String] -> Compiler a
compilerThrow
    catchError :: Compiler a -> ([String] -> Compiler a) -> Compiler a
catchError Compiler a
c = Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
forall a.
Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
compilerCatch Compiler a
c ((CompilerErrors String -> Compiler a) -> Compiler a)
-> (([String] -> Compiler a)
    -> CompilerErrors String -> Compiler a)
-> ([String] -> Compiler a)
-> Compiler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String] -> Compiler a)
-> (CompilerErrors String -> [String])
-> CompilerErrors String
-> Compiler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerErrors String -> [String]
forall a. CompilerErrors a -> [a]
compilerErrorMessages)


--------------------------------------------------------------------------------
-- | Like 'unCompiler' but treating IO exceptions as 'CompilerError's
runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)
runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)
runCompiler Compiler a
compiler CompilerRead
read' = (SomeException -> IO (CompilerResult a))
-> IO (CompilerResult a) -> IO (CompilerResult a)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO (CompilerResult a)
forall a. SomeException -> IO (CompilerResult a)
handler (IO (CompilerResult a) -> IO (CompilerResult a))
-> IO (CompilerResult a) -> IO (CompilerResult a)
forall a b. (a -> b) -> a -> b
$ Compiler a -> CompilerRead -> IO (CompilerResult a)
forall a. Compiler a -> CompilerRead -> IO (CompilerResult a)
unCompiler Compiler a
compiler CompilerRead
read'
  where
    handler :: SomeException -> IO (CompilerResult a)
    handler :: SomeException -> IO (CompilerResult a)
handler SomeException
e = CompilerResult a -> IO (CompilerResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerResult a -> IO (CompilerResult a))
-> CompilerResult a -> IO (CompilerResult a)
forall a b. (a -> b) -> a -> b
$ CompilerErrors String -> CompilerResult a
forall a. CompilerErrors String -> CompilerResult a
CompilerError (CompilerErrors String -> CompilerResult a)
-> CompilerErrors String -> CompilerResult a
forall a b. (a -> b) -> a -> b
$ NonEmpty String -> CompilerErrors String
forall a. NonEmpty a -> CompilerErrors a
CompilationFailure (NonEmpty String -> CompilerErrors String)
-> NonEmpty String -> CompilerErrors String
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e String -> [String] -> NonEmpty String
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 :: Compiler a
empty   = [String] -> Compiler a
forall a. [String] -> Compiler a
compilerNoResult []
    Compiler a
x <|> :: Compiler a -> Compiler a -> Compiler a
<|> Compiler a
y = Compiler a
x Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
forall a.
Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
`compilerCatch` (\CompilerErrors String
rx -> Compiler a
y Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
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)  ->
            [String] -> Compiler a
forall a. [String] -> Compiler a
compilerThrow ([String] -> Compiler a) -> [String] -> Compiler a
forall a b. (a -> b) -> a -> b
$ NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
ys
          (CompilationFailure NonEmpty String
xs,  CompilationNoResult [String]
ys) ->
            [String] -> Compiler ()
debug [String]
ys Compiler () -> Compiler a -> Compiler a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> Compiler a
forall a. [String] -> Compiler a
compilerThrow (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
xs)
          (CompilationNoResult [String]
xs, CompilationFailure NonEmpty String
ys)  ->
            [String] -> Compiler ()
debug [String]
xs Compiler () -> Compiler a -> Compiler a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> Compiler a
forall a. [String] -> Compiler a
compilerThrow (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
ys)
          (CompilationNoResult [String]
xs, CompilationNoResult [String]
ys) -> [String] -> Compiler a
forall a. [String] -> Compiler a
compilerNoResult ([String] -> Compiler a) -> [String] -> Compiler a
forall a b. (a -> b) -> a -> b
$ [String]
xs [String] -> [String] -> [String]
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 :: CompilerResult a -> Compiler a
compilerResult CompilerResult a
x = (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
_ -> CompilerResult a -> IO (CompilerResult a)
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 = (CompilerRead -> IO (CompilerResult CompilerRead))
-> Compiler CompilerRead
forall a. (CompilerRead -> IO (CompilerResult a)) -> Compiler a
Compiler ((CompilerRead -> IO (CompilerResult CompilerRead))
 -> Compiler CompilerRead)
-> (CompilerRead -> IO (CompilerResult CompilerRead))
-> Compiler CompilerRead
forall a b. (a -> b) -> a -> b
$ \CompilerRead
r -> CompilerResult CompilerRead -> IO (CompilerResult CompilerRead)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerResult CompilerRead -> IO (CompilerResult CompilerRead))
-> CompilerResult CompilerRead -> IO (CompilerResult CompilerRead)
forall a b. (a -> b) -> a -> b
$ CompilerRead -> CompilerWrite -> CompilerResult CompilerRead
forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone CompilerRead
r CompilerWrite
forall a. Monoid a => a
mempty
{-# INLINE compilerAsk #-}


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


--------------------------------------------------------------------------------
-- | Run an IO computation without dependencies in a Compiler
compilerUnsafeIO :: IO a -> Compiler a
compilerUnsafeIO :: IO a -> Compiler a
compilerUnsafeIO 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
x <- IO a
io
    CompilerResult a -> IO (CompilerResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (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
x CompilerWrite
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 :: [String] -> Compiler a
compilerThrow = CompilerResult a -> Compiler a
forall a. CompilerResult a -> Compiler a
compilerResult (CompilerResult a -> Compiler a)
-> ([String] -> CompilerResult a) -> [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)
-> ([String] -> CompilerErrors String)
-> [String]
-> CompilerResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    CompilerErrors String
-> (NonEmpty String -> CompilerErrors String)
-> Maybe (NonEmpty String)
-> CompilerErrors String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> CompilerErrors String
forall a. [a] -> CompilerErrors a
CompilationNoResult []) NonEmpty String -> CompilerErrors String
forall a. NonEmpty a -> CompilerErrors a
CompilationFailure (Maybe (NonEmpty String) -> CompilerErrors String)
-> ([String] -> Maybe (NonEmpty String))
-> [String]
-> CompilerErrors String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty

-- | Put a 'CompilerError' with  multiple messages as 'CompilationNoResult'
compilerNoResult :: [String] -> Compiler a
compilerNoResult :: [String] -> Compiler a
compilerNoResult = CompilerResult a -> Compiler a
forall a. CompilerResult a -> Compiler a
compilerResult (CompilerResult a -> Compiler a)
-> ([String] -> CompilerResult a) -> [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)
-> ([String] -> CompilerErrors String)
-> [String]
-> CompilerResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> CompilerErrors String
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 :: Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry (Compiler CompilerRead -> IO (CompilerResult a)
x) = (CompilerRead
 -> IO (CompilerResult (Either (CompilerErrors String) a)))
-> Compiler (Either (CompilerErrors String) a)
forall a. (CompilerRead -> IO (CompilerResult a)) -> Compiler a
Compiler ((CompilerRead
  -> IO (CompilerResult (Either (CompilerErrors String) a)))
 -> Compiler (Either (CompilerErrors String) a))
-> (CompilerRead
    -> IO (CompilerResult (Either (CompilerErrors String) a)))
-> Compiler (Either (CompilerErrors String) a)
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  -> CompilerResult (Either (CompilerErrors String) a)
-> IO (CompilerResult (Either (CompilerErrors String) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (CompilerErrors String) a
-> CompilerWrite
-> CompilerResult (Either (CompilerErrors String) a)
forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone (a -> Either (CompilerErrors String) a
forall a b. b -> Either a b
Right a
res') CompilerWrite
w)
        CompilerSnapshot String
s Compiler a
c -> CompilerResult (Either (CompilerErrors String) a)
-> IO (CompilerResult (Either (CompilerErrors String) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> Compiler (Either (CompilerErrors String) a)
-> CompilerResult (Either (CompilerErrors String) a)
forall a. String -> Compiler a -> CompilerResult a
CompilerSnapshot String
s (Compiler a -> Compiler (Either (CompilerErrors String) a)
forall a. Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry Compiler a
c))
        CompilerRequire [(Identifier, String)]
i Compiler a
c  -> CompilerResult (Either (CompilerErrors String) a)
-> IO (CompilerResult (Either (CompilerErrors String) a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Identifier, String)]
-> Compiler (Either (CompilerErrors String) a)
-> CompilerResult (Either (CompilerErrors String) a)
forall a. [(Identifier, String)] -> Compiler a -> CompilerResult a
CompilerRequire [(Identifier, String)]
i (Compiler a -> Compiler (Either (CompilerErrors String) a)
forall a. Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry Compiler a
c))
        CompilerError CompilerErrors String
e      -> CompilerResult (Either (CompilerErrors String) a)
-> IO (CompilerResult (Either (CompilerErrors String) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (CompilerErrors String) a
-> CompilerWrite
-> CompilerResult (Either (CompilerErrors String) a)
forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone (CompilerErrors String -> Either (CompilerErrors String) a
forall a b. a -> Either a b
Left CompilerErrors String
e) CompilerWrite
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 :: Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
compilerCatch (Compiler CompilerRead -> IO (CompilerResult a)
x) CompilerErrors String -> Compiler a
f = (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
r -> do
    CompilerResult a
res <- CompilerRead -> IO (CompilerResult a)
x CompilerRead
r
    case CompilerResult a
res of
        CompilerDone a
res' CompilerWrite
w  -> CompilerResult a -> IO (CompilerResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> CompilerWrite -> CompilerResult a
forall a. a -> CompilerWrite -> CompilerResult a
CompilerDone a
res' CompilerWrite
w)
        CompilerSnapshot String
s Compiler a
c -> CompilerResult a -> IO (CompilerResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Compiler a -> CompilerResult a
forall a. String -> Compiler a -> CompilerResult a
CompilerSnapshot String
s (Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
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  -> CompilerResult a -> IO (CompilerResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Identifier, String)] -> Compiler a -> CompilerResult a
forall a. [(Identifier, String)] -> Compiler a -> CompilerResult a
CompilerRequire [(Identifier, String)]
i (Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
forall a.
Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
compilerCatch Compiler a
c CompilerErrors String -> Compiler a
f))
        CompilerError CompilerErrors String
e      -> Compiler a -> CompilerRead -> IO (CompilerResult a)
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 (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
$ [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
ms ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Logger -> String -> IO ()
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 ([String] -> Compiler ())
-> ([String] -> [String]) -> [String] -> Compiler ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
msgString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
indent
  where
    indent :: ShowS
indent = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"    "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
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 ([String] -> Compiler ()) -> [String] -> Compiler ()
forall a b. (a -> b) -> a -> b
$ (Dependency -> String) -> [Dependency] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Dependency
d ->
      String
"Hakyll.Core.Compiler.Internal: Adding dependency: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dependency -> String
forall a. Show a => a -> String
show Dependency
d) [Dependency]
ds
  CompilerWrite -> Compiler ()
compilerTell CompilerWrite
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 CompilerWrite
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 (CompilerRead -> Provider)
-> Compiler CompilerRead -> Compiler Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    [Dependency] -> Compiler ()
compilerTellDependencies [Identifier -> Dependency
IdentifierDependency Identifier
identifier]
    IO Metadata -> Compiler Metadata
forall a. IO a -> Compiler a
compilerUnsafeIO (IO Metadata -> Compiler Metadata)
-> IO Metadata -> Compiler Metadata
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 (CompilerRead -> Set Identifier)
-> Compiler CompilerRead -> Compiler (Set Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    let matching :: Set Identifier
matching = (Identifier -> Bool) -> Set Identifier -> Set Identifier
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]
    [Identifier] -> Compiler [Identifier]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Identifier] -> Compiler [Identifier])
-> [Identifier] -> Compiler [Identifier]
forall a b. (a -> b) -> a -> b
$ Set Identifier -> [Identifier]
forall a. Set a -> [a]
S.toList Set Identifier
matching