git.iko.soy/hakyll
on b91c8be help sign in
hakyll/src/Hakyll/Core/Compiler/Require.hs
128 lines 5.0 kB history raw
1--------------------------------------------------------------------------------
2module Hakyll.Core.Compiler.Require
3 ( Snapshot
4 , save
5 , saveSnapshot
6 , load
7 , loadSnapshot
8 , loadBody
9 , loadSnapshotBody
10 , loadAll
11 , loadAllSnapshots
12 ) where
15--------------------------------------------------------------------------------
16import Control.Applicative ((<$>))
17import Control.Monad (when)
18import Data.Binary (Binary)
19import qualified Data.Set as S
20import Data.Typeable
23--------------------------------------------------------------------------------
24import Hakyll.Core.Compiler.Internal
25import Hakyll.Core.Dependencies
26import Hakyll.Core.Identifier
27import Hakyll.Core.Identifier.Pattern
28import Hakyll.Core.Item
29import Hakyll.Core.Metadata
30import Hakyll.Core.Store (Store)
31import qualified Hakyll.Core.Store as Store
34--------------------------------------------------------------------------------
35-- | Whilst compiling an item, it possible to save multiple snapshots of it, and
36-- not just the final result.
37type Snapshot = String
40--------------------------------------------------------------------------------
41save :: (Binary a, Typeable a) => Store -> Item a -> IO ()
42save store item = saveSnapshot store final item
45--------------------------------------------------------------------------------
46-- | Save a specific snapshot of an item, so you can load it later using
47-- 'loadSnapshot'.
48saveSnapshot :: (Binary a, Typeable a)
49 => Store -> Snapshot -> Item a -> IO ()
50saveSnapshot store snapshot item =
51 Store.set store (key (itemIdentifier item) snapshot) (itemBody item)
54--------------------------------------------------------------------------------
55-- | Load an item compiled elsewhere. If the required item is not yet compiled,
56-- the build system will take care of that automatically.
57load :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)
58load id' = loadSnapshot id' final
61--------------------------------------------------------------------------------
62-- | Require a specific snapshot of an item.
63loadSnapshot :: (Binary a, Typeable a)
64 => Identifier -> Snapshot -> Compiler (Item a)
65loadSnapshot id' snapshot = do
66 store <- compilerStore <$> compilerAsk
67 universe <- compilerUniverse <$> compilerAsk
69 -- Quick check for better error messages
70 when (id' `S.notMember` universe) $ compilerThrow notFound
72 compilerTellDependencies [IdentifierDependency id']
73 compilerResult $ CompilerRequire id' $ do
74 result <- compilerUnsafeIO $ Store.get store (key id' snapshot)
75 case result of
76 Store.NotFound -> compilerThrow notFound
77 Store.WrongType e r -> compilerThrow $ wrongType e r
78 Store.Found x -> return $ Item id' x
79 where
80 notFound =
81 "Hakyll.Core.Compiler.Require.load: " ++ show id' ++
82 " (snapshot " ++ snapshot ++ ") was not found in the cache, " ++
83 "the cache might be corrupted or " ++
84 "the item you are referring to might not exist"
85 wrongType e r =
86 "Hakyll.Core.Compiler.Require.load: " ++ show id' ++
87 " (snapshot " ++ snapshot ++ ") was found in the cache, " ++
88 "but does not have the right type: expected " ++ show e ++
89 " but got " ++ show r
92--------------------------------------------------------------------------------
93-- | A shortcut for only requiring the body of an item.
94--
95-- > loadBody = fmap itemBody . load
96loadBody :: (Binary a, Typeable a) => Identifier -> Compiler a
97loadBody id' = loadSnapshotBody id' final
100--------------------------------------------------------------------------------
101loadSnapshotBody :: (Binary a, Typeable a)
102 => Identifier -> Snapshot -> Compiler a
103loadSnapshotBody id' snapshot = fmap itemBody $ loadSnapshot id' snapshot
106--------------------------------------------------------------------------------
107-- | This function allows you to 'load' a dynamic list of items
108loadAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]
109loadAll pattern = loadAllSnapshots pattern final
112--------------------------------------------------------------------------------
113loadAllSnapshots :: (Binary a, Typeable a)
114 => Pattern -> Snapshot -> Compiler [Item a]
115loadAllSnapshots pattern snapshot = do
116 matching <- getMatches pattern
117 mapM (\i -> loadSnapshot i snapshot) matching
120--------------------------------------------------------------------------------
121key :: Identifier -> String -> [String]
122key identifier snapshot =
123 ["Hakyll.Core.Compiler.Require", show identifier, snapshot]
126--------------------------------------------------------------------------------
127final :: Snapshot
128final = "_final"