diff options
Diffstat (limited to 'src/Text/Hakyll/Internal')
| -rw-r--r-- | src/Text/Hakyll/Internal/Cache.hs | 53 | ||||
| -rw-r--r-- | src/Text/Hakyll/Internal/CompressCss.hs | 36 | ||||
| -rw-r--r-- | src/Text/Hakyll/Internal/FileType.hs | 49 | ||||
| -rw-r--r-- | src/Text/Hakyll/Internal/Template.hs | 86 | ||||
| -rw-r--r-- | src/Text/Hakyll/Internal/Template/Hamlet.hs | 56 | ||||
| -rw-r--r-- | src/Text/Hakyll/Internal/Template/Template.hs | 34 |
6 files changed, 0 insertions, 314 deletions
diff --git a/src/Text/Hakyll/Internal/Cache.hs b/src/Text/Hakyll/Internal/Cache.hs deleted file mode 100644 index b83d9af..0000000 --- a/src/Text/Hakyll/Internal/Cache.hs +++ /dev/null @@ -1,53 +0,0 @@ -module Text.Hakyll.Internal.Cache - ( storeInCache - , getFromCache - , isCacheMoreRecent - , cacheAction - ) where - -import Control.Monad ((<=<)) -import Control.Monad.Reader (liftIO) -import Data.Binary -import System.FilePath ((</>)) - -import Text.Hakyll.File -import Text.Hakyll.HakyllMonad (Hakyll) -import Text.Hakyll.HakyllAction - --- | We can store all datatypes instantiating @Binary@ to the cache. The cache --- directory is specified by the @HakyllConfiguration@, usually @_cache@. -storeInCache :: (Binary a) => a -> FilePath -> Hakyll () -storeInCache value path = do - cachePath <- toCache path - makeDirectories cachePath - liftIO $ encodeFile cachePath value - --- | Get a value from the cache. The filepath given should not be located in the --- cache. This function performs a timestamp check on the filepath and the --- filepath in the cache, and only returns the cached value when it is still --- up-to-date. -getFromCache :: (Binary a) => FilePath -> Hakyll a -getFromCache = liftIO . decodeFile <=< toCache - --- | Check if a file in the cache is more recent than a number of other files. -isCacheMoreRecent :: FilePath -> [FilePath] -> Hakyll Bool -isCacheMoreRecent file depends = toCache file >>= flip isFileMoreRecent depends - --- | Cache an entire arrow --- -cacheAction :: Binary a - => String - -> HakyllAction () a - -> HakyllAction () a -cacheAction key action = action { actionFunction = const cacheFunction } - where - cacheFunction = do - -- Construct a filename - fileName <- fmap (key </>) $ either id (const $ return "unknown") - $ actionUrl action - -- Check the cache - cacheOk <- isCacheMoreRecent fileName $ actionDependencies action - if cacheOk then getFromCache fileName - else do result <- actionFunction action () - storeInCache result fileName - return result diff --git a/src/Text/Hakyll/Internal/CompressCss.hs b/src/Text/Hakyll/Internal/CompressCss.hs deleted file mode 100644 index 4a78791..0000000 --- a/src/Text/Hakyll/Internal/CompressCss.hs +++ /dev/null @@ -1,36 +0,0 @@ --- | Module used for CSS compression. The compression is currently in a simple --- state, but would typically reduce the number of bytes by about 25%. -module Text.Hakyll.Internal.CompressCss - ( compressCss - ) where - -import Data.List (isPrefixOf) - -import Text.Hakyll.Regex (substituteRegex) - --- | Compress CSS to speed up your site. -compressCss :: String -> String -compressCss = compressSeparators - . stripComments - . compressWhitespace - --- | Compresses certain forms of separators. -compressSeparators :: String -> String -compressSeparators = substituteRegex "; *}" "}" - . substituteRegex " *([{};:]) *" "\\1" - . substituteRegex ";;*" ";" - --- | Compresses all whitespace. -compressWhitespace :: String -> String -compressWhitespace = substituteRegex "[ \t\n][ \t\n]*" " " - --- | Function that strips CSS comments away. -stripComments :: String -> String -stripComments [] = [] -stripComments str - | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str - | otherwise = head str : stripComments (drop 1 str) - where - eatComments str' | null str' = [] - | isPrefixOf "*/" str' = drop 2 str' - | otherwise = eatComments $ drop 1 str' diff --git a/src/Text/Hakyll/Internal/FileType.hs b/src/Text/Hakyll/Internal/FileType.hs deleted file mode 100644 index 689c77f..0000000 --- a/src/Text/Hakyll/Internal/FileType.hs +++ /dev/null @@ -1,49 +0,0 @@ --- | A module dealing with file extensions and associated file types. -module Text.Hakyll.Internal.FileType - ( FileType (..) - , getFileType - , isRenderable - , isRenderableFile - ) where - -import System.FilePath (takeExtension) - --- | Datatype to represent the different file types Hakyll can deal with. -data FileType = Html - | LaTeX - | LiterateHaskellMarkdown - | Markdown - | ReStructuredText - | Text - | UnknownFileType - deriving (Eq, Ord, Show, Read) - --- | Get the file type for a certain file. The type is determined by extension. -getFileType :: FilePath -> FileType -getFileType = getFileType' . takeExtension - where - getFileType' ".htm" = Html - getFileType' ".html" = Html - getFileType' ".lhs" = LiterateHaskellMarkdown - getFileType' ".markdown" = Markdown - getFileType' ".md" = Markdown - getFileType' ".mdn" = Markdown - getFileType' ".mdown" = Markdown - getFileType' ".mdwn" = Markdown - getFileType' ".mkd" = Markdown - getFileType' ".mkdwn" = Markdown - getFileType' ".page" = Markdown - getFileType' ".rst" = ReStructuredText - getFileType' ".tex" = LaTeX - getFileType' ".text" = Text - getFileType' ".txt" = Text - getFileType' _ = UnknownFileType - --- | Check if a certain @FileType@ is renderable. -isRenderable :: FileType -> Bool -isRenderable UnknownFileType = False -isRenderable _ = True - --- | Check if a certain file is renderable. -isRenderableFile :: FilePath -> Bool -isRenderableFile = isRenderable . getFileType diff --git a/src/Text/Hakyll/Internal/Template.hs b/src/Text/Hakyll/Internal/Template.hs deleted file mode 100644 index cd6a3bd..0000000 --- a/src/Text/Hakyll/Internal/Template.hs +++ /dev/null @@ -1,86 +0,0 @@ -module Text.Hakyll.Internal.Template - ( Template (..) - , fromString - , readTemplate - , substitute - , regularSubstitute - , finalSubstitute - ) where - -import Control.Arrow ((>>>)) -import Control.Applicative ((<$>)) -import Data.List (isPrefixOf) -import Data.Char (isAlphaNum) -import Data.Maybe (fromMaybe) -import System.FilePath ((</>)) -import qualified Data.Map as M - -import Text.Hakyll.Context (Context (..)) -import Text.Hakyll.HakyllMonad (Hakyll) -import Text.Hakyll.HakyllAction -import Text.Hakyll.Pandoc -import Text.Hakyll.Internal.Cache -import Text.Hakyll.Page -import Text.Hakyll.ContextManipulations -import Text.Hakyll.Internal.Template.Template -import Text.Hakyll.Internal.Template.Hamlet - --- | Construct a @Template@ from a string. --- -fromString :: String -> Template -fromString = Template . fromString' - where - fromString' [] = [] - fromString' string - | "$$" `isPrefixOf` string = - EscapeCharacter : (fromString' $ drop 2 string) - | "$" `isPrefixOf` string = - let (key, rest) = span isAlphaNum $ drop 1 string - in Identifier key : fromString' rest - | otherwise = - let (chunk, rest) = break (== '$') string - in Chunk chunk : fromString' rest - --- | Read a @Template@ from a file. This function might fetch the @Template@ --- from the cache, if available. -readTemplate :: FilePath -> Hakyll Template -readTemplate path = do - isCacheMoreRecent' <- isCacheMoreRecent fileName [path] - if isCacheMoreRecent' - then getFromCache fileName - else do - template <- if isHamletRTFile path - then readHamletTemplate - else readDefaultTemplate - storeInCache template fileName - return template - where - fileName = "templates" </> path - readDefaultTemplate = do - body <- runHakyllAction $ readPageAction path - >>> renderAction - >>> takeBody - return $ fromString body - - readHamletTemplate = fromHamletRT <$> readHamletRT path - --- | Substitutes @$identifiers@ in the given @Template@ by values from the given --- "Context". When a key is not found, it is left as it is. You can specify --- the characters used to replace escaped dollars (@$$@) here. -substitute :: String -> Template -> Context -> String -substitute escaper template context = substitute' =<< unTemplate template - where - substitute' (Chunk chunk) = chunk - substitute' (Identifier key) = - fromMaybe ('$' : key) $ M.lookup key $ unContext context - substitute' (EscapeCharacter) = escaper - --- | @substitute@ for use during a chain. This will leave escaped characters as --- they are. -regularSubstitute :: Template -> Context -> String -regularSubstitute = substitute "$$" - --- | @substitute@ for the end of a chain (just before writing). This renders --- escaped characters. -finalSubstitute :: Template -> Context -> String -finalSubstitute = substitute "$" diff --git a/src/Text/Hakyll/Internal/Template/Hamlet.hs b/src/Text/Hakyll/Internal/Template/Hamlet.hs deleted file mode 100644 index 458ab35..0000000 --- a/src/Text/Hakyll/Internal/Template/Hamlet.hs +++ /dev/null @@ -1,56 +0,0 @@ --- | Support for Hamlet templates in Hakyll. --- -module Text.Hakyll.Internal.Template.Hamlet - ( isHamletRTFile - , readHamletRT - , fromHamletRT - ) where - -import Control.Exception (try) -import Control.Monad.Trans (liftIO) -import System.FilePath (takeExtension) - -import Text.Hamlet.RT - -import Text.Hakyll.Internal.Template.Template -import Text.Hakyll.HakyllMonad (Hakyll, askHakyll, hamletSettings, logHakyll) - --- | Determine if a file is a hamlet template by extension. --- -isHamletRTFile :: FilePath -> Bool -isHamletRTFile fileName = takeExtension fileName `elem` [".hamlet", ".hml"] - --- | Read a 'HamletRT' by file name. --- -readHamletRT :: FilePath -- ^ Filename of the template - -> Hakyll HamletRT -- ^ Resulting hamlet template -readHamletRT fileName = do - settings <- askHakyll hamletSettings - string <- liftIO $ readFile fileName - result <- liftIO $ try $ parseHamletRT settings string - case result of - Left (HamletParseException s) -> error' s - Left (HamletUnsupportedDocException d) -> error' $ show d - Left (HamletRenderException s) -> error' s - Right x -> return x - where - error' s = do - logHakyll $ "Parse of hamlet file " ++ fileName ++ " failed." - logHakyll s - error "Parse failed." - --- | Convert a 'HamletRT' to a 'Template' --- -fromHamletRT :: HamletRT -- ^ Hamlet runtime template - -> Template -- ^ Hakyll template -fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd - where - fromSimpleDoc :: SimpleDoc -> TemplateElement - fromSimpleDoc (SDRaw chunk) = Chunk chunk - fromSimpleDoc (SDVar [var]) = Identifier var - fromSimpleDoc (SDVar _) = - error "Hakyll does not support '.' in identifier names when using \ - \hamlet templates." - fromSimpleDoc _ = - error "Only simple $key$ identifiers are allowed when using hamlet \ - \templates." diff --git a/src/Text/Hakyll/Internal/Template/Template.hs b/src/Text/Hakyll/Internal/Template/Template.hs deleted file mode 100644 index 49373fd..0000000 --- a/src/Text/Hakyll/Internal/Template/Template.hs +++ /dev/null @@ -1,34 +0,0 @@ --- | Module containing the template data structure. --- -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Text.Hakyll.Internal.Template.Template - ( Template (..) - , TemplateElement (..) - ) where - -import Control.Applicative ((<$>)) - -import Data.Binary (Binary, get, getWord8, put, putWord8) - --- | Datatype used for template substitutions. --- -newtype Template = Template { unTemplate :: [TemplateElement] } - deriving (Show, Eq, Binary) - --- | Elements of a template. --- -data TemplateElement = Chunk String - | Identifier String - | EscapeCharacter - deriving (Show, Eq) - -instance Binary TemplateElement where - put (Chunk string) = putWord8 0 >> put string - put (Identifier key) = putWord8 1 >> put key - put (EscapeCharacter) = putWord8 2 - - get = getWord8 >>= \tag -> - case tag of 0 -> Chunk <$> get - 1 -> Identifier <$> get - 2 -> return EscapeCharacter - _ -> error "Error reading cached template" |