WIP

7 files changed, 101 insertions, 111 deletions

diff --git a/src/Hakyll/Web/CompressCss.hs b/src/Hakyll/Web/CompressCss.hs
index d0ca8cd..133c7f0 100644
--- a/src/Hakyll/Web/CompressCss.hs
+++ b/src/Hakyll/Web/CompressCss.hs
@@ -1,50 +1,59 @@
+--------------------------------------------------------------------------------
 -- | 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 Hakyll.Web.CompressCss
     ( compressCssCompiler
     , compressCss
     ) where
 
-import Data.Char (isSpace)
-import Data.List (isPrefixOf)
-import Control.Arrow ((>>^))
 
-import Hakyll.Core.Compiler
-import Hakyll.Core.Util.String
+--------------------------------------------------------------------------------
+import           Control.Applicative     ((<$>))
+import           Data.Char               (isSpace)
+import           Data.List               (isPrefixOf)
 
+
+--------------------------------------------------------------------------------
+import           Hakyll.Core.Compiler
+import           Hakyll.Core.Util.String
+
+
+--------------------------------------------------------------------------------
 -- | Compiler form of 'compressCss'
---
-compressCssCompiler :: Compiler a String
-compressCssCompiler = getResourceString >>^ compressCss
+compressCssCompiler :: Compiler String
+compressCssCompiler = compressCss <$> getResourceString
+
 
+--------------------------------------------------------------------------------
 -- | Compress CSS to speed up your site.
---
 compressCss :: String -> String
-compressCss = compressSeparators
-            . stripComments
-            . compressWhitespace
+compressCss = compressSeparators . stripComments . compressWhitespace
 
+
+--------------------------------------------------------------------------------
 -- | Compresses certain forms of separators.
---
 compressSeparators :: String -> String
-compressSeparators = replaceAll "; *}" (const "}")
-                   . replaceAll " *([{};:]) *" (take 1 . dropWhile isSpace)
-                   . replaceAll ";+" (const ";")
+compressSeparators =
+    replaceAll "; *}" (const "}") .
+    replaceAll " *([{};:]) *" (take 1 . dropWhile isSpace) .
+    replaceAll ";+" (const ";")
+
 
+--------------------------------------------------------------------------------
 -- | Compresses all whitespace.
---
 compressWhitespace :: String -> String
 compressWhitespace = replaceAll "[ \t\n\r]+" (const " ")
 
+
+--------------------------------------------------------------------------------
 -- | 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'
+    eatComments str'
+        | null str' = []
+        | isPrefixOf "*/" str' = drop 2 str'
+        | otherwise = eatComments $ drop 1 str'
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index fc17735..ca98042 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -58,9 +58,6 @@ module Hakyll.Web.Page
 
 
 --------------------------------------------------------------------------------
-import           Control.Arrow            (arr, (>>>))
-import           Control.Category         (id)
-import           Prelude                  hiding (id)
 import           Text.Pandoc              (Pandoc, ParserState, WriterOptions)
 
 
@@ -72,14 +69,14 @@ import           Hakyll.Web.Pandoc
 
 --------------------------------------------------------------------------------
 -- | Read a page (do not render it)
