diff options
Diffstat (limited to 'src/Hakyll/Core')
| -rw-r--r-- | src/Hakyll/Core/Compiler.hs | 32 | ||||
| -rw-r--r-- | src/Hakyll/Core/Compiler/Internal.hs | 24 | ||||
| -rw-r--r-- | src/Hakyll/Core/Identifier.hs | 29 | ||||
| -rw-r--r-- | src/Hakyll/Core/Identifier/Pattern.hs | 57 | ||||
| -rw-r--r-- | src/Hakyll/Core/Resource.hs | 4 | ||||
| -rw-r--r-- | src/Hakyll/Core/Routes.hs | 13 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules.hs | 45 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules/Internal.hs | 8 | ||||
| -rw-r--r-- | src/Hakyll/Core/Run.hs | 10 | ||||
| -rw-r--r-- | src/Hakyll/Core/Store.hs | 6 | ||||
| -rw-r--r-- | src/Hakyll/Core/Writable.hs | 4 |
11 files changed, 135 insertions, 97 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index 2164dda..02e59ac 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -142,9 +142,9 @@ import Hakyll.Core.Logger -- version of 'runCompilerJob' also stores the result -- runCompiler :: Compiler () CompileRule -- ^ Compiler to run - -> Identifier -- ^ Target identifier + -> Identifier () -- ^ Target identifier -> ResourceProvider -- ^ Resource provider - -> [Identifier] -- ^ Universe + -> [Identifier ()] -- ^ Universe -> Routes -- ^ Route -> Store -- ^ Store -> Bool -- ^ Was the resource modified? @@ -161,7 +161,8 @@ runCompiler compiler id' provider universe routes store modified logger = do -- before we return control. This makes sure the compiled item can later -- be accessed by e.g. require. Right (CompileRule (CompiledItem x)) -> - storeSet store "Hakyll.Core.Compiler.runCompiler" id' x + storeSet store "Hakyll.Core.Compiler.runCompiler" + (castIdentifier id') x -- Otherwise, we do nothing here _ -> return () @@ -170,8 +171,9 @@ runCompiler compiler id' provider universe routes store modified logger = do -- | Get the identifier of the item that is currently being compiled -- -getIdentifier :: Compiler a Identifier -getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask +getIdentifier :: Compiler a (Identifier b) +getIdentifier = fromJob $ const $ CompilerM $ + castIdentifier . compilerIdentifier <$> ask -- | Get the route we are using for this item -- @@ -180,7 +182,7 @@ getRoute = getIdentifier >>> getRouteFor -- | Get the route for a specified item -- -getRouteFor :: Compiler Identifier (Maybe FilePath) +getRouteFor :: Compiler (Identifier a) (Maybe FilePath) getRouteFor = fromJob $ \identifier -> CompilerM $ do routes <- compilerRoutes <$> ask return $ runRoutes routes identifier @@ -212,7 +214,7 @@ getResourceWith reader = fromJob $ \resource -> CompilerM $ do -- | Auxiliary: get a dependency -- getDependency :: (Binary a, Writable a, Typeable a) - => Identifier -> CompilerM a + => Identifier a -> CompilerM a getDependency id' = CompilerM $ do store <- compilerStore <$> ask result <- liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" id' @@ -233,7 +235,7 @@ getDependency id' = CompilerM $ do -- | Variant of 'require' which drops the current value -- require_ :: (Binary a, Typeable a, Writable a) - => Identifier + => Identifier a -> Compiler b a require_ identifier = fromDependency identifier >>> fromJob (const $ getDependency identifier) @@ -242,7 +244,7 @@ require_ identifier = -- dependencies -- require :: (Binary a, Typeable a, Writable a) - => Identifier + => Identifier a -> (b -> a -> c) -> Compiler b c require identifier = requireA identifier . arr . uncurry @@ -250,7 +252,7 @@ require identifier = requireA identifier . arr . uncurry -- | Arrow-based variant of 'require' -- requireA :: (Binary a, Typeable a, Writable a) - => Identifier + => Identifier a -> Compiler (b, a) c -> Compiler b c requireA identifier = (id &&& require_ identifier >>>) @@ -258,11 +260,11 @@ requireA identifier = (id &&& require_ identifier >>>) -- | Variant of 'requireAll' which drops the current value -- requireAll_ :: (Binary a, Typeable a, Writable a) - => Pattern + => Pattern a -> Compiler b [a] requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_' where - getDeps = filterMatches pattern + getDeps = map castIdentifier . filterMatches pattern . map castIdentifier requireAll_' = const $ CompilerM $ do deps <- getDeps . compilerUniverse <$> ask mapM (unCompilerM . getDependency) deps @@ -271,7 +273,7 @@ requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_' -- of dependencies -- requireAll :: (Binary a, Typeable a, Writable a) - => Pattern + => Pattern a -> (b -> [a] -> c) -> Compiler b c requireAll pattern = requireAllA pattern . arr . uncurry @@ -279,7 +281,7 @@ requireAll pattern = requireAllA pattern . arr . uncurry -- | Arrow-based variant of 'requireAll' -- requireAllA :: (Binary a, Typeable a, Writable a) - => Pattern + => Pattern a -> Compiler (b, [a]) c -> Compiler b c requireAllA pattern = (id &&& requireAll_ pattern >>>) @@ -290,7 +292,7 @@ cached :: (Binary a, Typeable a, Writable a) -> Compiler Resource a cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do logger <- compilerLogger <$> ask - identifier <- compilerIdentifier <$> ask + identifier <- castIdentifier . compilerIdentifier <$> ask store <- compilerStore <$> ask modified <- compilerResourceModified <$> ask report logger $ "Checking cache: " ++ if modified then "modified" else "OK" diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs index 594c23e..8ed822d 100644 --- a/src/Hakyll/Core/Compiler/Internal.hs +++ b/src/Hakyll/Core/Compiler/Internal.hs @@ -33,26 +33,26 @@ import Hakyll.Core.Logger -- | A set of dependencies -- -type Dependencies = Set Identifier +type Dependencies = Set (Identifier ()) -- | Environment in which the dependency analyzer runs -- data DependencyEnvironment = DependencyEnvironment { -- | Target identifier - dependencyIdentifier :: Identifier + dependencyIdentifier :: Identifier () , -- | List of available identifiers we can depend upon - dependencyUniverse :: [Identifier] + dependencyUniverse :: [Identifier ()] } -- | Environment in which a compiler runs -- data CompilerEnvironment = CompilerEnvironment { -- | Target identifier - compilerIdentifier :: Identifier + compilerIdentifier :: Identifier () , -- | Resource provider compilerResourceProvider :: ResourceProvider , -- | List of all known identifiers - compilerUniverse :: [Identifier] + compilerUniverse :: [Identifier ()] , -- | Site routes compilerRoutes :: Routes , -- | Compiler store @@ -107,9 +107,9 @@ instance ArrowChoice Compiler where -- | Run a compiler, yielding the resulting target -- runCompilerJob :: Compiler () a -- ^ Compiler to run - -> Identifier -- ^ Target identifier + -> Identifier () -- ^ Target identifier -> ResourceProvider -- ^ Resource provider - -> [Identifier] -- ^ Universe + -> [Identifier ()] -- ^ Universe -> Routes -- ^ Route -> Store -- ^ Store -> Bool -- ^ Was the resource modified? @@ -129,8 +129,8 @@ runCompilerJob compiler id' provider universe route store modified logger = } runCompilerDependencies :: Compiler () a - -> Identifier - -> [Identifier] + -> Identifier () + -> [Identifier ()] -> Dependencies runCompilerDependencies compiler identifier universe = runReader (compilerDependencies compiler) env @@ -144,7 +144,7 @@ fromJob :: (a -> CompilerM b) -> Compiler a b fromJob = Compiler (return S.empty) -fromDependencies :: (Identifier -> [Identifier] -> [Identifier]) +fromDependencies :: (Identifier () -> [Identifier ()] -> [Identifier ()]) -> Compiler b b fromDependencies collectDeps = flip Compiler return $ do DependencyEnvironment identifier universe <- ask @@ -152,5 +152,5 @@ fromDependencies collectDeps = flip Compiler return $ do -- | Wait until another compiler has finished before running this compiler -- -fromDependency :: Identifier -> Compiler a a -fromDependency = fromDependencies . const . const . return +fromDependency :: Identifier a -> Compiler b b +fromDependency = fromDependencies . const . const . return . castIdentifier diff --git a/src/Hakyll/Core/Identifier.hs b/src/Hakyll/Core/Identifier.hs index c2455fc..b413b32 100644 --- a/src/Hakyll/Core/Identifier.hs +++ b/src/Hakyll/Core/Identifier.hs @@ -23,6 +23,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} module Hakyll.Core.Identifier ( Identifier (..) + , castIdentifier , parseIdentifier , toFilePath , setGroup @@ -40,30 +41,42 @@ import Data.Typeable (Typeable) -- | An identifier used to uniquely identify a value -- -data Identifier = Identifier +-- The @a@ is used to denote the type that the identifier points to. It is a +-- phantom type parameter, meaning you can safely change this if you know what +-- you are doing. +-- +-- If the @a@ type is not known, Hakyll traditionally uses @Identifier ()@. +-- +data Identifier a = Identifier { identifierGroup :: Maybe String , identifierPath :: String } deriving (Eq, Ord, Typeable) -instance Monoid Identifier where +instance Monoid (Identifier a) where mempty = Identifier Nothing "" Identifier g1 p1 `mappend` Identifier g2 p2 = Identifier (g1 `mplus` g2) (p1 `mappend` p2) -instance Binary Identifier where +instance Binary (Identifier a) where put (Identifier g p) = put g >> put p get = Identifier <$> get <*> get -instance Show Identifier where +instance Show (Identifier a) where show i@(Identifier Nothing _) = toFilePath i show i@(Identifier (Just g) _) = toFilePath i ++ " (" ++ g ++ ")" -instance IsString Identifier where +instance IsString (Identifier a) where fromString = parseIdentifier +-- | Discard the phantom type parameter of an identifier +-- +castIdentifier :: Identifier a -> Identifier b +castIdentifier (Identifier g p) = Identifier g p +{-# INLINE castIdentifier #-} + -- | Parse an identifier from a string -- -parseIdentifier :: String -> Identifier +parseIdentifier :: String -> Identifier a parseIdentifier = Identifier Nothing . intercalate "/" . filter (not . null) . split' where @@ -73,10 +86,10 @@ parseIdentifier = Identifier Nothing -- | Convert an identifier to a relative 'FilePath' -- -toFilePath :: Identifier -> FilePath +toFilePath :: Identifier a -> FilePath toFilePath = identifierPath -- | Set the identifier group for some identifier -- -setGroup :: Maybe String -> Identifier -> Identifier +setGroup :: Maybe String -> Identifier a -> Identifier a setGroup g (Identifier _ p) = Identifier g p diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs index cee4bbc..6bbfad8 100644 --- a/src/Hakyll/Core/Identifier/Pattern.hs +++ b/src/Hakyll/Core/Identifier/Pattern.hs @@ -33,8 +33,10 @@ -- module Hakyll.Core.Identifier.Pattern ( Pattern + , castPattern , parseGlob , predicate + , list , regex , inGroup , matches @@ -64,21 +66,28 @@ data GlobComponent = Capture -- | Type that allows matching on identifiers -- -data Pattern = Glob [GlobComponent] - | Predicate (Identifier -> Bool) +data Pattern a = Glob [GlobComponent] + | Predicate (Identifier a -> Bool) + | List [Identifier a] -instance IsString Pattern where +instance IsString (Pattern a) where fromString = parseGlob -instance Monoid Pattern where +instance Monoid (Pattern a) where mempty = Predicate (const True) - g@(Glob _) `mappend` x = Predicate (matches g) `mappend` x - x `mappend` g@(Glob _) = x `mappend` Predicate (matches g) - Predicate f `mappend` Predicate g = Predicate $ \i -> f i && g i + p1 `mappend` p2 = Predicate $ \i -> matches p1 i && matches p2 i + +-- | Discard the phantom type parameter +-- +castPattern :: Pattern a -> Pattern b +castPattern (Glob g) = Glob g +castPattern (Predicate p) = Predicate $ p . castIdentifier +castPattern (List l) = List $ map castIdentifier l +{-# INLINE castPattern #-} -- | Parse a pattern from a string -- -parseGlob :: String -> Pattern +parseGlob :: String -> Pattern a parseGlob = Glob . parse' where parse' str = @@ -95,33 +104,39 @@ parseGlob = Glob . parse' -- -- > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i)) -- -predicate :: (Identifier -> Bool) -> Pattern +predicate :: (Identifier a -> Bool) -> Pattern a predicate = Predicate +-- | Create a 'Pattern' from a list of 'Identifier's it should match +-- +list :: [Identifier a] -> Pattern a +list = List + -- | Create a 'Pattern' from a regex -- -- Example: -- -- > regex "^foo/[^x]*$ -- -regex :: String -> Pattern +regex :: String -> Pattern a regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath -- | Create a 'Pattern' which matches if the identifier is in a certain group -- (or in no group) -- -inGroup :: Maybe String -> Pattern +inGroup :: Maybe String -> Pattern a inGroup group = predicate $ (== group) . identifierGroup -- | Check if an identifier matches a pattern -- -matches :: Pattern -> Identifier -> Bool +matches :: Pattern a -> Identifier a -> Bool matches (Glob p) = isJust . capture (Glob p) matches (Predicate p) = (p $) +matches (List l) = (`elem` l) -- | Given a list of identifiers, retain only those who match the given pattern -- -filterMatches :: Pattern -> [Identifier] -> [Identifier] +filterMatches :: Pattern a -> [Identifier a] -> [Identifier a] filterMatches = filter . matches -- | Split a list at every possible point, generate a list of (init, tail) @@ -132,9 +147,9 @@ splits = inits &&& tails >>> uncurry zip >>> reverse -- | Match a glob against a pattern, generating a list of captures -- -capture :: Pattern -> Identifier -> Maybe [String] +capture :: Pattern a -> Identifier a -> Maybe [String] capture (Glob p) (Identifier _ i) = capture' p i -capture (Predicate _) _ = Nothing +capture _ _ = Nothing -- | Internal verion of 'capture' -- @@ -164,17 +179,17 @@ capture' (CaptureMany : ms) str = -- -- > "tags/foo" -- -fromCapture :: Pattern -> String -> Identifier +fromCapture :: Pattern a -> String -> Identifier a fromCapture pattern = fromCaptures pattern . repeat -- | Create an identifier from a pattern by filling in the captures with the -- given list of strings -- -fromCaptures :: Pattern -> [String] -> Identifier -fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p -fromCaptures (Predicate _) = error $ - "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures called on a " ++ - "predicate instead of a glob" +fromCaptures :: Pattern a -> [String] -> Identifier a +fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p +fromCaptures _ = error $ + "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++ + "on simple globs!" -- | Internally used version of 'fromCaptures' -- diff --git a/src/Hakyll/Core/Resource.hs b/src/Hakyll/Core/Resource.hs index 8154752..ce5da81 100644 --- a/src/Hakyll/Core/Resource.hs +++ b/src/Hakyll/Core/Resource.hs @@ -15,10 +15,10 @@ newtype Resource = Resource {unResource :: String} -- | Create a resource from an identifier -- -fromIdentifier :: Identifier -> Resource +fromIdentifier :: Identifier a -> Resource fromIdentifier = Resource . toFilePath -- | Map the resource to an identifier. Note that the group will not be set! -- -toIdentifier :: Resource -> Identifier +toIdentifier :: Resource -> Identifier a toIdentifier = parseIdentifier . unResource diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs index abbd0a7..f351447 100644 --- a/src/Hakyll/Core/Routes.hs +++ b/src/Hakyll/Core/Routes.hs @@ -25,6 +25,7 @@ -- -- * If an item matches multiple routes, the first rule will be chosen. -- +{-# LANGUAGE Rank2Types #-} module Hakyll.Core.Routes ( Routes , runRoutes @@ -46,7 +47,7 @@ import Hakyll.Core.Util.String -- | Type used for a route -- -newtype Routes = Routes {unRoutes :: Identifier -> Maybe FilePath} +newtype Routes = Routes {unRoutes :: forall a. Identifier a -> Maybe FilePath} instance Monoid Routes where mempty = Routes $ const Nothing @@ -54,7 +55,7 @@ instance Monoid Routes where -- | Apply a route to an identifier -- -runRoutes :: Routes -> Identifier -> Maybe FilePath +runRoutes :: Routes -> Identifier a -> Maybe FilePath runRoutes = unRoutes -- | A route that uses the identifier as filepath. For example, the target with @@ -88,15 +89,15 @@ setExtension extension = Routes $ fmap (`replaceExtension` extension) -- | Apply the route if the identifier matches the given pattern, fail -- otherwise -- -matchRoute :: Pattern -> Routes -> Routes +matchRoute :: Pattern a -> Routes -> Routes matchRoute pattern (Routes route) = Routes $ \id' -> - if matches pattern id' then route id' else Nothing + if matches pattern (castIdentifier id') then route id' else Nothing -- | Create a custom route. This should almost always be used with -- 'matchRoute' -- -customRoute :: (Identifier -> FilePath) -> Routes -customRoute f = Routes $ Just . f +customRoute :: (Identifier a -> FilePath) -> Routes +customRoute f = Routes $ Just . f . castIdentifier -- | Create a gsub route -- diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs index fe2c59c..eb75a2e 100644 --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -31,7 +31,7 @@ module Hakyll.Core.Rules import Control.Applicative ((<$>)) import Control.Monad.Writer (tell) import Control.Monad.Reader (ask, local) -import Control.Arrow (second, (>>>), arr, (>>^), (***)) +import Control.Arrow ((>>>), arr, (>>^), (***)) import Control.Monad.State (get, put) import Data.Monoid (mempty, mappend) import qualified Data.Set as S @@ -58,13 +58,11 @@ tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty -- | Add a number of compilers -- tellCompilers :: (Binary a, Typeable a, Writable a) - => [(Identifier, Compiler () a)] + => [(Identifier a, Compiler () a)] -> Rules tellCompilers compilers = RulesM $ do - -- We box the compilers so they have a more simple type, and we apply the - -- current group to the corresponding identifiers - group' <- rulesGroup <$> ask - let compilers' = map (setGroup group' *** boxCompiler) compilers + -- We box the compilers so they have a more simple type + let compilers' = map (castIdentifier *** boxCompiler) compilers tell $ RuleSet mempty compilers' mempty where boxCompiler = (>>> arr compiledItem >>> arr CompileRule) @@ -78,11 +76,11 @@ tellResources resources' = RulesM $ tell $ -- | Only compile/route items satisfying the given predicate -- -match :: Pattern -> Rules -> Rules +match :: Pattern a -> RulesM b -> RulesM b match pattern = RulesM . local addPredicate . unRulesM where addPredicate env = env - { rulesPattern = rulesPattern env `mappend` pattern + { rulesPattern = rulesPattern env `mappend` castPattern pattern } -- | Greate a group of compilers @@ -116,7 +114,7 @@ match pattern = RulesM . local addPredicate . unRulesM -- This will put the compiler for the raw content in a separate group -- (@\"raw\"@), which causes it to be compiled as well. -- -group :: String -> Rules -> Rules +group :: String -> RulesM a -> RulesM a group g = RulesM . local setGroup' . unRulesM where setGroup' env = env { rulesGroup = Just g } @@ -128,12 +126,13 @@ group g = RulesM . local setGroup' . unRulesM -- you might want to have a look at 'create'. -- compile :: (Binary a, Typeable a, Writable a) - => Compiler Resource a -> Rules + => Compiler Resource a -> RulesM (Pattern a) compile compiler = do ids <- resources tellCompilers $ flip map ids $ \identifier -> (identifier, constA (fromIdentifier identifier) >>> compiler) tellResources $ map fromIdentifier ids + return $ list ids -- | Add a compilation rule -- @@ -143,8 +142,12 @@ compile compiler = do -- actual content itself. -- create :: (Binary a, Typeable a, Writable a) - => Identifier -> Compiler () a -> Rules -create identifier compiler = tellCompilers [(identifier, compiler)] + => Identifier a -> Compiler () a -> RulesM (Identifier a) +create id' compiler = RulesM $ do + group' <- rulesGroup <$> ask + let id'' = setGroup group' id' + unRulesM $ tellCompilers [(id'', compiler)] + return id'' -- | Add a route. -- @@ -158,13 +161,17 @@ route route' = RulesM $ do group' <- rulesGroup <$> ask unRulesM $ tellRoute $ matchRoute (pattern `mappend` inGroup group') route' --- | Get a list of resources matching the current pattern +-- | Get a list of resources matching the current pattern. This will also set +-- the correct group to the identifiers. -- -resources :: RulesM [Identifier] +resources :: RulesM [Identifier a] resources = RulesM $ do pattern <- rulesPattern <$> ask provider <- rulesResourceProvider <$> ask - return $ filterMatches pattern $ map toIdentifier $ resourceList provider + group' <- rulesGroup <$> ask + return $ filterMatches pattern $ map (toId group') $ resourceList provider + where + toId g = setGroup g . toIdentifier -- | Apart from regular compilers, one is also able to specify metacompilers. -- Metacompilers are a special class of compilers: they are compilers which @@ -197,7 +204,7 @@ resources = RulesM $ do -- which items must be rendered. -- metaCompile :: (Binary a, Typeable a, Writable a) - => Compiler () [(Identifier, Compiler () a)] + => Compiler () [(Identifier a, Compiler () a)] -- ^ Compiler generating the other compilers -> Rules -- ^ Resulting rules @@ -217,9 +224,9 @@ metaCompile compiler = RulesM $ do -- the metacompiler. -- metaCompileWith :: (Binary a, Typeable a, Writable a) - => Identifier + => Identifier () -- ^ Identifier for this compiler - -> Compiler () [(Identifier, Compiler () a)] + -> Compiler () [(Identifier a, Compiler () a)] -- ^ Compiler generating the other compilers -> Rules -- ^ Resulting rules @@ -229,7 +236,7 @@ metaCompileWith identifier compiler = RulesM $ do let -- Set the correct group on the identifier id' = setGroup group' identifier -- Function to box an item into a rule - makeRule = MetaCompileRule . map (second box) + makeRule = MetaCompileRule . map (castIdentifier *** box) -- Entire boxing function box = (>>> fromDependency id' >>^ CompileRule . compiledItem) -- Resulting compiler list diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs index 83783b5..5a1ab8e 100644 --- a/src/Hakyll/Core/Rules/Internal.hs +++ b/src/Hakyll/Core/Rules/Internal.hs @@ -1,6 +1,6 @@ -- | Internal rules module for types which are not exposed to the user -- -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-} module Hakyll.Core.Rules.Internal ( CompileRule (..) , RuleSet (..) @@ -35,7 +35,7 @@ import Hakyll.Core.CompiledItem -- added to the runtime if possible, since other items might depend upon them. -- data CompileRule = CompileRule CompiledItem - | MetaCompileRule [(Identifier, Compiler () CompileRule)] + | MetaCompileRule [(Identifier (), Compiler () CompileRule)] -- | A collection of rules for the compilation process -- @@ -43,7 +43,7 @@ data RuleSet = RuleSet { -- | Routes used in the compilation structure rulesRoutes :: Routes , -- | Compilation rules - rulesCompilers :: [(Identifier, Compiler () CompileRule)] + rulesCompilers :: [(Identifier (), Compiler () CompileRule)] , -- | A list of the used resources rulesResources :: Set Resource } @@ -63,7 +63,7 @@ data RuleState = RuleState -- data RuleEnvironment = RuleEnvironment { rulesResourceProvider :: ResourceProvider - , rulesPattern :: Pattern + , rulesPattern :: forall a. Pattern a , rulesGroup :: Maybe String } diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index 643aa4e..8bde15d 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -89,8 +89,8 @@ data RuntimeEnvironment = RuntimeEnvironment } data RuntimeState = RuntimeState - { hakyllAnalyzer :: DependencyAnalyzer Identifier - , hakyllCompilers :: Map Identifier (Compiler () CompileRule) + { hakyllAnalyzer :: DependencyAnalyzer (Identifier ()) + , hakyllCompilers :: Map (Identifier ()) (Compiler () CompileRule) } newtype Runtime a = Runtime @@ -99,7 +99,7 @@ newtype Runtime a = Runtime -- | Add a number of compilers and continue using these compilers -- -addNewCompilers :: [(Identifier, Compiler () CompileRule)] +addNewCompilers :: [(Identifier (), Compiler () CompileRule)] -- ^ Compilers to add -> Runtime () addNewCompilers newCompilers = Runtime $ do @@ -157,14 +157,14 @@ stepAnalyzer = Runtime $ do -- | Dump cyclic error and quit -- -dumpCycle :: [Identifier] -> Runtime () +dumpCycle :: [Identifier ()] -> Runtime () dumpCycle cycle' = Runtime $ do logger <- hakyllLogger <$> ask section logger "Dependency cycle detected! Conflict:" forM_ (zip cycle' $ drop 1 cycle') $ \(x, y) -> report logger $ show x ++ " -> " ++ show y -build :: Identifier -> Runtime () +build :: Identifier () -> Runtime () build id' = Runtime $ do logger <- hakyllLogger <$> ask routes <- hakyllRoutes <$> ask diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs index 20e85d7..3000910 100644 --- a/src/Hakyll/Core/Store.hs +++ b/src/Hakyll/Core/Store.hs @@ -60,7 +60,7 @@ addToMap store path value = -- | Create a path -- -makePath :: Store -> String -> Identifier -> FilePath +makePath :: Store -> String -> Identifier a -> FilePath makePath store name identifier = storeDirectory store </> name </> group </> toFilePath identifier </> "hakyllstore" where @@ -69,7 +69,7 @@ makePath store name identifier = storeDirectory store </> name -- | Store an item -- storeSet :: (Binary a, Typeable a) - => Store -> String -> Identifier -> a -> IO () + => Store -> String -> Identifier a -> a -> IO () storeSet store name identifier value = do makeDirectories path encodeFile path value @@ -80,7 +80,7 @@ storeSet store name identifier value = do -- | Load an item -- storeGet :: forall a. (Binary a, Typeable a) - => Store -> String -> Identifier -> IO (StoreGet a) + => Store -> String -> Identifier a -> IO (StoreGet a) storeGet store name identifier = do -- First check the in-memory map map' <- readMVar $ storeMap store diff --git a/src/Hakyll/Core/Writable.hs b/src/Hakyll/Core/Writable.hs index b7a4116..d001f00 100644 --- a/src/Hakyll/Core/Writable.hs +++ b/src/Hakyll/Core/Writable.hs @@ -38,5 +38,5 @@ instance Writable [Word8] where instance Writable Html where write p html = write p $ renderHtml html -instance Writable Identifier where - write p i = write p $ show i +instance Writable (Identifier a) where + write p = write p . show |