diff options
Diffstat (limited to 'src/Hakyll/Core/Writable')
-rw-r--r-- | src/Hakyll/Core/Writable/CopyFile.hs | 29 | ||||
-rw-r--r-- | src/Hakyll/Core/Writable/WritableTuple.hs | 37 |
2 files changed, 66 insertions, 0 deletions
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 |