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


--------------------------------------------------------------------------------
import           Control.Monad                  (when)
import           Data.Binary                    (Binary)
import           Data.Foldable                  (toList, traverse_)
import           Data.Functor.Identity          (Identity(Identity, runIdentity))
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 :: forall a. (Binary a, Typeable a) => Store -> Item a -> IO ()
save Store
store Item a
item = 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 :: forall a.
(Binary a, Typeable a) =>
Store -> Snapshot -> Item a -> IO ()
saveSnapshot Store
store Snapshot
snapshot Item a
item =
    forall a.
(Binary a, Typeable a) =>
Store -> [Snapshot] -> a -> IO ()
Store.set Store
store (Identifier -> Snapshot -> [Snapshot]
key (forall a. Item a -> Identifier
itemIdentifier Item a
item) Snapshot
snapshot) (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 :: forall a. (Binary a, Typeable a) => Identifier -> Compiler (Item a)
load Identifier
id' = 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 :: forall a.
(Binary a, Typeable a) =>
Identifier -> Snapshot -> Compiler (Item a)
loadSnapshot Identifier
id' Snapshot
snapshot =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall a (t :: * -> *).
(Binary a, Typeable a, Traversable t) =>
t (Identifier, Snapshot) -> Compiler (t (Item a))
loadSnapshotCollection (forall a. a -> Identity a
Identity (Identifier
id', Snapshot
snapshot))


--------------------------------------------------------------------------------
-- | A shortcut for only requiring the body of an item.
--
-- > loadBody = fmap itemBody . load
loadBody :: (Binary a, Typeable a) => Identifier -> Compiler a
loadBody :: forall a. (Binary a, Typeable a) => Identifier -> Compiler a
loadBody Identifier
id' = 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 :: forall a.
(Binary a, Typeable a) =>
Identifier -> Snapshot -> Compiler a
loadSnapshotBody Identifier
id' Snapshot
snapshot = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Item a -> a
itemBody forall a b. (a -> b) -> a -> b
$ 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 :: forall a. (Binary a, Typeable a) => Pattern -> Compiler [Item a]
loadAll Pattern
pattern = 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 :: forall a.
(Binary a, Typeable a) =>
Pattern -> Snapshot -> Compiler [Item a]
loadAllSnapshots Pattern
pattern Snapshot
snapshot = do
    [(Identifier, Snapshot)]
ids <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Identifier
id' -> (Identifier
id', Snapshot
snapshot)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches Pattern
pattern
    forall a (t :: * -> *).
(Binary a, Typeable a, Traversable t) =>
t (Identifier, Snapshot) -> Compiler (t (Item a))
loadSnapshotCollection [(Identifier, Snapshot)]
ids


--------------------------------------------------------------------------------
-- | Load a collection of snapshots.
-- Only the first NotFound or WrongType error will be reported.
loadSnapshotCollection :: (Binary a, Typeable a, Traversable t)
              => t (Identifier, Snapshot) -> Compiler (t (Item a))
loadSnapshotCollection :: forall a (t :: * -> *).
(Binary a, Typeable a, Traversable t) =>
t (Identifier, Snapshot) -> Compiler (t (Item a))
loadSnapshotCollection t (Identifier, Snapshot)
ids = do
    Store
store    <- CompilerRead -> Store
compilerStore forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Set Identifier
universe <- CompilerRead -> Set Identifier
compilerUniverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk

    -- Quick check for better error messages
    let checkMember :: (Identifier, Snapshot) -> f ()
checkMember (Identifier
id', Snapshot
snap) =
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Identifier
id' forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Identifier
universe) (forall (m :: * -> *) a. MonadFail m => Snapshot -> m a
fail forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => a -> Snapshot -> Snapshot
notFound Identifier
id' Snapshot
snap)
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall {f :: * -> *}. MonadFail f => (Identifier, Snapshot) -> f ()
checkMember t (Identifier, Snapshot)
ids

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


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


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