Remove metacompilation

5 files changed, 44 insertions, 119 deletions

diff --git a/src/Hakyll/Core/CompiledItem.hs b/src/Hakyll/Core/CompiledItem.hs
index e40ab56..85e85b3 100644
--- a/src/Hakyll/Core/CompiledItem.hs
+++ b/src/Hakyll/Core/CompiledItem.hs
@@ -1,3 +1,4 @@
+--------------------------------------------------------------------------------
 -- | A module containing a box datatype representing a compiled item. This
 -- item can be of any type, given that a few restrictions hold:
 --
@@ -6,42 +7,49 @@
 -- * we need a 'Binary' instance so we can serialize these items to the cache;
 --
 -- * we need a 'Writable' instance so the results can be saved.
---
-{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable        #-}
+{-# LANGUAGE ExistentialQuantification #-}
 module Hakyll.Core.CompiledItem
     ( CompiledItem (..)
     , compiledItem
     , unCompiledItem
     ) where
 
-import Data.Binary (Binary)
-import Data.Typeable (Typeable, cast, typeOf)
-import Data.Maybe (fromMaybe)
 
-import Hakyll.Core.Writable
+--------------------------------------------------------------------------------
+import           Data.Binary          (Binary)
+import           Data.Maybe           (fromMaybe)
+import           Data.Typeable        (Typeable, cast, typeOf)
+
+
+--------------------------------------------------------------------------------
+import           Hakyll.Core.Writable
 
+
+--------------------------------------------------------------------------------
 -- | Box type for a compiled item
 --
 data CompiledItem =  forall a.  (Binary a, Typeable a, Writable a)
                   => CompiledItem a
                   deriving (Typeable)
 
+
+--------------------------------------------------------------------------------
 instance Writable CompiledItem where
     write p (CompiledItem x) = write p x
 
+
+--------------------------------------------------------------------------------
 -- | Box a value into a 'CompiledItem'
---
-compiledItem :: (Binary a, Typeable a, Writable a)
-             => a
-             -> CompiledItem
+compiledItem :: (Binary a, Typeable a, Writable a) => a -> CompiledItem
 compiledItem = CompiledItem
 
+
+--------------------------------------------------------------------------------
 -- | Unbox a value from a 'CompiledItem'
---
-unCompiledItem :: (Binary a, Typeable a, Writable a)
-               => CompiledItem
-               -> a
+unCompiledItem :: (Binary a, Typeable a, Writable a) => CompiledItem -> a
 unCompiledItem (CompiledItem x) = fromMaybe error' $ cast x
   where
-    error' = error $  "Hakyll.Core.CompiledItem.unCompiledItem: "
-                   ++ "unsupported type (got " ++ show (typeOf x) ++ ")"
+    error' = error $
+        "Hakyll.Core.CompiledItem.unCompiledItem: " ++
+        "unsupported type (got " ++ show (typeOf x) ++ ")"
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index ee3f90e..31b25e3 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -137,7 +137,6 @@ import Hakyll.Core.Writable
 import Hakyll.Core.ResourceProvider
 import Hakyll.Core.Compiler.Internal
 import Hakyll.Core.Store (Store)
-import Hakyll.Core.Rules.Internal
 import Hakyll.Core.Routes
 import Hakyll.Core.Logger
 import qualified Hakyll.Core.Store as Store
@@ -145,15 +144,15 @@ import qualified Hakyll.Core.Store as Store
 -- | Run a compiler, yielding the resulting target and it's dependencies. This
 -- version of 'runCompilerJob' also stores the result
 --
-runCompiler :: Compiler () CompileRule    -- ^ Compiler to run
-            -> Identifier ()              -- ^ Target identifier
-            -> ResourceProvider           -- ^ Resource provider
-            -> [Identifier ()]            -- ^ Universe
-            -> Routes                     -- ^ Route
-            -> Store                      -- ^ Store
-            -> Bool                       -- ^ Was the resource modified?
-            -> Logger                     -- ^ Logger
-            -> IO (Throwing CompileRule)  -- ^ Resulting item
+runCompiler :: Compiler () CompiledItem    -- ^ Compiler to run
+            -> Identifier ()               -- ^ Target identifier
+            -> ResourceProvider            -- ^ Resource provider
+            -> [Identifier ()]             -- ^ Universe
+            -> Routes                      -- ^ Route
+            -> Store                       -- ^ Store
+            -> Bool                        -- ^ Was the resource modified?
+            -> Logger                      -- ^ Logger
+            -> IO (Throwing CompiledItem)  -- ^ Resulting item
 runCompiler compiler id' provider universe routes store modified logger = do
     -- Run the compiler job
     result <- handle (\(e :: SomeException) -> return $ Left $ show e) $
@@ -165,7 +164,7 @@ runCompiler compiler id' provider universe routes store modified logger = do
         -- In case we compiled an item, we will store a copy in the cache first,
         -- before we return control. This makes sure the compiled item can later
         -- be accessed by e.g. require.
-        Right (CompileRule (CompiledItem x)) ->
+        Right (CompiledItem x) ->
             Store.set store ["Hakyll.Core.Compiler.runCompiler", show id'] x
 
         -- Otherwise, we do nothing here
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index 5ac63bc..ba89d75 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -25,15 +25,13 @@ module Hakyll.Core.Rules
     , create
     , route
     , resources
-    , metaCompile
-    , metaCompileWith
     , freshIdentifier
     ) where
 
 
 --------------------------------------------------------------------------------
 import           Control.Applicative            ((<$>))
-import           Control.Arrow                  (arr, (***), (>>>), (>>^))
+import           Control.Arrow                  (arr, (***), (>>>))
 import           Control.Monad.Reader           (ask, local)
 import           Control.Monad.State            (get, put)
 import           Control.Monad.Writer           (tell)
@@ -73,7 +71,7 @@ tellCompilers compilers = RulesM $ do
     let compilers' = map (castIdentifier *** boxCompiler) compilers
     tell $ RuleSet mempty compilers' mempty
   where
-    boxCompiler = (>>> arr compiledItem >>> arr CompileRule)
+    boxCompiler = (>>> arr compiledItem)
 
 
 --------------------------------------------------------------------------------
@@ -188,72 +186,8 @@ resources = RulesM $ do
 
 
 --------------------------------------------------------------------------------
--- | Apart from regular compilers, one is also able to specify metacompilers.
--- Metacompilers are a special class of compilers: they are compilers which
--- produce other compilers.
---
--- This is needed when the list of compilers depends on something we cannot know
--- before actually running other compilers. The most typical example is if we
--- have a blogpost using tags.
---
--- Every post has a collection of tags. For example,
---
--- > post1: code, haskell
--- > post2: code, random
---
--- Now, we want to create a list of posts for every tag. We cannot write this
--- down in our 'Rules' DSL directly, since we don't know what tags the different
--- posts will have -- we depend on information that will only be available when
--- we are actually compiling the pages.
---
--- The solution is simple, using 'metaCompile', we can add a compiler that will
--- parse the pages and produce the compilers needed for the different tag pages.
---
--- And indeed, we can see that the first argument to 'metaCompile' is a
--- 'Compiler' which produces a list of ('Identifier', 'Compiler') pairs. The
--- idea is simple: 'metaCompile' produces a list of compilers, and the
--- corresponding identifiers.
---
--- For simple hakyll systems, it is no need for this construction. More
--- formally, it is only needed when the content of one or more items determines
--- which items must be rendered.
-metaCompile :: (Binary a, Typeable a, Writable a)
-            => Compiler () [(Identifier a, Compiler () a)]
-            -- ^ Compiler generating the other compilers
-            -> Rules
-            -- ^ Resulting rules
-metaCompile compiler = do
-    id' <- freshIdentifier "Hakyll.Core.Rules.metaCompile"
-    metaCompileWith id' compiler
-
-
---------------------------------------------------------------------------------
--- | Version of 'metaCompile' that allows you to specify a custom identifier for
--- the metacompiler.
-metaCompileWith :: (Binary a, Typeable a, Writable a)
-                => Identifier ()
-                -- ^ Identifier for this compiler
-                -> Compiler () [(Identifier a, Compiler () a)]
-                -- ^ Compiler generating the other compilers
-                -> Rules
-                -- ^ Resulting rules
-metaCompileWith identifier compiler = RulesM $ do
-    group' <- rulesGroup <$> ask
-
-    let -- Set the correct group on the identifier
-        id' = setGroup group' identifier
-        -- Function to box an item into a rule
-        makeRule = MetaCompileRule . map (castIdentifier *** box)
-        -- Entire boxing function
-        box = (>>> fromDependency id' >>^ CompileRule . compiledItem)
-        -- Resulting compiler list
-        compilers = [(id', compiler >>> arr makeRule )]
-
-    tell $ RuleSet mempty compilers mempty
-
-
---------------------------------------------------------------------------------
 -- | Generate a fresh Identifier with a given prefix
+-- TODO: remove?
 freshIdentifier :: String                 -- ^ Prefix
                 -> RulesM (Identifier a)  -- ^ Fresh identifier
 freshIdentifier prefix = RulesM $ do
diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs
index 245d935..dc2badd 100644
--- a/src/Hakyll/Core/Rules/Internal.hs
+++ b/src/Hakyll/Core/Rules/Internal.hs
@@ -3,8 +3,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE Rank2Types                 #-}
 module Hakyll.Core.Rules.Internal
-    ( CompileRule (..)
-    , RuleSet (..)
+    ( RuleSet (..)
     , RuleState (..)
     , RuleEnvironment (..)
     , RulesM (..)
@@ -31,23 +30,12 @@ import           Hakyll.Core.Routes
 
 
 --------------------------------------------------------------------------------
--- | Output of a compiler rule
---
--- * The compiler will produce a simple item. This is the most common case.
---
--- * The compiler will produce more compilers. These new compilers need to be
---   added to the runtime if possible, since other items might depend upon them.
-data CompileRule = CompileRule CompiledItem
-                 | MetaCompileRule [(Identifier (), Compiler () CompileRule)]
-
-
---------------------------------------------------------------------------------
 -- | A collection of rules for the compilation process
 data RuleSet = RuleSet
     { -- | Routes used in the compilation structure
       rulesRoutes    :: Routes
     , -- | Compilation rules
-      rulesCompilers :: [(Identifier (), Compiler () CompileRule)]
+      rulesCompilers :: [(Identifier (), Compiler () CompiledItem)]
     , -- | A set of the actually used files
       rulesResources :: Set (Identifier ())
     }
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index ff7acac..5c0e1c8 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -18,6 +18,7 @@ import System.FilePath ((</>))
 import qualified Data.Map as M
 import qualified Data.Set as S
 
+import Hakyll.Core.CompiledItem
 import Hakyll.Core.Compiler
 import Hakyll.Core.Compiler.Internal
 import Hakyll.Core.Configuration
@@ -94,7 +95,7 @@ data RuntimeEnvironment = RuntimeEnvironment
 
 data RuntimeState = RuntimeState
     { hakyllAnalyzer  :: DependencyAnalyzer (Identifier ())
-    , hakyllCompilers :: Map (Identifier ()) (Compiler () CompileRule)
+    , hakyllCompilers :: Map (Identifier ()) (Compiler () CompiledItem)
     }
 
 newtype Runtime a = Runtime
@@ -104,7 +105,7 @@ newtype Runtime a = Runtime
 
 -- | Add a number of compilers and continue using these compilers
 --
-addNewCompilers :: [(Identifier (), Compiler () CompileRule)]
+addNewCompilers :: [(Identifier (), Compiler () CompiledItem)]
                 -- ^ Compilers to add
                 -> Runtime ()
 addNewCompilers newCompilers = Runtime $ do
@@ -190,8 +191,8 @@ build id' = Runtime $ do
                     store isModified logger
 
     case result of
-        -- Compile rule for one item, easy stuff
-        Right (CompileRule compiled) -> do
+        -- Success
+        Right compiled -> do
             case runRoutes routes id' of
                 Nothing  -> return ()
                 Just url -> timed logger ("Routing to " ++ url) $ do
@@ -204,10 +205,5 @@ build id' = Runtime $ do
             -- Continue for the remaining compilers
             unRuntime stepAnalyzer
 
-        -- Metacompiler, slightly more complicated
-        Right (MetaCompileRule newCompilers) ->
-            -- Actually I was just kidding, it's not hard at all
-            unRuntime $ addNewCompilers newCompilers
-
         -- Some error happened, rethrow in Runtime monad
         Left err -> throwError err