diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Hakyll/Core/Compiler.hs | 104 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules.hs | 12 | ||||
| -rw-r--r-- | src/Hakyll/Core/Run.hs | 30 | ||||
| -rw-r--r-- | src/Hakyll/Core/Target.hs | 31 | ||||
| -rw-r--r-- | src/Hakyll/Core/Target/Internal.hs | 66 | ||||
| -rw-r--r-- | src/Hakyll/Web/FileType.hs | 8 | ||||
| -rw-r--r-- | src/Hakyll/Web/Pandoc.hs | 6 |
7 files changed, 98 insertions, 159 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index 8a87fef..c4a7b06 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -4,26 +4,32 @@ module Hakyll.Core.Compiler ( Dependencies , CompilerM - , Compiler + , Compiler (..) , runCompiler + , getIdentifier + , getResourceString , require - , requireAll - , compileFromString + -- , requireAll + -- , compileFromString ) where -import Control.Arrow (second) +import Prelude hiding ((.), id) +import Control.Arrow (second, (>>>)) import Control.Applicative (Applicative, (<$>)) import Control.Monad.State (State, modify, runState) import Control.Monad.Reader (ReaderT, ask, runReaderT) +import Control.Monad.Trans (liftIO) +import Control.Monad ((<=<)) import Data.Set (Set) import qualified Data.Set as S -import Data.Typeable (Typeable) +import Control.Category (Category, (.), id) +import Control.Arrow (Arrow, arr, first) + import Data.Binary (Binary) +import Data.Typeable (Typeable) import Hakyll.Core.Identifier import Hakyll.Core.Identifier.Pattern -import Hakyll.Core.Target -import Hakyll.Core.Target.Internal import Hakyll.Core.CompiledItem import Hakyll.Core.Writable import Hakyll.Core.ResourceProvider @@ -32,65 +38,92 @@ import Hakyll.Core.ResourceProvider -- type Dependencies = Set Identifier --- | Add one dependency +-- | A lookup with which we can get dependencies -- -addDependency :: Identifier -> CompilerM () -addDependency dependency = CompilerM $ modify $ addDependency' - where - addDependency' x = x - { compilerDependencies = S.insert dependency $ compilerDependencies x - } +type DependencyLookup = Identifier -> CompiledItem -- | Environment in which a compiler runs -- data CompilerEnvironment = CompilerEnvironment { compilerIdentifier :: Identifier -- ^ Target identifier , compilerResourceProvider :: ResourceProvider -- ^ Resource provider - } - --- | State carried along by a compiler --- -data CompilerState = CompilerState - { compilerDependencies :: Dependencies + , compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup } -- | The compiler monad -- newtype CompilerM a = CompilerM - { unCompilerM :: ReaderT CompilerEnvironment (State CompilerState) a + { unCompilerM :: ReaderT CompilerEnvironment IO a } deriving (Monad, Functor, Applicative) --- | Simplified type for a compiler generating a target (which covers most --- cases) +-- | The compiler arrow -- -type Compiler a = CompilerM (TargetM a) +data Compiler a b = Compiler + { -- TODO: Reader ResourceProvider Dependencies + compilerDependencies :: Dependencies + , compilerJob :: a -> CompilerM b + } + +instance Category Compiler where + id = Compiler S.empty return + (Compiler d1 j1) . (Compiler d2 j2) = + Compiler (d1 `S.union` d2) (j1 <=< j2) + +instance Arrow Compiler where + arr f = Compiler S.empty (return . f) + first (Compiler d j) = Compiler d $ \(x, y) -> do + x' <- j x + return (x', y) -- | Run a compiler, yielding the resulting target and it's dependencies -- -runCompiler :: Compiler a -> Identifier -> ResourceProvider - -> (TargetM a, Dependencies) -runCompiler compiler identifier provider = second compilerDependencies $ - runState (runReaderT (unCompilerM compiler) env) state +runCompiler :: Compiler () a + -> Identifier + -> ResourceProvider + -> DependencyLookup + -> IO a +runCompiler compiler identifier provider lookup' = + runReaderT (unCompilerM $ compilerJob compiler ()) env where - state = CompilerState S.empty env = CompilerEnvironment { compilerIdentifier = identifier , compilerResourceProvider = provider + , compilerDependencyLookup = lookup' } +addDependency :: Identifier + -> Compiler b b +addDependency id' = Compiler (S.singleton id') return + +fromCompilerM :: (a -> CompilerM b) + -> Compiler a b +fromCompilerM = Compiler S.empty + +getIdentifier :: Compiler () Identifier +getIdentifier = fromCompilerM $ const $ CompilerM $ + compilerIdentifier <$> ask + +getResourceString :: Compiler () String +getResourceString = getIdentifier >>> getResourceString' + where + getResourceString' = fromCompilerM $ \id' -> CompilerM $ do + provider <- compilerResourceProvider <$> ask + liftIO $ resourceString provider id' -- | Require another target. Using this function ensures automatic handling of -- dependencies -- require :: (Binary a, Typeable a, Writable a) => Identifier - -> Compiler a -require identifier = do - addDependency identifier - return $ TargetM $ do - lookup' <- targetDependencyLookup <$> ask - return $ unCompiledItem $ lookup' identifier + -> (a -> b -> c) + -> Compiler b c +require identifier f = addDependency identifier >>> fromCompilerM require' + where + require' x = CompilerM $ do + lookup' <- compilerDependencyLookup <$> ask + return $ f (unCompiledItem $ lookup' identifier) x +{- -- | Require a number of targets. Using this function ensures automatic handling -- of dependencies -- @@ -108,3 +141,4 @@ requireAll pattern = CompilerM $ do compileFromString :: (String -> TargetM a) -- ^ Function to create the target -> Compiler a -- ^ Resulting compiler compileFromString = return . (getResourceString >>=) +-} diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs index 021af5d..de7f6d4 100644 --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -15,7 +15,7 @@ module Hakyll.Core.Rules import Control.Applicative (Applicative, (<$>)) import Control.Monad.Writer import Control.Monad.Reader -import Control.Arrow (second) +import Control.Arrow (second, (>>>), arr) import Data.Typeable (Typeable) import Data.Binary (Binary) @@ -32,7 +32,7 @@ import Hakyll.Core.Writable -- data RuleSet = RuleSet { rulesRoute :: Route - , rulesCompilers :: [(Identifier, Compiler CompiledItem)] + , rulesCompilers :: [(Identifier, Compiler () CompiledItem)] } instance Monoid RuleSet where @@ -64,12 +64,12 @@ addRoute route' = RulesM $ tell $ RuleSet route' mempty -- | Add a number of compilers -- addCompilers :: (Binary a, Typeable a, Writable a) - => [(Identifier, Compiler a)] + => [(Identifier, Compiler () a)] -> Rules addCompilers compilers = RulesM $ tell $ RuleSet mempty $ map (second boxCompiler) compilers where - boxCompiler = fmap (fmap compiledItem) + boxCompiler = (>>> arr compiledItem) -- | Add a compilation rule -- @@ -77,7 +77,7 @@ addCompilers compilers = RulesM $ tell $ RuleSet mempty $ -- the given compiler -- compile :: (Binary a, Typeable a, Writable a) - => Pattern -> Compiler a -> Rules + => Pattern -> Compiler () a -> Rules compile pattern compiler = RulesM $ do identifiers <- matches pattern . resourceList <$> ask unRulesM $ addCompilers $ zip identifiers (repeat compiler) @@ -87,7 +87,7 @@ compile pattern compiler = RulesM $ do -- This sets a compiler for the given identifier -- create :: (Binary a, Typeable a, Writable a) - => Identifier -> Compiler a -> Rules + => Identifier -> Compiler () a -> Rules create identifier compiler = addCompilers [(identifier, compiler)] -- | Add a route diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index 1a79aa9..3bd1e6b 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -11,12 +11,12 @@ import Data.Binary (Binary) import System.FilePath ((</>)) import Hakyll.Core.Route +import Hakyll.Core.Identifier import Hakyll.Core.Util.File import Hakyll.Core.Compiler import Hakyll.Core.ResourceProvider import Hakyll.Core.ResourceProvider.FileResourceProvider import Hakyll.Core.Rules -import Hakyll.Core.Target import Hakyll.Core.DirectedGraph import Hakyll.Core.DirectedGraph.Dot import Hakyll.Core.DirectedGraph.DependencySolver @@ -38,22 +38,20 @@ hakyllWith rules provider store = do -- Get all identifiers and compilers compilers = rulesCompilers ruleSet - -- Get all targets - targets = flip map compilers $ \(id', compiler) -> - let (targ, deps) = runCompiler compiler id' provider - in (id', targ, deps) + -- Get all dependencies + dependencies = flip map compilers $ \(id', compiler) -> + let deps = compilerDependencies compiler + in (id', deps) - -- Map mapping every identifier to it's target - targetMap = M.fromList $ map (\(i, t, _) -> (i, t)) targets + -- Create a compiler map + compilerMap = M.fromList compilers - -- Create a dependency graph - graph = fromList $ map (\(i, _, d) -> (i, d)) targets - - -- Solve the graph, creating a target order + -- Create and solve the graph, creating a compiler order + graph = fromList dependencies ordered = solveDependencies graph - -- Join the order with the targets again - orderedTargets = map (id &&& (targetMap M.!)) ordered + -- Join the order with the compilers again + orderedCompilers = map (id &&& (compilerMap M.!)) ordered -- Fetch the routes route' = rulesRoute ruleSet @@ -62,12 +60,12 @@ hakyllWith rules provider store = do writeDot "dependencies.dot" show graph -- Generate all the targets in order - _ <- foldM (addTarget route') M.empty orderedTargets + _ <- foldM (addTarget route') M.empty orderedCompilers putStrLn "DONE." where - addTarget route' map' (id', targ) = do - compiled <- runTarget targ id' (dependencyLookup map') provider store + addTarget route' map' (id', comp) = do + compiled <- runCompiler comp id' provider (dependencyLookup map') putStrLn $ "Generated target: " ++ show id' case runRoute route' id' of diff --git a/src/Hakyll/Core/Target.hs b/src/Hakyll/Core/Target.hs deleted file mode 100644 index 452fb57..0000000 --- a/src/Hakyll/Core/Target.hs +++ /dev/null @@ -1,31 +0,0 @@ --- | A target represents one compilation unit, e.g. a blog post, a CSS file... --- -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Hakyll.Core.Target - ( DependencyLookup - , TargetM - , runTarget - , getIdentifier - , getResourceString - ) where - -import Control.Applicative ((<$>)) -import Control.Monad.Reader (ask) -import Control.Monad.Trans (liftIO) - -import Hakyll.Core.Identifier -import Hakyll.Core.Target.Internal -import Hakyll.Core.ResourceProvider - --- | Get the current identifier --- -getIdentifier :: TargetM Identifier -getIdentifier = TargetM $ targetIdentifier <$> ask - --- | Get the resource content as a string --- -getResourceString :: TargetM String -getResourceString = TargetM $ do - provider <- targetResourceProvider <$> ask - identifier <- unTargetM getIdentifier - liftIO $ resourceString provider identifier diff --git a/src/Hakyll/Core/Target/Internal.hs b/src/Hakyll/Core/Target/Internal.hs deleted file mode 100644 index 62fb4fc..0000000 --- a/src/Hakyll/Core/Target/Internal.hs +++ /dev/null @@ -1,66 +0,0 @@ --- | Internal structure of a Target, not exported outside of the library --- -{-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-} -module Hakyll.Core.Target.Internal - ( DependencyLookup - , TargetEnvironment (..) - , TargetM (..) - , runTarget - ) where - -import Control.Applicative (Applicative) -import Control.Monad.Trans (MonadIO) -import Control.Monad.Reader (ReaderT, runReaderT) -import Control.Monad.State (StateT, evalStateT) - -import Hakyll.Core.Identifier -import Hakyll.Core.ResourceProvider -import Hakyll.Core.Store -import Hakyll.Core.CompiledItem - --- | A lookup with which we can get dependencies --- -type DependencyLookup = Identifier -> CompiledItem - --- | Environment for the target monad --- -data TargetEnvironment = TargetEnvironment - { targetIdentifier :: Identifier -- ^ Identifier - , targetDependencyLookup :: DependencyLookup -- ^ Dependency lookup - , targetResourceProvider :: ResourceProvider -- ^ To get resources - , targetStore :: Store -- ^ Store for caching - } - --- | State for the target monad --- -data TargetState = TargetState - { targetSnapshot :: Int -- ^ Snapshot ID - } - --- | Monad for targets. In this monad, the user can compose targets and describe --- how they should be created. --- -newtype TargetM a = TargetM - { unTargetM :: ReaderT TargetEnvironment (StateT TargetState IO) a - } deriving (Monad, Functor, Applicative, MonadIO) - --- | Run a target, yielding an actual result. --- -runTarget :: TargetM a - -> Identifier - -> DependencyLookup - -> ResourceProvider - -> Store - -> IO a -runTarget target id' lookup' provider store = - evalStateT (runReaderT (unTargetM target) env) state - where - env = TargetEnvironment - { targetIdentifier = id' - , targetDependencyLookup = lookup' - , targetResourceProvider = provider - , targetStore = store - } - state = TargetState - { targetSnapshot = 0 - } diff --git a/src/Hakyll/Web/FileType.hs b/src/Hakyll/Web/FileType.hs index a958fed..d5a9c56 100644 --- a/src/Hakyll/Web/FileType.hs +++ b/src/Hakyll/Web/FileType.hs @@ -7,10 +7,10 @@ module Hakyll.Web.FileType ) where import System.FilePath (takeExtension) -import Control.Applicative ((<$>)) +import Control.Arrow ((>>>), arr) import Hakyll.Core.Identifier -import Hakyll.Core.Target +import Hakyll.Core.Compiler -- | Datatype to represent the different file types Hakyll can deal with by -- default @@ -51,5 +51,5 @@ fileType = fileType' . takeExtension -- | Get the file type for the current file -- -getFileType :: TargetM FileType -getFileType = fileType . toFilePath <$> getIdentifier +getFileType :: Compiler () FileType +getFileType = getIdentifier >>> arr (fileType . toFilePath) diff --git a/src/Hakyll/Web/Pandoc.hs b/src/Hakyll/Web/Pandoc.hs index 17cac81..653c711 100644 --- a/src/Hakyll/Web/Pandoc.hs +++ b/src/Hakyll/Web/Pandoc.hs @@ -8,10 +8,12 @@ module Hakyll.Web.Pandoc , writePandocWith -- * Functions working on pages/targets + {- , pageReadPandoc , pageReadPandocWith , pageRenderPandoc , pageRenderPandocWith + -} -- * Default options , defaultParserState @@ -23,7 +25,7 @@ import Control.Applicative ((<$>)) import Text.Pandoc (Pandoc) import qualified Text.Pandoc as P -import Hakyll.Core.Target +import Hakyll.Core.Compiler import Hakyll.Web.FileType import Hakyll.Web.Page @@ -62,6 +64,7 @@ writePandocWith :: P.WriterOptions -- ^ Writer options for pandoc -> String -- ^ Resulting HTML writePandocWith = P.writeHtmlString +{- -- | Read the resource using pandoc -- pageReadPandoc :: Page String -> TargetM (Page Pandoc) @@ -88,6 +91,7 @@ pageRenderPandocWith :: P.ParserState pageRenderPandocWith state options page = do pandoc <- pageReadPandocWith state page return $ writePandocWith options <$> pandoc +-} -- | The default reader options for pandoc parsing in hakyll -- |