summaryrefslogtreecommitdiff
path: root/src/Hakyll/Core/Item.hs
blob: 8933d5bfe4c2608ba816de4ff26f3afe7e64b6e3 (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
--------------------------------------------------------------------------------
-- | An item is a combination of some content and its 'Identifier'. This way, we
-- can still use the 'Identifier' to access metadata.
{-# LANGUAGE DeriveDataTypeable #-}
module Hakyll.Core.Item
    ( Item (..)
    , itemSetBody
    , withItemBody
    ) where


--------------------------------------------------------------------------------
import           Control.Applicative           (Applicative, (<$>), (<*>))
import           Data.Binary                   (Binary (..))
import           Data.Foldable                 (Foldable (..))
import           Data.Traversable              (Traversable (..))
import           Data.Typeable                 (Typeable)
import           Prelude                       hiding (foldr)


--------------------------------------------------------------------------------
import           Hakyll.Core.Compiler.Internal
import           Hakyll.Core.Identifier


--------------------------------------------------------------------------------
data Item a = Item
    { itemIdentifier :: Identifier
    , itemBody       :: a
    } deriving (Show, Typeable)


--------------------------------------------------------------------------------
instance Functor Item where
    fmap f (Item i x) = Item i (f x)


--------------------------------------------------------------------------------
instance Foldable Item where
    foldr f z (Item _ x) = f x z


--------------------------------------------------------------------------------
instance Traversable Item where
    traverse f (Item i x) = Item i <$> f x


--------------------------------------------------------------------------------
instance Binary a => Binary (Item a) where
    put (Item i x) = put i >> put x
    get            = Item <$> get <*> get


--------------------------------------------------------------------------------
itemSetBody :: a -> Item b -> Item a
itemSetBody x (Item i _) = Item i x


--------------------------------------------------------------------------------
-- | Perform a compiler action on the item body. This is the same as 'traverse',
-- but looks less intimidating.
--
-- > withItemBody = traverse
withItemBody :: (a -> Compiler b) -> Item a -> Compiler (Item b)
withItemBody = traverse