summaryrefslogtreecommitdiff
path: root/src/Hakyll/Core/Compiler/Require.hs
blob: a7c47ce7d000ccf7e4c4b4a74115c90bc45c9bb0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
--------------------------------------------------------------------------------
module Hakyll.Core.Compiler.Require
    ( save
    , require
    , requireBody
    , requireAll
    ) where


--------------------------------------------------------------------------------
import           Control.Applicative            ((<$>))
import           Data.Binary                    (Binary)
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.Store              (Store)
import qualified Hakyll.Core.Store              as Store


--------------------------------------------------------------------------------
save :: (Binary a, Typeable a) => Store -> Identifier -> a -> IO ()
save store identifier x = Store.set store (key identifier) x


--------------------------------------------------------------------------------
require :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)
require id' = do
    store <- compilerStore <$> compilerAsk

    compilerTellDependencies [IdentifierDependency id']
    compilerResult $ CompilerRequire id' $ do
        result <- compilerUnsafeIO $ Store.get store (key id')
        case result of
            Store.NotFound      -> compilerThrow notFound
            Store.WrongType e r -> compilerThrow $ wrongType e r
            Store.Found x       -> return $ Item id' x
  where
    notFound =
        "Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was " ++
        "not found in the cache, the cache might be corrupted or " ++
        "the item you are referring to might not exist"
    wrongType e r =
        "Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was found " ++
        "in the cache, but does not have the right type: expected " ++ show e ++
        " but got " ++ show r


--------------------------------------------------------------------------------
requireBody :: (Binary a, Typeable a) => Identifier -> Compiler a
requireBody = fmap itemBody . require


--------------------------------------------------------------------------------
requireAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]
requireAll pattern = do
    universe <- compilerUniverse <$> compilerAsk
    let matching = filterMatches pattern universe
    compilerTellDependencies [PatternDependency pattern matching]
    mapM require matching


--------------------------------------------------------------------------------
key :: Identifier -> [String]
key identifier = ["Hakyll.Core.Compiler.Require", show identifier]