Added Text.Hakyll.Internal.FileType module.

3 files changed, 60 insertions, 26 deletions

diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs
index 438f9fe..b428a78 100644
--- a/src/Text/Hakyll/File.hs
+++ b/src/Text/Hakyll/File.hs
@@ -24,6 +24,7 @@ import Data.Ord (comparing)
 import Control.Monad.Reader (liftIO)
 
 import Text.Hakyll.Hakyll
+import Text.Hakyll.Internal.FileType (isRenderableFile)
 
 -- | Auxiliary function to remove pathSeparators form the start. We don't deal
 --   with absolute paths here. We also remove $root from the start.
@@ -62,7 +63,7 @@ toUrl :: FilePath -> Hakyll FilePath
 toUrl path = do enableIndexUrl' <- askHakyll enableIndexUrl
                 -- If the file does not have a renderable extension, like for
                 -- example favicon.ico, we don't have to change it at all.
-                return $ if not hasRenderableExtension
+                return $ if not (isRenderableFile path)
                             then path
                             -- If index url's are enabled, we create pick it
                             -- unless the page is an index already.
@@ -70,20 +71,6 @@ toUrl path = do enableIndexUrl' <- askHakyll enableIndexUrl
                                 then indexUrl
                                 else withSimpleHtmlExtension
   where
-    hasRenderableExtension = takeExtension path `elem` [ ".markdown"
-                                                       , ".md"
-                                                       , ".mdn"
-                                                       , ".mdwn"
-                                                       , ".mkd"
-                                                       , ".mkdn"
-                                                       , ".mkdwn"
-                                                       , ".rst"
-                                                       , ".text"
-                                                       , ".tex"
-                                                       , ".lhs"
-                                                       , ".htm"
-                                                       , ".html"
-                                                       ]
     isIndex = dropExtension (takeFileName path) == "index"
     withSimpleHtmlExtension = flip addExtension ".html" $ dropExtension path
     indexUrl = dropExtension path ++ "/"
diff --git a/src/Text/Hakyll/Internal/FileType.hs b/src/Text/Hakyll/Internal/FileType.hs
new file mode 100644
index 0000000..e3a73cd
--- /dev/null
+++ b/src/Text/Hakyll/Internal/FileType.hs
@@ -0,0 +1,45 @@
+-- | 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
+              | 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' ".rst"      = ReStructuredText
+    getFileType' ".tex"      = LaTeX
+    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/Page.hs b/src/Text/Hakyll/Internal/Page.hs
index 657ea77..5168161 100644
--- a/src/Text/Hakyll/Internal/Page.hs
+++ b/src/Text/Hakyll/Internal/Page.hs
@@ -17,6 +17,7 @@ import Text.Hakyll.Hakyll
 import Text.Hakyll.Regex (substituteRegex, matchesRegex)
 import Text.Hakyll.Util (trim)
 import Text.Hakyll.Internal.Cache
+import Text.Hakyll.Internal.FileType
 
 -- | The default reader options for pandoc parsing.
 readerOptions :: ParserState
@@ -35,18 +36,19 @@ writerOptions = defaultWriterOptions
     }
 
 -- | Get a render function for a given extension.
-getRenderFunction :: String -> (String -> String)
-getRenderFunction ".html" = id
-getRenderFunction ".htm"  = id
-getRenderFunction ext = writeHtmlString writerOptions
-                      . readFunction ext (readOptions ext)
+getRenderFunction :: FileType -> (String -> String)
+getRenderFunction Html     = id
+getRenderFunction fileType = writeHtmlString writerOptions
+                           . readFunction fileType (readOptions fileType)
   where
-    readFunction ".rst" = readRST
-    readFunction ".tex" = readLaTeX
-    readFunction _      = readMarkdown
+    readFunction ReStructuredText = readRST
+    readFunction LaTeX            = readLaTeX
+    readFunction Markdown         = readMarkdown
+    readFunction t                = error $ "Cannot render file " ++ show t
 
-    readOptions ".lhs"  = readerOptions { stateLiterateHaskell = True }
-    readOptions _       = readerOptions
+    readOptions LiterateHaskellMarkdown =
+        readerOptions { stateLiterateHaskell = True }
+    readOptions _                       = readerOptions
 
 -- | Split a page into sections.
 splitAtDelimiters :: [String] -> [[String]]
@@ -89,7 +91,7 @@ readSection renderFunction isFirst ls
 --   has a @.markdown@ extension, it will be rendered using pandoc.
 readPageFromFile :: FilePath -> Hakyll Context
 readPageFromFile path = do
-    let renderFunction = getRenderFunction $ takeExtension path
+    let renderFunction = getRenderFunction $ getFileType path
         sectionFunctions = map (readSection renderFunction)
                                (True : repeat False)