Cleanup, split up page module

4 files changed, 54 insertions, 22 deletions

diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index 78178cb..eea474c 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -6,35 +6,24 @@
 module Hakyll.Web.Page
     ( Page (..)
     , toMap
+    , pageRead
     ) where
 
-import Control.Applicative ((<$>), (<*>))
+import Control.Arrow ((>>^))
 
 import Data.Map (Map)
 import qualified Data.Map as M
-import Data.Binary (Binary, get, put)
-import Data.Typeable (Typeable)
 
-import Hakyll.Core.Writable
-
--- | Type used to represent pages
---
-data Page a = Page
-    { pageMetadata :: Map String String
-    , pageBody     :: a
-    } deriving (Show, Typeable)
-
-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
+import Hakyll.Core.Compiler
+import Hakyll.Web.Page.Internal
+import Hakyll.Web.Page.Read
 
 -- | 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
+
+-- | Read a page (do not render it)
+--
+pageRead :: Compiler a (Page String)
+pageRead = getResourceString >>^ readPage
diff --git a/src/Hakyll/Web/Page/Internal.hs b/src/Hakyll/Web/Page/Internal.hs
new file mode 100644
index 0000000..bac4c51
--- /dev/null
+++ b/src/Hakyll/Web/Page/Internal.hs
@@ -0,0 +1,31 @@
+-- | Internal representation of the page datatype
+--
+{-# LANGUAGE DeriveDataTypeable #-}
+module Hakyll.Web.Page.Internal
+    ( Page (..)
+    ) where
+
+import Control.Applicative ((<$>), (<*>))
+
+import Data.Map (Map)
+import Data.Binary (Binary, get, put)
+import Data.Typeable (Typeable)
+
+import Hakyll.Core.Writable
+
+-- | Type used to represent pages
+--
+data Page a = Page
+    { pageMetadata :: Map String String
+    , pageBody     :: a
+    } deriving (Show, Typeable)
+
+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
diff --git a/src/Hakyll/Web/Page/Read.hs b/src/Hakyll/Web/Page/Read.hs
index 82224a4..d72f32a 100644
--- a/src/Hakyll/Web/Page/Read.hs
+++ b/src/Hakyll/Web/Page/Read.hs
@@ -11,7 +11,7 @@ import Data.List (isPrefixOf)
 import Data.Map (Map)
 import qualified Data.Map as M
 
-import Hakyll.Web.Page
+import Hakyll.Web.Page.Internal
 import Hakyll.Web.Util.String
 
 -- | We're using a simple state monad as parser
diff --git a/src/Hakyll/Web/Util/String.hs b/src/Hakyll/Web/Util/String.hs
index 5a8c7c6..e48580b 100644
--- a/src/Hakyll/Web/Util/String.hs
+++ b/src/Hakyll/Web/Util/String.hs
@@ -2,13 +2,25 @@
 --
 module Hakyll.Web.Util.String
     ( trim
+    , toSiteRoot
     ) where
 
 import Data.Char (isSpace)
 
+import System.FilePath (splitPath, takeDirectory, joinPath)
+
 -- | Trim a string (drop spaces, tabs and newlines at both sides).
 --
 trim :: String -> String
 trim = reverse . trim' . reverse . trim'
   where
     trim' = dropWhile isSpace
+
+-- | Get the relative url to the site root, for a given (absolute) url
+--
+toSiteRoot :: FilePath -> FilePath
+toSiteRoot = emptyException . joinPath . map parent . splitPath . takeDirectory
+  where
+    parent = const ".."
+    emptyException [] = "."
+    emptyException x  = x