Add WritableTuple

src/Hakyll.hs

@@ -2,7 +2,6 @@
 --
 module Hakyll
     ( module Hakyll.Core.Compiler
-    , module Hakyll.Core.CopyFile
     , module Hakyll.Core.Configuration
     , module Hakyll.Core.Identifier
     , module Hakyll.Core.Identifier.Pattern
@@ -14,6 +13,8 @@ module Hakyll
     , module Hakyll.Core.Util.File
     , module Hakyll.Core.Util.String
     , module Hakyll.Core.Writable
+    , module Hakyll.Core.Writable.CopyFile
+    , module Hakyll.Core.Writable.WritableTuple
     , module Hakyll.Main
     , module Hakyll.Web.CompressCss
     , module Hakyll.Web.Feed
@@ -29,7 +30,6 @@ module Hakyll
     ) where
 
 import Hakyll.Core.Compiler
-import Hakyll.Core.CopyFile
 import Hakyll.Core.Configuration
 import Hakyll.Core.Identifier
 import Hakyll.Core.Identifier.Pattern
@@ -41,6 +41,8 @@ import Hakyll.Core.Util.Arrow
 import Hakyll.Core.Util.File
 import Hakyll.Core.Util.String
 import Hakyll.Core.Writable
+import Hakyll.Core.Writable.CopyFile
+import Hakyll.Core.Writable.WritableTuple
 import Hakyll.Main
 import Hakyll.Web.CompressCss
 import Hakyll.Web.Feed

src/Hakyll/Core/CompiledItem.hs

@@ -15,7 +15,7 @@ module Hakyll.Core.CompiledItem
     ) where
 
 import Data.Binary (Binary)
-import Data.Typeable (Typeable, cast)
+import Data.Typeable (Typeable, cast, typeOf)
 import Data.Maybe (fromMaybe)
 
 import Hakyll.Core.Writable
@@ -42,4 +42,5 @@ unCompiledItem :: (Binary a, Typeable a, Writable a)
                -> a
 unCompiledItem (CompiledItem x) = fromMaybe error' $ cast x
   where
-    error' = error "Hakyll.Core.CompiledItem.unCompiledItem: Unsupported type"
+    error' = error $  "Hakyll.Core.CompiledItem.unCompiledItem: "
+                   ++ "unsupported type (got " ++ show (typeOf x) ++ ")"

src/Hakyll/Core/Writable/CopyFile.hs

@@ -1,7 +1,7 @@
 -- | Exports simple compilers to just copy files
 --
 {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
-module Hakyll.Core.CopyFile
+module Hakyll.Core.Writable.CopyFile
     ( CopyFile (..)
     , copyFileCompiler
     ) where

src/Hakyll/Core/Writable/WritableTuple.hs

@@ -0,0 +1,37 @@
+-- | This module exposes a writable type 'WritableTuple' which is a simple
+-- newtype wrapper around a tuple.
+--
+-- The idea is that, given a tuple @(a, b)@, @a@ is the value you actually want
+-- to save to the disk, and @b@ is some additional info that you /don't/ want to
+-- save, but that you need later, for example in a 'require' clause.
+--
+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
+module Hakyll.Core.Writable.WritableTuple
+    ( WritableTuple (..)
+    , writableTupleFst
+    , writableTupleSnd
+    , writableTupleCompiler
+    ) where
+
+import Control.Arrow (arr)
+
+import Data.Typeable (Typeable)
+import Data.Binary (Binary)
+
+import Hakyll.Core.Writable
+import Hakyll.Core.Compiler
+
+newtype WritableTuple a b = WritableTuple {unWritableTuple :: (a, b)}
+                          deriving (Show, Eq, Ord, Binary, Typeable)
+
+instance Writable a => Writable (WritableTuple a b) where
+    write dst (WritableTuple (x, _)) = write dst x
+
+writableTupleFst :: WritableTuple a b -> a
+writableTupleFst = fst . unWritableTuple
+
+writableTupleSnd :: WritableTuple a b -> b
+writableTupleSnd = snd . unWritableTuple
+
+writableTupleCompiler :: Compiler (a, b) (WritableTuple a b)
+writableTupleCompiler = arr WritableTuple