on master help sign in
Add WritableTuple
commit21789abd101a738639c957d5701a514860b63ee2 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateWed 2 Mar 2011, 20:37 (16 years ago) parent38effae
4 files changed+45−5
src/Hakyll.hs+4−2 src/Hakyll/Core/CompiledItem.hs+3−2 src/Hakyll/Core/CopyFile.hs → src/Hakyll/Core/Writable/CopyFile.hs+1−1 src/Hakyll/Core/Writable/WritableTuple.hs+37
src/Hakyll.hs+4−2
@@ -2,7 +2,6 @@
22--
33module Hakyll
44 ( module Hakyll.Core.Compiler
5− , module Hakyll.Core.CopyFile
65 , module Hakyll.Core.Configuration
76 , module Hakyll.Core.Identifier
87 , module Hakyll.Core.Identifier.Pattern
@@ -14,6 +13,8 @@ module Hakyll
1413 , module Hakyll.Core.Util.File
1514 , module Hakyll.Core.Util.String
1615 , module Hakyll.Core.Writable
16+ , module Hakyll.Core.Writable.CopyFile
17+ , module Hakyll.Core.Writable.WritableTuple
1718 , module Hakyll.Main
1819 , module Hakyll.Web.CompressCss
1920 , module Hakyll.Web.Feed
@@ -29,7 +30,6 @@ module Hakyll
2930 ) where
3031
3132import Hakyll.Core.Compiler
32−import Hakyll.Core.CopyFile
3333import Hakyll.Core.Configuration
3434import Hakyll.Core.Identifier
3535import Hakyll.Core.Identifier.Pattern
@@ -41,6 +41,8 @@ import Hakyll.Core.Util.Arrow
4141import Hakyll.Core.Util.File
4242import Hakyll.Core.Util.String
4343import Hakyll.Core.Writable
44+import Hakyll.Core.Writable.CopyFile
45+import Hakyll.Core.Writable.WritableTuple
4446import Hakyll.Main
4547import Hakyll.Web.CompressCss
4648import Hakyll.Web.Feed
src/Hakyll/Core/CompiledItem.hs+3−2
@@ -15,7 +15,7 @@ module Hakyll.Core.CompiledItem
1515 ) where
1616
1717import Data.Binary (Binary)
18−import Data.Typeable (Typeable, cast)
18+import Data.Typeable (Typeable, cast, typeOf)
1919import Data.Maybe (fromMaybe)
2020
2121import Hakyll.Core.Writable
@@ -42,4 +42,5 @@ unCompiledItem :: (Binary a, Typeable a, Writable a)
4242 -> a
4343unCompiledItem (CompiledItem x) = fromMaybe error' $ cast x
4444 where
45− error' = error "Hakyll.Core.CompiledItem.unCompiledItem: Unsupported type"
45+ error' = error $ "Hakyll.Core.CompiledItem.unCompiledItem: "
46+ ++ "unsupported type (got " ++ show (typeOf x) ++ ")"
src/Hakyll/Core/CopyFile.hs → src/Hakyll/Core/Writable/CopyFile.hsrenamed+1−1
@@ -1,7 +1,7 @@
11-- | Exports simple compilers to just copy files
22--
33{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
4−module Hakyll.Core.CopyFile
4+module Hakyll.Core.Writable.CopyFile
55 ( CopyFile (..)
66 , copyFileCompiler
77 ) where
src/Hakyll/Core/Writable/WritableTuple.hsnew file+37
@@ -0,0 +1,37 @@
1+-- | This module exposes a writable type 'WritableTuple' which is a simple
2+-- newtype wrapper around a tuple.
3+--
4+-- The idea is that, given a tuple @(a, b)@, @a@ is the value you actually want
5+-- to save to the disk, and @b@ is some additional info that you /don't/ want to
6+-- save, but that you need later, for example in a 'require' clause.
7+--
8+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
9+module Hakyll.Core.Writable.WritableTuple
10+ ( WritableTuple (..)
11+ , writableTupleFst
12+ , writableTupleSnd
13+ , writableTupleCompiler
14+ ) where
15+
16+import Control.Arrow (arr)
17+
18+import Data.Typeable (Typeable)
19+import Data.Binary (Binary)
20+
21+import Hakyll.Core.Writable
22+import Hakyll.Core.Compiler
23+
24+newtype WritableTuple a b = WritableTuple {unWritableTuple :: (a, b)}
25+ deriving (Show, Eq, Ord, Binary, Typeable)
26+
27+instance Writable a => Writable (WritableTuple a b) where
28+ write dst (WritableTuple (x, _)) = write dst x
29+
30+writableTupleFst :: WritableTuple a b -> a
31+writableTupleFst = fst . unWritableTuple
32+
33+writableTupleSnd :: WritableTuple a b -> b
34+writableTupleSnd = snd . unWritableTuple
35+
36+writableTupleCompiler :: Compiler (a, b) (WritableTuple a b)
37+writableTupleCompiler = arr WritableTuple