summaryrefslogtreecommitdiff
path: root/src/Hakyll/Web/Page/Internal.hs
blob: 55067edd760d0855a4b61632ad1096089829b02b (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
-- | Internal representation of the page datatype
--
{-# LANGUAGE DeriveDataTypeable #-}
module Hakyll.Web.Page.Internal
    ( Page (..)
    , fromMap
    , toMap
    ) where

import Control.Applicative ((<$>), (<*>))
import Data.Monoid (Monoid, mempty, mappend)

import Data.Map (Map)
import Data.Binary (Binary, get, put)
import Data.Typeable (Typeable)
import qualified Data.Map as M

import Hakyll.Core.Writable

-- | Type used to represent pages
--
data Page a = Page
    { pageMetadata :: Map String String
    , pageBody     :: a
    } deriving (Eq, Show, Typeable)

instance Monoid a => Monoid (Page a) where
    mempty = Page M.empty mempty
    mappend (Page m1 b1) (Page m2 b2) =
        Page (M.union m1 m2) (mappend b1 b2)

instance Functor Page where
    fmap f (Page m b) = Page m (f b)

instance Binary a => Binary (Page a) where
    put (Page m b) = put m >> put b
    get = Page <$> get <*> get

instance Writable a => Writable (Page a) where
    write p (Page _ b) = write p b

-- | Create a metadata page, without a body
--
fromMap :: Monoid a => Map String String -> Page a
fromMap m = Page m mempty

-- | Convert a page to a map. The body will be placed in the @body@ key.
--
toMap :: Page String -> Map String String
toMap (Page m b) = M.insert "body" b m