From 21789abd101a738639c957d5701a514860b63ee2 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Wed, 2 Mar 2011 20:37:34 +0100
Subject: Add WritableTuple

---
 src/Hakyll/Core/CompiledItem.hs           |  5 +++--
 src/Hakyll/Core/CopyFile.hs               | 29 ------------------------
 src/Hakyll/Core/Writable/CopyFile.hs      | 29 ++++++++++++++++++++++++
 src/Hakyll/Core/Writable/WritableTuple.hs | 37 +++++++++++++++++++++++++++++++
 4 files changed, 69 insertions(+), 31 deletions(-)
 delete mode 100644 src/Hakyll/Core/CopyFile.hs
 create mode 100644 src/Hakyll/Core/Writable/CopyFile.hs
 create mode 100644 src/Hakyll/Core/Writable/WritableTuple.hs

(limited to 'src/Hakyll/Core')

diff --git a/src/Hakyll/Core/CompiledItem.hs b/src/Hakyll/Core/CompiledItem.hs
index 5dd0efc..2e492a2 100644
--- a/src/Hakyll/Core/CompiledItem.hs
+++ b/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) ++ ")"
diff --git a/src/Hakyll/Core/CopyFile.hs b/src/Hakyll/Core/CopyFile.hs
deleted file mode 100644
index dbbaaa1..0000000
--- a/src/Hakyll/Core/CopyFile.hs
+++ /dev/null
@@ -1,29 +0,0 @@
--- | Exports simple compilers to just copy files
---
-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
-module Hakyll.Core.CopyFile
-    ( CopyFile (..)
-    , copyFileCompiler
-    ) where
-
-import Control.Arrow ((>>^))
-import System.Directory (copyFile)
-
-import Data.Typeable (Typeable)
-import Data.Binary (Binary)
-
-import Hakyll.Core.ResourceProvider
-import Hakyll.Core.Writable
-import Hakyll.Core.Compiler
-import Hakyll.Core.Identifier
-
--- | Newtype construct around 'FilePath' which will copy the file directly
---
-newtype CopyFile = CopyFile {unCopyFile :: FilePath}
-                 deriving (Show, Eq, Ord, Binary, Typeable)
-
-instance Writable CopyFile where
-    write dst (CopyFile src) = copyFile src dst
-
-copyFileCompiler :: Compiler Resource CopyFile
-copyFileCompiler = getIdentifier >>^ CopyFile . toFilePath
diff --git a/src/Hakyll/Core/Writable/CopyFile.hs b/src/Hakyll/Core/Writable/CopyFile.hs
new file mode 100644
index 0000000..1cd5fd2
--- /dev/null
+++ b/src/Hakyll/Core/Writable/CopyFile.hs
@@ -0,0 +1,29 @@
+-- | Exports simple compilers to just copy files
+--
+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
+module Hakyll.Core.Writable.CopyFile
+    ( CopyFile (..)
+    , copyFileCompiler
+    ) where
+
+import Control.Arrow ((>>^))
+import System.Directory (copyFile)
+
+import Data.Typeable (Typeable)
+import Data.Binary (Binary)
+
+import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Writable
+import Hakyll.Core.Compiler
+import Hakyll.Core.Identifier
+
+-- | Newtype construct around 'FilePath' which will copy the file directly
+--
+newtype CopyFile = CopyFile {unCopyFile :: FilePath}
+                 deriving (Show, Eq, Ord, Binary, Typeable)
+
+instance Writable CopyFile where
+    write dst (CopyFile src) = copyFile src dst
+
+copyFileCompiler :: Compiler Resource CopyFile
+copyFileCompiler = getIdentifier >>^ CopyFile . toFilePath
diff --git a/src/Hakyll/Core/Writable/WritableTuple.hs b/src/Hakyll/Core/Writable/WritableTuple.hs
new file mode 100644
index 0000000..741d2c7
--- /dev/null
+++ b/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
-- 
cgit v1.2.3