diff --git a/src/Hakyll.hs b/src/Hakyll.hs index 0261044..dbc67f3 100644 --- a/src/Hakyll.hs +++ b/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 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/Writable/CopyFile.hs similarity index 95% rename from src/Hakyll/Core/CopyFile.hs rename to src/Hakyll/Core/Writable/CopyFile.hs index dbbaaa1..1cd5fd2 100644 --- a/src/Hakyll/Core/CopyFile.hs +++ b/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 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