--------------------------------------------------------------------------------
module Hakyll.Core.Compiler.Require
    ( Snapshot
    , save
    , saveSnapshot
    , load
    , loadSnapshot
    , loadBody
    , loadSnapshotBody
    , loadAll
    , loadAllSnapshots
    ) where


--------------------------------------------------------------------------------
import           Control.Monad                  (when)
import           Data.Binary                    (Binary)
import qualified Data.Set                       as S
import           Data.Typeable


--------------------------------------------------------------------------------
import           Hakyll.Core.Compiler.Internal
import           Hakyll.Core.Dependencies
import           Hakyll.Core.Identifier
import           Hakyll.Core.Identifier.Pattern
import           Hakyll.Core.Item
import           Hakyll.Core.Metadata
import           Hakyll.Core.Store              (Store)
import qualified Hakyll.Core.Store              as Store


--------------------------------------------------------------------------------
save :: (Binary a, Typeable a) => Store -> Item a -> IO ()
save :: Store -> Item a -> IO ()
save Store
store Item a
item = Store -> Snapshot -> Item a -> IO ()
forall a.
(Binary a, Typeable a) =>
Store -> Snapshot -> Item a -> IO ()
saveSnapshot Store
store Snapshot
final Item a
item


--------------------------------------------------------------------------------
-- | Save a specific snapshot of an item, so you can load it later using
-- 'loadSnapshot'.
saveSnapshot :: (Binary a, Typeable a)
             => Store -> Snapshot -> Item a -> IO ()
saveSnapshot :: Store -> Snapshot -> Item a -> IO ()
saveSnapshot Store
store Snapshot
snapshot Item a
item =
    Store -> [Snapshot] -> a -> IO ()
forall a.
(Binary a, Typeable a) =>
Store -> [Snapshot] -> a -> IO ()
Store.set Store
store (Identifier -> Snapshot -> [Snapshot]
key (Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item a
item) Snapshot
snapshot) (Item a -> a
forall a. Item a -> a
itemBody Item a
item)


--------------------------------------------------------------------------------
-- | Load an item compiled elsewhere. If the required item is not yet compiled,
-- the build system will take care of that automatically.
load :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)
load :: Identifier -> Compiler (Item a)
load Identifier
id' = Identifier -> Snapshot -> Compiler (Item a)
forall a.
(Binary a, Typeable a) =>
Identifier -> Snapshot -> Compiler (Item a)
loadSnapshot Identifier
id' Snapshot
final


--------------------------------------------------------------------------------
-- | Require a specific snapshot of an item.
loadSnapshot :: (Binary a, Typeable a)
             => Identifier -> Snapshot -> Compiler (Item a)
loadSnapshot :: Identifier -> Snapshot -> Compiler (Item a)
loadSnapshot Identifier
id' Snapshot
snapshot = do
    Store
store    <- CompilerRead -> Store
compilerStore (CompilerRead -> Store) -> Compiler CompilerRead -> Compiler Store
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    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

    -- Quick check for better error messages
    Bool -> Compiler () -> Compiler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Identifier
id' Identifier -> Set Identifier -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Identifier
universe) (Compiler () -> Compiler ()) -> Compiler () -> Compiler ()
forall a b. (a -> b) -> a -> b
$ Snapshot -> Compiler ()
forall (m :: * -> *) a. MonadFail m => Snapshot -> m a
fail Snapshot
notFound

    [Dependency] -> Compiler ()