-readPageCompiler :: Compiler () Page
+readPageCompiler :: Compiler Page
 readPageCompiler = getResourceBody
 {-# DEPRECATED readPageCompiler "Use getResourceBody" #-}
 
 
 --------------------------------------------------------------------------------
 -- | Read a page render using pandoc
-pageCompiler :: Compiler () Page
+pageCompiler :: Compiler Page
 pageCompiler =
     pageCompilerWith defaultHakyllParserState defaultHakyllWriterOptions
 
@@ -87,7 +84,7 @@ pageCompiler =
 --------------------------------------------------------------------------------
 -- | A version of 'pageCompiler' which allows you to specify your own pandoc
 -- options
-pageCompilerWith :: ParserState -> WriterOptions -> Compiler () Page
+pageCompilerWith :: ParserState -> WriterOptions -> Compiler Page
 pageCompilerWith state options = pageCompilerWithPandoc state options id
 
 
@@ -96,9 +93,9 @@ pageCompilerWith state options = pageCompilerWithPandoc state options id
 -- pandoc transformation for the content
 pageCompilerWithPandoc :: ParserState -> WriterOptions
                        -> (Pandoc -> Pandoc)
-                       -> Compiler () Page
+                       -> Compiler Page
 pageCompilerWithPandoc state options f = cached cacheName $
-    readPageCompiler >>> pageReadPandocWith state >>>
-    arr (writePandocWith options . f)
+    readPageCompiler >>= pageReadPandocWith state >>=
+    return . writePandocWith options . f
   where
     cacheName = "Hakyll.Web.Page.pageCompilerWithPandoc"
diff --git a/src/Hakyll/Web/Pandoc.hs b/src/Hakyll/Web/Pandoc.hs
index 7ebf4a2..caada26 100644
--- a/src/Hakyll/Web/Pandoc.hs
+++ b/src/Hakyll/Web/Pandoc.hs
@@ -10,7 +10,6 @@ module Hakyll.Web.Pandoc
       -- * Functions working on pages/compilers
     , pageReadPandoc
     , pageReadPandocWith
-    , pageReadPandocWithA
     , pageRenderPandoc
     , pageRenderPandocWith
 
@@ -21,37 +20,34 @@ module Hakyll.Web.Pandoc
 
 
 --------------------------------------------------------------------------------
-import           Control.Arrow              ((&&&), (***), (>>>), (>>^))
-import           Control.Category           (id)
+import           Control.Applicative        ((<$>))
 import           Data.Maybe                 (fromMaybe)
-import           Prelude                    hiding (id)
 import           Text.Pandoc
 
 
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
 import           Hakyll.Core.Identifier
-import           Hakyll.Core.Util.Arrow
 import           Hakyll.Web.Page.Internal
 import           Hakyll.Web.Pandoc.FileType
 
 
 --------------------------------------------------------------------------------
 -- | Read a string using pandoc, with the default options
-readPandoc :: FileType              -- ^ Determines how parsing happens
-           -> Maybe (Identifier a)  -- ^ Optional, for better error messages
-           -> Page                  -- ^ String to read
-           -> Pandoc                -- ^ Resulting document
+readPandoc :: FileType          -- ^ Determines how parsing happens
+           -> Maybe Identifier  -- ^ Optional, for better error messages
+           -> Page              -- ^ String to read
+           -> Pandoc            -- ^ Resulting document
 readPandoc = readPandocWith defaultHakyllParserState
 
 
 --------------------------------------------------------------------------------
 -- | Read a string using pandoc, with the supplied options
-readPandocWith :: ParserState           -- ^ Parser options
-               -> FileType              -- ^ Determines parsing method
-               -> Maybe (Identifier a)  -- ^ Optional, for better error messages
-               -> Page                  -- ^ String to read
-               -> Pandoc                -- ^ Resulting document
+readPandocWith :: ParserState       -- ^ Parser options
+               -> FileType          -- ^ Determines parsing method
+               -> Maybe Identifier  -- ^ Optional, for better error messages
+               -> Page              -- ^ String to read
+               -> Pandoc            -- ^ Resulting document
 readPandocWith state fileType' id' = case fileType' of
     Html              -> readHtml state
     LaTeX             -> readLaTeX state
@@ -82,38 +78,31 @@ writePandocWith = writeHtmlString
 
 --------------------------------------------------------------------------------
 -- | Read the resource using pandoc
-pageReadPandoc :: Compiler Page Pandoc
+pageReadPandoc :: Page -> Compiler Pandoc
 pageReadPandoc = pageReadPandocWith defaultHakyllParserState
 
 
 --------------------------------------------------------------------------------
 -- | Read the resource using pandoc
-pageReadPandocWith :: ParserState -> Compiler Page Pandoc
-pageReadPandocWith state = constA state &&& id >>> pageReadPandocWithA
-
-
---------------------------------------------------------------------------------
--- | Read the resource using pandoc. This is a (rarely needed) variant, which
--- comes in very useful when the parser state is the result of some arrow.
-pageReadPandocWithA :: Compiler (ParserState, Page) Pandoc
-pageReadPandocWithA =
-    id *** id &&& getIdentifier &&& getFileType >>^ pageReadPandocWithA'
-  where
-    pageReadPandocWithA' (s, (p, (i, t))) = readPandocWith s t (Just i) p
+pageReadPandocWith :: ParserState -> Page -> Compiler Pandoc
+pageReadPandocWith state page = do
+    identifier <- getIdentifier
+    fileType'  <- getFileType
+    return $ readPandocWith state fileType' (Just identifier) page
 
 
 --------------------------------------------------------------------------------
 -- | Render the resource using pandoc
-pageRenderPandoc :: Compiler Page Page
+pageRenderPandoc :: Page -> Compiler Page
 pageRenderPandoc =
     pageRenderPandocWith defaultHakyllParserState defaultHakyllWriterOptions
 
 
 --------------------------------------------------------------------------------
 -- | Render the resource using pandoc
-pageRenderPandocWith :: ParserState -> WriterOptions -> Compiler Page Page
-pageRenderPandocWith state options =
-    pageReadPandocWith state >>^ writePandocWith options
+pageRenderPandocWith :: ParserState -> WriterOptions -> Page -> Compiler Page
+pageRenderPandocWith state options page =
+    writePandocWith options <$> pageReadPandocWith state page
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Hakyll/Web/Pandoc/Biblio.hs b/src/Hakyll/Web/Pandoc/Biblio.hs
index 699ba31..ca8d10e 100644
--- a/src/Hakyll/Web/Pandoc/Biblio.hs
+++ b/src/Hakyll/Web/Pandoc/Biblio.hs
@@ -7,7 +7,9 @@
 -- refer to these files when you use 'pageReadPandocBiblio'. This function also
 -- takes a parser state for completeness -- you can use
 -- 'defaultHakyllParserState' if you're unsure.
-{-# LANGUAGE Arrows, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE Arrows                     #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Hakyll.Web.Pandoc.Biblio
     ( CSL
     , cslCompiler
@@ -18,21 +20,20 @@ module Hakyll.Web.Pandoc.Biblio
 
 
 --------------------------------------------------------------------------------
-import Control.Applicative ((<$>))
-import Control.Arrow (arr, returnA, (>>>))
-import Data.Typeable (Typeable)
-import Data.Binary (Binary (..))
-import Text.Pandoc (Pandoc, ParserState (..))
-import Text.Pandoc.Biblio (processBiblio)
-import qualified Text.CSL as CSL
+import           Control.Applicative    ((<$>))
+import           Data.Binary            (Binary (..))
+import           Data.Typeable          (Typeable)
+import qualified Text.CSL               as CSL
+import           Text.Pandoc            (Pandoc, ParserState (..))
+import           Text.Pandoc.Biblio     (processBiblio)
 
 
 --------------------------------------------------------------------------------
-import Hakyll.Core.Compiler
-import Hakyll.Core.Identifier
-import Hakyll.Core.Writable
-import Hakyll.Web.Page
-import Hakyll.Web.Pandoc
+import           Hakyll.Core.Compiler
+import           Hakyll.Core.Identifier
+import           Hakyll.Core.Writable
+import           Hakyll.Web.Page
+import           Hakyll.Web.Pandoc
 
 
 --------------------------------------------------------------------------------
@@ -41,8 +42,8 @@ newtype CSL = CSL FilePath
 
 
 --------------------------------------------------------------------------------
-cslCompiler :: Compiler () CSL
-cslCompiler = getIdentifier >>> arr (CSL . toFilePath)
+cslCompiler :: Compiler CSL
+cslCompiler = CSL . toFilePath <$> getIdentifier
 
 
 --------------------------------------------------------------------------------
@@ -61,26 +62,24 @@ instance Writable Biblio where
 
 
 --------------------------------------------------------------------------------
-biblioCompiler :: Compiler () Biblio
-biblioCompiler = getIdentifier >>>
-    arr toFilePath >>> unsafeCompiler CSL.readBiblioFile >>> arr Biblio
+biblioCompiler :: Compiler Biblio
+biblioCompiler = do
+    filePath <- toFilePath <$> getIdentifier
+    unsafeCompiler $ Biblio <$> CSL.readBiblioFile filePath
 
 
 --------------------------------------------------------------------------------
 pageReadPandocBiblio :: ParserState
-                     -> Identifier CSL
-                     -> Identifier Biblio
-                     -> Compiler Page Pandoc
-pageReadPandocBiblio state csl refs = proc page -> do
-    CSL csl' <- require_ csl -< ()
-    Biblio refs' <- require_ refs -< ()
+                     -> CSL
+                     -> Biblio
+                     -> Page
+                     -> Compiler Pandoc
+pageReadPandocBiblio state (CSL csl) (Biblio refs) page = do
     -- We need to know the citation keys, add then *before* actually parsing the
     -- actual page. If we don't do this, pandoc won't even consider them
     -- citations!
-    let cits   = map CSL.refId refs'
+    let cits   = map CSL.refId refs
         state' = state {stateCitations = stateCitations state ++ cits}
-    pandoc  <- pageReadPandocWithA -< (state', page)
-    pandoc' <- unsafeCompiler processBiblio' -< (csl', refs', pandoc)
-    returnA -< pandoc'
-  where
-    processBiblio' (c, r, p) = processBiblio c Nothing r p
+    pandoc  <- pageReadPandocWith state' page
+    pandoc' <- unsafeCompiler $ processBiblio csl Nothing refs pandoc
+    return pandoc'
diff --git a/src/Hakyll/Web/Pandoc/FileType.hs b/src/Hakyll/Web/Pandoc/FileType.hs
index db24da7..2d28edd 100644
--- a/src/Hakyll/Web/Pandoc/FileType.hs
+++ b/src/Hakyll/Web/Pandoc/FileType.hs
@@ -8,7 +8,7 @@ module Hakyll.Web.Pandoc.FileType
 
 
 --------------------------------------------------------------------------------
-import           Control.Arrow          ((>>^))
+import           Control.Applicative    ((<$>))
 import           System.FilePath        (takeExtension)
 
 
@@ -62,5 +62,5 @@ fileType = fileType' . takeExtension
 
 --------------------------------------------------------------------------------
 -- | Get the file type for the current file
-getFileType :: Compiler a FileType
-getFileType = getIdentifier >>^ fileType . toFilePath
+getFileType :: Compiler FileType
+getFileType = fileType . toFilePath <$> getIdentifier
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index 4273b79..6261a09 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -26,16 +26,14 @@ import           Hakyll.Web.Urls
 
 
 --------------------------------------------------------------------------------
-type Context a = Compiler (String, (Identifier a, a)) String
+type Context a = String -> Identifier -> a -> Compiler String
 
 
 --------------------------------------------------------------------------------
-field :: String -> Compiler (Identifier a, a) String -> Context a
-field key value = arr checkKey >>> (empty ||| value)
-  where
-    checkKey (k, x)
-        | k /= key  = Left ()
-        | otherwise = Right x
+field :: String -> (Identifier -> a -> Compiler String) -> Context a
+field key value k' id' x
+    | k' == key = value id' x
+    | otherwise = empty
 
 
 --------------------------------------------------------------------------------
@@ -51,7 +49,7 @@ defaultContext =
 
 --------------------------------------------------------------------------------
 bodyField :: String -> Context Page
-bodyField key = field key $ arr snd
+bodyField key = field key $ \_ x -> return x
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Hakyll/Web/Urls/Relativize.hs b/src/Hakyll/Web/Urls/Relativize.hs
index 0251cfe..068ae09 100644
--- a/src/Hakyll/Web/Urls/Relativize.hs
+++ b/src/Hakyll/Web/Urls/Relativize.hs
@@ -21,10 +21,7 @@ module Hakyll.Web.Urls.Relativize
 
 
 --------------------------------------------------------------------------------
-import           Control.Arrow        ((&&&), (>>^))
-import           Control.Category     (id)
 import           Data.List            (isPrefixOf)
-import           Prelude              hiding (id)
 
 
 --------------------------------------------------------------------------------
@@ -36,11 +33,12 @@ import           Hakyll.Web.Urls
 --------------------------------------------------------------------------------
 -- | Compiler form of 'relativizeUrls' which automatically picks the right root
 -- path
-relativizeUrlsCompiler :: Compiler Page Page
-relativizeUrlsCompiler = getRoute &&& id >>^ uncurry relativize
-  where
-    relativize Nothing  = id
-    relativize (Just r) = relativizeUrls $ toSiteRoot r
+relativizeUrlsCompiler :: Page -> Compiler Page
+relativizeUrlsCompiler page = do
+    route <- getRoute
+    return $ case route of
+        Nothing -> page
+        Just r  -> relativizeUrls (toSiteRoot r) page
 
 
 --------------------------------------------------------------------------------