compilerTellDependencies [Identifier -> Dependency
IdentifierDependency Identifier
id']
    CompilerResult (Item a) -> Compiler (Item a)
forall a. CompilerResult a -> Compiler a
compilerResult (CompilerResult (Item a) -> Compiler (Item a))
-> CompilerResult (Item a) -> Compiler (Item a)
forall a b. (a -> b) -> a -> b
$ (Identifier, Snapshot)
-> Compiler (Item a) -> CompilerResult (Item a)
forall a. (Identifier, Snapshot) -> Compiler a -> CompilerResult a
CompilerRequire (Identifier
id', Snapshot
snapshot) (Compiler (Item a) -> CompilerResult (Item a))
-> Compiler (Item a) -> CompilerResult (Item a)
forall a b. (a -> b) -> a -> b
$ do
        Result a
result <- IO (Result a) -> Compiler (Result a)
forall a. IO a -> Compiler a
compilerUnsafeIO (IO (Result a) -> Compiler (Result a))
-> IO (Result a) -> Compiler (Result a)
forall a b. (a -> b) -> a -> b
$ Store -> [Snapshot] -> IO (Result a)
forall a.
(Binary a, Typeable a) =>
Store -> [Snapshot] -> IO (Result a)
Store.get Store
store (Identifier -> Snapshot -> [Snapshot]
key Identifier
id' Snapshot
snapshot)
        case Result a
result of
            Result a
Store.NotFound      -> Snapshot -> Compiler (Item a)
forall (m :: * -> *) a. MonadFail m => Snapshot -> m a
fail Snapshot
notFound
            Store.WrongType TypeRep
e TypeRep
r -> Snapshot -> Compiler (Item a)
forall (m :: * -> *) a. MonadFail m => Snapshot -> m a
fail (Snapshot -> Compiler (Item a)) -> Snapshot -> Compiler (Item a)
forall a b. (a -> b) -> a -> b
$ TypeRep -> TypeRep -> Snapshot
forall a a. (Show a, Show a) => a -> a -> Snapshot
wrongType TypeRep
e TypeRep
r
            Store.Found a
x       -> Item a -> Compiler (Item a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Item a -> Compiler (Item a)) -> Item a -> Compiler (Item a)
forall a b. (a -> b) -> a -> b
$ Identifier -> a -> Item a
forall a. Identifier -> a -> Item a
Item Identifier
id' a
x
  where
    notFound :: Snapshot
notFound =
        Snapshot
"Hakyll.Core.Compiler.Require.load: " Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++ Identifier -> Snapshot
forall a. Show a => a -> Snapshot
show Identifier
id' Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++
        Snapshot
" (snapshot " Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++ Snapshot
snapshot Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++ Snapshot
") was not found in the cache, " Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++
        Snapshot
"the cache might be corrupted or " Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++
        Snapshot
"the item you are referring to might not exist"
    wrongType :: a -> a -> Snapshot
wrongType a
e a
r =
        Snapshot
"Hakyll.Core.Compiler.Require.load: " Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++ Identifier -> Snapshot
forall a. Show a => a -> Snapshot
show Identifier
id' Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++
        Snapshot
" (snapshot " Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++ Snapshot
snapshot Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++ Snapshot
") was found in the cache, " Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++
        Snapshot
"but does not have the right type: expected " Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++ a -> Snapshot
forall a. Show a => a -> Snapshot
show a
e Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++
        Snapshot
" but got " Snapshot -> Snapshot -> Snapshot
forall a. [a] -> [a] -> [a]
++ a -> Snapshot
forall a. Show a => a -> Snapshot
show a
r


--------------------------------------------------------------------------------
-- | A shortcut for only requiring the body of an item.
--
-- > loadBody = fmap itemBody . load
loadBody :: (Binary a, Typeable a) => Identifier -> Compiler a
loadBody :: Identifier -> Compiler a
loadBody Identifier
id' = Identifier -> Snapshot -> Compiler a
forall a.
(Binary a, Typeable a) =>
Identifier -> Snapshot -> Compiler a
loadSnapshotBody Identifier
id' Snapshot
final


--------------------------------------------------------------------------------
-- | A shortcut for only requiring the body for a specific snapshot of an item
loadSnapshotBody :: (Binary a, Typeable a)
                 => Identifier -> Snapshot -> Compiler a
loadSnapshotBody :: Identifier -> Snapshot -> Compiler a
loadSnapshotBody Identifier
id' Snapshot
snapshot = (Item a -> a) -> Compiler (Item a) -> Compiler a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Item a -> a
forall a. Item a -> a
itemBody (Compiler (Item a) -> Compiler a)
-> Compiler (Item a) -> Compiler a
forall a b. (a -> b) -> a -> b
$ Identifier -> Snapshot -> Compiler (Item a)
forall a.
(Binary a, Typeable a) =>
Identifier -> Snapshot -> Compiler (Item a)
loadSnapshot Identifier
id' Snapshot
snapshot


--------------------------------------------------------------------------------
-- | This function allows you to 'load' a dynamic list of items
loadAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]
loadAll :: Pattern -> Compiler [Item a]
loadAll Pattern
pattern = Pattern -> Snapshot -> Compiler [Item a]
forall a.
(Binary a, Typeable a) =>
Pattern -> Snapshot -> Compiler [Item a]
loadAllSnapshots Pattern
pattern Snapshot
final


--------------------------------------------------------------------------------
-- | Load a specific snapshot for each of dynamic list of items
loadAllSnapshots :: (Binary a, Typeable a)
                 => Pattern -> Snapshot -> Compiler [Item a]
loadAllSnapshots :: Pattern -> Snapshot -> Compiler [Item a]
loadAllSnapshots Pattern
pattern Snapshot
snapshot = do
    [Identifier]
matching <- Pattern -> Compiler [Identifier]
forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches Pattern
pattern
    (Identifier -> Compiler (Item a))
-> [Identifier] -> Compiler [Item a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Identifier
i -> Identifier -> Snapshot -> Compiler (Item a)
forall a.
(Binary a, Typeable a) =>
Identifier -> Snapshot -> Compiler (Item a)
loadSnapshot Identifier
i Snapshot
snapshot) [Identifier]
matching


--------------------------------------------------------------------------------
key :: Identifier -> String -> [String]
key :: Identifier -> Snapshot -> [Snapshot]
key Identifier
identifier Snapshot
snapshot =
    [Snapshot
"Hakyll.Core.Compiler.Require", Identifier -> Snapshot
forall a. Show a => a -> Snapshot
show Identifier
identifier, Snapshot
snapshot]


--------------------------------------------------------------------------------
final :: Snapshot
final :: Snapshot
final = Snapshot
"_final"