diff options
| -rw-r--r-- | src/Hakyll/Core/Compiler/Internal.hs | 47 | ||||
| -rw-r--r-- | src/Hakyll/Core/Dependencies.hs | 22 | ||||
| -rw-r--r-- | src/Hakyll/Core/Identifier.hs | 24 | ||||
| -rw-r--r-- | src/Hakyll/Core/Identifier/Pattern.hs | 49 | ||||
| -rw-r--r-- | src/Hakyll/Core/Metadata.hs | 2 | ||||
| -rw-r--r-- | src/Hakyll/Core/ResourceProvider.hs | 4 | ||||
| -rw-r--r-- | src/Hakyll/Core/ResourceProvider/Internal.hs | 16 | ||||
| -rw-r--r-- | src/Hakyll/Core/ResourceProvider/Metadata.hs | 2 | ||||
| -rw-r--r-- | src/Hakyll/Core/ResourceProvider/MetadataCache.hs | 8 | ||||
| -rw-r--r-- | src/Hakyll/Core/ResourceProvider/Modified.hs | 6 | ||||
| -rw-r--r-- | src/Hakyll/Core/Routes.hs | 12 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules.hs | 65 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules/Internal.hs | 23 | ||||
| -rw-r--r-- | src/Hakyll/Core/Writable.hs | 2 |
14 files changed, 112 insertions, 170 deletions
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs index cac5948..d983cef 100644 --- a/src/Hakyll/Core/Compiler/Internal.hs +++ b/src/Hakyll/Core/Compiler/Internal.hs @@ -4,7 +4,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hakyll.Core.Compiler.Internal ( CompilerRead (..) - , Compiler (..) + , Compiler + , runCompiler , compilerTell , compilerAsk , compilerThrow @@ -31,11 +32,11 @@ import Hakyll.Core.Store -- | Environment in which a compiler runs data CompilerRead = CompilerRead { -- | 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 @@ -55,7 +56,7 @@ type CompilerWrite = [Dependency] data CompilerResult a where CompilerDone :: a -> CompilerWrite -> CompilerResult a CompilerError :: String -> CompilerResult a - CompilerRequire :: Identifier b -> (b -> Compiler a) -> CompilerResult a + CompilerRequire :: Identifier -> (b -> Compiler a) -> CompilerResult a -------------------------------------------------------------------------------- @@ -107,6 +108,11 @@ instance Applicative Compiler where -------------------------------------------------------------------------------- +runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a) +runCompiler = unCompiler + + +-------------------------------------------------------------------------------- instance Alternative Compiler where empty = compilerThrow "Hakyll.Core.Compiler.Internal: empty alternative" x <|> y = compilerCatch x (\_ -> y) @@ -139,36 +145,3 @@ compilerCatch (Compiler x) f = Compiler $ \r -> do CompilerError e -> unCompiler (f e) r _ -> return res {-# INLINE compilerCatch #-} - - -{- --------------------------------------------------------------------------------- --- | The compiler monad -newtype CompilerM a = CompilerM - { unCompilerM :: ErrorT String (ReaderT CompilerEnvironment IO) a - } deriving (Monad, Functor, Applicative) - - --------------------------------------------------------------------------------- --- | The compiler arrow -data Compiler a = Compiler - { compilerDependencies :: Reader DependencyEnvironment Dependencies - , compilerJob :: CompilerM a - } - - --------------------------------------------------------------------------------- -instance Functor Compiler where - fmap f (Compiler d j) = Compiler d $ fmap f j - {-# INLINE fmap #-} - - --------------------------------------------------------------------------------- -instance Applicative Compiler where - pure = fromJob . return - {-# INLINE pure #-} - - Compiler d1 j1 <*> Compiler d2 j2 = - Compiler (liftM2 S.union d1 d2) $ j1 <*> j2 - {-# INLINE (<*>) #-} --} diff --git a/src/Hakyll/Core/Dependencies.hs b/src/Hakyll/Core/Dependencies.hs index 72edb4d..144e5f6 100644 --- a/src/Hakyll/Core/Dependencies.hs +++ b/src/Hakyll/Core/Dependencies.hs @@ -28,21 +28,21 @@ import Hakyll.Core.Identifier.Pattern -------------------------------------------------------------------------------- data Dependency - = Pattern (Pattern ()) [Identifier ()] - | Identifier (Identifier ()) + = Pattern Pattern [Identifier] + | Identifier Identifier deriving (Show) -------------------------------------------------------------------------------- -type DependencyFacts = Map (Identifier ()) [Dependency] +type DependencyFacts = Map Identifier [Dependency] -------------------------------------------------------------------------------- outOfDate - :: [Identifier ()] -- ^ All known identifiers - -> Set (Identifier ()) -- ^ Initially out-of-date resources - -> DependencyFacts -- ^ Old dependency facts - -> (Set (Identifier ()), DependencyFacts, [String]) + :: [Identifier] -- ^ All known identifiers + -> Set Identifier -- ^ Initially out-of-date resources + -> DependencyFacts -- ^ Old dependency facts + -> (Set Identifier, DependencyFacts, [String]) outOfDate universe ood oldFacts = let (_, state, logs) = runRWS rws universe (DependencyState oldFacts ood) in (dependencyOod state, dependencyFacts state, logs) @@ -56,21 +56,21 @@ outOfDate universe ood oldFacts = -------------------------------------------------------------------------------- data DependencyState = DependencyState { dependencyFacts :: DependencyFacts - , dependencyOod :: Set (Identifier ()) + , dependencyOod :: Set Identifier } deriving (Show) -------------------------------------------------------------------------------- -type DependencyM a = RWS [Identifier ()] [String] DependencyState a +type DependencyM a = RWS [Identifier] [String] DependencyState a -------------------------------------------------------------------------------- -markOod :: Identifier () -> DependencyM () +markOod :: Identifier -> DependencyM () markOod id' = modify $ \s -> s {dependencyOod = S.insert id' $ dependencyOod s} -------------------------------------------------------------------------------- -dependenciesFor :: Identifier () -> DependencyM [Identifier ()] +dependenciesFor :: Identifier -> DependencyM [Identifier] dependenciesFor id' = do facts <- dependencyFacts <$> get let relevant = fromMaybe [] $ M.lookup id' facts diff --git a/src/Hakyll/Core/Identifier.hs b/src/Hakyll/Core/Identifier.hs index 2cf8a53..876d0fe 100644 --- a/src/Hakyll/Core/Identifier.hs +++ b/src/Hakyll/Core/Identifier.hs @@ -35,7 +35,6 @@ module Hakyll.Core.Identifier ( Identifier , fromFilePath , toFilePath - , castIdentifier , identifierVersion , setVersion ) where @@ -56,30 +55,30 @@ import GHC.Exts (IsString, fromString) -------------------------------------------------------------------------------- -- | An identifier used to uniquely identify a value -data Identifier a = Identifier +data Identifier = Identifier { identifierVersion :: Maybe String , identifierPath :: String } deriving (Eq, Ord, Typeable) -------------------------------------------------------------------------------- -instance Binary (Identifier a) where +instance Binary Identifier where put (Identifier v p) = put v >> put p get = Identifier <$> get <*> get -------------------------------------------------------------------------------- -instance IsString (Identifier a) where +instance IsString Identifier where fromString = fromFilePath -------------------------------------------------------------------------------- -instance NFData (Identifier a) where +instance NFData Identifier where rnf (Identifier v p) = rnf v `seq` rnf p `seq` () -------------------------------------------------------------------------------- -instance Show (Identifier a) where +instance Show Identifier where show i = case identifierVersion i of Nothing -> toFilePath i Just v -> toFilePath i ++ " (" ++ v ++ ")" @@ -87,7 +86,7 @@ instance Show (Identifier a) where -------------------------------------------------------------------------------- -- | Parse an identifier from a string -fromFilePath :: String -> Identifier a +fromFilePath :: String -> Identifier fromFilePath = Identifier Nothing . intercalate "/" . filter (not . null) . split' where @@ -96,17 +95,10 @@ fromFilePath = Identifier Nothing . -------------------------------------------------------------------------------- -- | Convert an identifier to a relative 'FilePath' -toFilePath :: Identifier a -> FilePath +toFilePath :: Identifier -> FilePath toFilePath = identifierPath -------------------------------------------------------------------------------- --- | Discard the phantom type parameter of an identifier -castIdentifier :: Identifier a -> Identifier b -castIdentifier (Identifier v p) = Identifier v p -{-# INLINE castIdentifier #-} - - --------------------------------------------------------------------------------- -setVersion :: Maybe String -> Identifier a -> Identifier a +setVersion :: Maybe String -> Identifier -> Identifier setVersion v i = i {identifierVersion = v} diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs index dc02be3..48e5441 100644 --- a/src/Hakyll/Core/Identifier/Pattern.hs +++ b/src/Hakyll/Core/Identifier/Pattern.hs @@ -48,7 +48,6 @@ module Hakyll.Core.Identifier.Pattern -- * Manipulating patterns , complement , withVersion - , castPattern -- * Applying patterns , matches @@ -104,19 +103,19 @@ instance Binary GlobComponent where -------------------------------------------------------------------------------- -- | Type that allows matching on identifiers -data Pattern a +data Pattern = Everything - | Complement (Pattern a) - | And (Pattern a) (Pattern a) + | Complement Pattern + | And Pattern Pattern | Glob [GlobComponent] - | List [Identifier a] -- TODO Maybe use a set here + | List [Identifier] -- TODO Maybe use a set here | Regex String | Version (Maybe String) deriving (Show) -------------------------------------------------------------------------------- -instance Binary (Pattern a) where +instance Binary Pattern where put Everything = putWord8 0 put (Complement p) = putWord8 1 >> put p put (And x y) = putWord8 2 >> put x >> put y @@ -136,19 +135,19 @@ instance Binary (Pattern a) where -------------------------------------------------------------------------------- -instance IsString (Pattern a) where +instance IsString Pattern where fromString = fromGlob -------------------------------------------------------------------------------- -instance Monoid (Pattern a) where +instance Monoid Pattern where mempty = Everything mappend = And -------------------------------------------------------------------------------- -- | Parse a pattern from a string -fromGlob :: String -> Pattern a +fromGlob :: String -> Pattern fromGlob = Glob . parse' where parse' str = @@ -162,7 +161,7 @@ fromGlob = Glob . parse' -------------------------------------------------------------------------------- -- | Create a 'Pattern' from a list of 'Identifier's it should match -fromList :: [Identifier a] -> Pattern a +fromList :: [Identifier] -> Pattern fromList = List @@ -172,12 +171,12 @@ fromList = List -- Example: -- -- > regex "^foo/[^x]*$ -fromRegex :: String -> Pattern a +fromRegex :: String -> Pattern fromRegex = Regex -------------------------------------------------------------------------------- -fromVersion :: Maybe String -> Pattern a +fromVersion :: Maybe String -> Pattern fromVersion = Version @@ -187,7 +186,7 @@ fromVersion = Version -- > complement "foo/bar.html" -- -- will match /anything/ except @\"foo\/bar.html\"@ -complement :: Pattern a -> Pattern a +complement :: Pattern -> Pattern complement = Complement @@ -195,25 +194,13 @@ complement = Complement -- | Specify a version, e.g. -- -- > "foo/*.markdown" `withVersion` "pdf" -withVersion :: Pattern a -> String -> Pattern a +withVersion :: Pattern -> String -> Pattern withVersion p v = And p $ fromVersion $ Just v -------------------------------------------------------------------------------- --- | Discard the phantom type parameter -castPattern :: Pattern a -> Pattern b -castPattern Everything = Everything -castPattern (Complement x) = Complement (castPattern x) -castPattern (And x y) = And (castPattern x) (castPattern y) -castPattern (Glob g) = Glob g -castPattern (List l) = List $ map castIdentifier l -castPattern (Regex r) = Regex r -castPattern (Version v) = Version v - - --------------------------------------------------------------------------------- -- | Check if an identifier matches a pattern -matches :: Pattern a -> Identifier a -> Bool +matches :: Pattern -> Identifier -> Bool matches Everything _ = True matches (Complement p) i = not $ matches p i matches (And x y) i = matches x i && matches y i @@ -225,7 +212,7 @@ matches (Version v) i = identifierVersion i == v -------------------------------------------------------------------------------- -- | Given a list of identifiers, retain only those who match the given pattern -filterMatches :: Pattern a -> [Identifier a] -> [Identifier a] +filterMatches :: Pattern -> [Identifier] -> [Identifier] filterMatches = filter . matches @@ -238,7 +225,7 @@ splits = inits &&& tails >>> uncurry zip >>> reverse -------------------------------------------------------------------------------- -- | Match a glob against a pattern, generating a list of captures -capture :: Pattern a -> Identifier a -> Maybe [String] +capture :: Pattern -> Identifier -> Maybe [String] capture (Glob p) i = capture' p (toFilePath i) capture _ _ = Nothing @@ -272,14 +259,14 @@ capture' (CaptureMany : ms) str = -- Result: -- -- > "tags/foo" -fromCapture :: Pattern a -> String -> Identifier a +fromCapture :: Pattern -> String -> Identifier fromCapture pattern = fromCaptures pattern . repeat -------------------------------------------------------------------------------- -- | Create an identifier from a pattern by filling in the captures with the -- given list of strings -fromCaptures :: Pattern a -> [String] -> Identifier a +fromCaptures :: Pattern -> [String] -> Identifier fromCaptures (Glob p) = fromFilePath . fromCaptures' p fromCaptures _ = error $ "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++ diff --git a/src/Hakyll/Core/Metadata.hs b/src/Hakyll/Core/Metadata.hs index 79922e1..a417624 100644 --- a/src/Hakyll/Core/Metadata.hs +++ b/src/Hakyll/Core/Metadata.hs @@ -19,6 +19,6 @@ type Metadata = Map String String -------------------------------------------------------------------------------- class MonadMetadata m where - identifierMetadata :: Identifier a -> m Metadata + identifierMetadata :: Identifier -> m Metadata -- allMetadata :: m [(Resource, Metadata)] -- patternMetadata :: Pattern a -> m [(Resource, Metadata)] diff --git a/src/Hakyll/Core/ResourceProvider.hs b/src/Hakyll/Core/ResourceProvider.hs index f18d462..04b5625 100644 --- a/src/Hakyll/Core/ResourceProvider.hs +++ b/src/Hakyll/Core/ResourceProvider.hs @@ -32,7 +32,7 @@ import Hakyll.Core.ResourceProvider.Modified -------------------------------------------------------------------------------- -- | Wrapper to ensure metadata cache is invalidated if necessary -resourceMetadata :: ResourceProvider -> Identifier a -> IO Metadata +resourceMetadata :: ResourceProvider -> Identifier -> IO Metadata resourceMetadata rp r = do _ <- resourceModified rp r Internal.resourceMetadata rp r @@ -40,7 +40,7 @@ resourceMetadata rp r = do -------------------------------------------------------------------------------- -- | Wrapper to ensure metadata cache is invalidated if necessary -resourceBody :: ResourceProvider -> Identifier a -> IO String +resourceBody :: ResourceProvider -> Identifier -> IO String resourceBody rp r = do _ <- resourceModified rp r Internal.resourceBody rp r diff --git a/src/Hakyll/Core/ResourceProvider/Internal.hs b/src/Hakyll/Core/ResourceProvider/Internal.hs index 02ff98c..628d1b5 100644 --- a/src/Hakyll/Core/ResourceProvider/Internal.hs +++ b/src/Hakyll/Core/ResourceProvider/Internal.hs @@ -33,9 +33,9 @@ import Hakyll.Core.Identifier -- | Responsible for retrieving and listing resources data ResourceProvider = ResourceProvider { -- | A list of all files found - resourceSet :: Set (Identifier ()) + resourceSet :: Set Identifier , -- | Cache keeping track of modified files - resourceModifiedCache :: IORef (Map (Identifier ()) Bool) + resourceModifiedCache :: IORef (Map Identifier Bool) , -- | Underlying persistent store for caching resourceStore :: Store } @@ -55,32 +55,32 @@ newResourceProvider store ignore directory = do -------------------------------------------------------------------------------- -resourceList :: ResourceProvider -> [Identifier ()] +resourceList :: ResourceProvider -> [Identifier] resourceList = S.toList . resourceSet -------------------------------------------------------------------------------- -- | Check if a given resource exists -resourceExists :: ResourceProvider -> Identifier a -> Bool +resourceExists :: ResourceProvider -> Identifier -> Bool resourceExists provider = - (`S.member` resourceSet provider) . setVersion Nothing . castIdentifier + (`S.member` resourceSet provider) . setVersion Nothing -------------------------------------------------------------------------------- -- | Each resource may have an associated metadata resource (with a @.metadata@ -- filename) -resourceMetadataResource :: Identifier a -> Identifier () +resourceMetadataResource :: Identifier -> Identifier resourceMetadataResource = fromFilePath . flip addExtension "metadata" . toFilePath -------------------------------------------------------------------------------- -- | Get the raw body of a resource as string -resourceString :: Identifier a -> IO String +resourceString :: Identifier -> IO String resourceString = readFile . toFilePath -------------------------------------------------------------------------------- -- | Get the raw body of a resource of a lazy bytestring -resourceLBS :: Identifier a -> IO BL.ByteString +resourceLBS :: Identifier -> IO BL.ByteString resourceLBS = BL.readFile . toFilePath diff --git a/src/Hakyll/Core/ResourceProvider/Metadata.hs b/src/Hakyll/Core/ResourceProvider/Metadata.hs index 2b0615c..50af0c9 100644 --- a/src/Hakyll/Core/ResourceProvider/Metadata.hs +++ b/src/Hakyll/Core/ResourceProvider/Metadata.hs @@ -24,7 +24,7 @@ import Hakyll.Core.Util.String -------------------------------------------------------------------------------- -loadMetadata :: ResourceProvider -> Identifier a -> IO (Metadata, Maybe String) +loadMetadata :: ResourceProvider -> Identifier -> IO (Metadata, Maybe String) loadMetadata rp identifier = do hasHeader <- probablyHasMetadataHeader fp (md, body) <- if hasHeader diff --git a/src/Hakyll/Core/ResourceProvider/MetadataCache.hs b/src/Hakyll/Core/ResourceProvider/MetadataCache.hs index 85062a0..959cdde 100644 --- a/src/Hakyll/Core/ResourceProvider/MetadataCache.hs +++ b/src/Hakyll/Core/ResourceProvider/MetadataCache.hs @@ -15,7 +15,7 @@ import qualified Hakyll.Core.Store as Store -------------------------------------------------------------------------------- -resourceMetadata :: ResourceProvider -> Identifier a -> IO Metadata +resourceMetadata :: ResourceProvider -> Identifier -> IO Metadata resourceMetadata rp r = do load rp r Store.Found md <- Store.get (resourceStore rp) @@ -24,7 +24,7 @@ resourceMetadata rp r = do -------------------------------------------------------------------------------- -resourceBody :: ResourceProvider -> Identifier a -> IO String +resourceBody :: ResourceProvider -> Identifier -> IO String resourceBody rp r = do load rp r Store.Found bd <- Store.get (resourceStore rp) @@ -33,14 +33,14 @@ resourceBody rp r = do -------------------------------------------------------------------------------- -resourceInvalidateMetadataCache :: ResourceProvider -> Identifier a -> IO () +resourceInvalidateMetadataCache :: ResourceProvider -> Identifier -> IO () resourceInvalidateMetadataCache rp r = do Store.delete (resourceStore rp) [name, toFilePath r, "metadata"] Store.delete (resourceStore rp) [name, toFilePath r, "body"] -------------------------------------------------------------------------------- -load :: ResourceProvider -> Identifier a -> IO () +load :: ResourceProvider -> Identifier -> IO () load rp r = do mmd <- Store.get store mdk :: IO (Store.Result Metadata) case mmd of diff --git a/src/Hakyll/Core/ResourceProvider/Modified.hs b/src/Hakyll/Core/ResourceProvider/Modified.hs index 0da3d0f..761f13c 100644 --- a/src/Hakyll/Core/ResourceProvider/Modified.hs +++ b/src/Hakyll/Core/ResourceProvider/Modified.hs @@ -27,7 +27,7 @@ import qualified Hakyll.Core.Store as Store -------------------------------------------------------------------------------- -- | A resource is modified if it or its metadata has changed -resourceModified :: ResourceProvider -> Identifier a -> IO Bool +resourceModified :: ResourceProvider -> Identifier -> IO Bool resourceModified rp r | not exists = return False | otherwise = do @@ -47,7 +47,7 @@ resourceModified rp r return m where - normalized = castIdentifier $ setVersion Nothing r + normalized = setVersion Nothing r exists = resourceExists rp r store = resourceStore rp cacheRef = resourceModifiedCache rp @@ -79,5 +79,5 @@ fileDigest = fmap MD5.hashlazy . BL.readFile -------------------------------------------------------------------------------- -resourceModificationTime :: Identifier a -> IO UTCTime +resourceModificationTime :: Identifier -> IO UTCTime resourceModificationTime = getModificationTime . toFilePath diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs index 63e32e7..27e03b1 100644 --- a/src/Hakyll/Core/Routes.hs +++ b/src/Hakyll/Core/Routes.hs @@ -53,7 +53,7 @@ import Hakyll.Core.Util.String -------------------------------------------------------------------------------- -- | Type used for a route -newtype Routes = Routes {unRoutes :: forall a. Identifier a -> Maybe FilePath} +newtype Routes = Routes {unRoutes :: Identifier -> Maybe FilePath} -------------------------------------------------------------------------------- @@ -64,7 +64,7 @@ instance Monoid Routes where -------------------------------------------------------------------------------- -- | Apply a route to an identifier -runRoutes :: Routes -> Identifier a -> Maybe FilePath +runRoutes :: Routes -> Identifier -> Maybe FilePath runRoutes = unRoutes @@ -101,16 +101,16 @@ setExtension extension = Routes $ -------------------------------------------------------------------------------- -- | Apply the route if the identifier matches the given pattern, fail -- otherwise -matchRoute :: Pattern a -> Routes -> Routes +matchRoute :: Pattern -> Routes -> Routes matchRoute pattern (Routes route) = Routes $ \id' -> - if matches pattern (castIdentifier id') then route id' else Nothing + if matches pattern id' then route id' else Nothing -------------------------------------------------------------------------------- -- | Create a custom route. This should almost always be used with -- 'matchRoute' -customRoute :: (Identifier a -> FilePath) -> Routes -customRoute f = Routes $ Just . f . castIdentifier +customRoute :: (Identifier -> FilePath) -> Routes +customRoute f = Routes $ Just . f -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs index c481977..24b65dd 100644 --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -2,7 +2,7 @@ -- | This module provides a declarative DSL in which the user can specify the -- different rules used to run the compilers. -- --- The convention is to just list all items in the 'RulesM' monad, routes and +-- The convention is to just list all items in the 'Rules' monad, routes and -- compilation rules. -- -- A typical usage example would be: @@ -17,8 +17,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} module Hakyll.Core.Rules - ( RulesM - , Rules + ( Rules , match , group , compile @@ -31,7 +30,7 @@ module Hakyll.Core.Rules -------------------------------------------------------------------------------- import Control.Applicative ((<$>)) -import Control.Arrow ((***)) +import Control.Arrow (second) import Control.Monad.Reader (ask, local) import Control.Monad.State (get, put) import Control.Monad.Writer (tell) @@ -57,36 +56,36 @@ import Hakyll.Core.Writable -------------------------------------------------------------------------------- -- | Add a route -tellRoute :: Routes -> Rules -tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty +tellRoute :: Routes -> Rules () +tellRoute route' = Rules $ tell $ RuleSet route' mempty mempty -------------------------------------------------------------------------------- -- | Add a number of compilers tellCompilers :: (Binary a, Typeable a, Writable a) - => [(Identifier a, Compiler a)] - -> Rules -tellCompilers compilers = RulesM $ do + => [(Identifier, Compiler a)] + -> Rules () +tellCompilers compilers = Rules $ do -- We box the compilers so they have a more simple type - let compilers' = map (castIdentifier *** fmap compiledItem) compilers + let compilers' = map (second $ fmap compiledItem) compilers tell $ RuleSet mempty compilers' mempty -------------------------------------------------------------------------------- -- | Add resources -tellResources :: [Identifier a] - -> Rules -tellResources resources' = RulesM $ tell $ - RuleSet mempty mempty $ S.fromList $ map castIdentifier resources' +tellResources :: [Identifier] + -> Rules () +tellResources resources' = Rules $ tell $ + RuleSet mempty mempty $ S.fromList resources' -------------------------------------------------------------------------------- -- | Only compile/route items satisfying the given predicate -match :: Pattern a -> RulesM b -> RulesM b -match pattern = RulesM . local addPredicate . unRulesM +match :: Pattern -> Rules b -> Rules b +match pattern = Rules . local addPredicate . unRules where addPredicate env = env - { rulesPattern = rulesPattern env `mappend` castPattern pattern + { rulesPattern = rulesPattern env `mappend` pattern } @@ -120,8 +119,8 @@ 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 -> RulesM a -> RulesM a -group g = RulesM . local setVersion' . unRulesM +group :: String -> Rules a -> Rules a +group g = Rules . local setVersion' . unRules where setVersion' env = env {rulesVersion = Just g} @@ -133,12 +132,11 @@ group g = RulesM . local setVersion' . unRulesM -- no resources match the current selection, nothing will happen. In this case, -- you might want to have a look at 'create'. compile :: (Binary a, Typeable a, Writable a) - => Compiler a -> RulesM (Pattern a) + => Compiler a -> Rules () compile compiler = do ids <- resources - tellCompilers [(castIdentifier id', compiler) | id' <- ids] + tellCompilers [(id', compiler) | id' <- ids] tellResources ids - return $ fromList $ map castIdentifier ids -------------------------------------------------------------------------------- @@ -151,33 +149,32 @@ compile compiler = do -- replaced by the group set via 'group' (or 'Nothing', if 'group' has not been -- used). create :: (Binary a, Typeable a, Writable a) - => Identifier a -> Compiler a -> RulesM (Identifier a) -create id' compiler = RulesM $ do + => Identifier -> Compiler a -> Rules () +create id' compiler = Rules $ do version' <- rulesVersion <$> ask let id'' = setVersion version' id' - unRulesM $ tellCompilers [(id'', compiler)] - return id'' + unRules $ tellCompilers [(id'', compiler)] -------------------------------------------------------------------------------- -- | Add a route. -- -- This adds a route for all items matching the current pattern. -route :: Routes -> Rules -route route' = RulesM $ do +route :: Routes -> Rules () +route route' = Rules $ do -- We want the route only to be applied if we match the current pattern and -- version pattern <- rulesPattern <$> ask version' <- rulesVersion <$> ask - unRulesM $ tellRoute $ matchRoute + unRules $ tellRoute $ matchRoute (pattern `mappend` fromVersion version') route' -------------------------------------------------------------------------------- -- | Get a list of resources matching the current pattern. This will also set -- the correct group to the identifiers. -resources :: RulesM [Identifier ()] -resources = RulesM $ do +resources :: Rules [Identifier] +resources = Rules $ do pattern <- rulesPattern <$> ask provider <- rulesResourceProvider <$> ask g <- rulesVersion <$> ask @@ -187,9 +184,9 @@ resources = RulesM $ do -------------------------------------------------------------------------------- -- | Generate a fresh Identifier with a given prefix -- TODO: remove? -freshIdentifier :: String -- ^ Prefix - -> RulesM (Identifier a) -- ^ Fresh identifier -freshIdentifier prefix = RulesM $ do +freshIdentifier :: String -- ^ Prefix + -> Rules Identifier -- ^ Fresh identifier +freshIdentifier prefix = Rules $ do state <- get let index = rulesNextIdentifier state id' = fromFilePath $ prefix ++ "/" ++ show index diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs index ec3714c..360293f 100644 --- a/src/Hakyll/Core/Rules/Internal.hs +++ b/src/Hakyll/Core/Rules/Internal.hs @@ -6,8 +6,7 @@ module Hakyll.Core.Rules.Internal ( RuleSet (..) , RuleState (..) , RuleEnvironment (..) - , RulesM (..) - , Rules + , Rules (..) , runRules ) where @@ -35,9 +34,9 @@ data RuleSet = RuleSet { -- | Routes used in the compilation structure rulesRoutes :: Routes , -- | Compilation rules - rulesCompilers :: [(Identifier (), Compiler CompiledItem)] + rulesCompilers :: [(Identifier, Compiler CompiledItem)] , -- | A set of the actually used files - rulesResources :: Set (Identifier ()) + rulesResources :: Set Identifier } @@ -59,29 +58,23 @@ data RuleState = RuleState -- | Rule environment data RuleEnvironment = RuleEnvironment { rulesResourceProvider :: ResourceProvider - , rulesPattern :: forall a. Pattern a + , rulesPattern :: Pattern , rulesVersion :: Maybe String } -------------------------------------------------------------------------------- -- | The monad used to compose rules -newtype RulesM a = RulesM - { unRulesM :: RWST RuleEnvironment RuleSet RuleState IO a +newtype Rules a = Rules + { unRules :: RWST RuleEnvironment RuleSet RuleState IO a } deriving (Monad, Functor, Applicative) -------------------------------------------------------------------------------- --- | Simplification of the RulesM type; usually, it will not return any --- result. -type Rules = RulesM () - - --------------------------------------------------------------------------------- -- | Run a Rules monad, resulting in a 'RuleSet' -runRules :: RulesM a -> ResourceProvider -> IO RuleSet +runRules :: Rules a -> ResourceProvider -> IO RuleSet runRules rules provider = do - (_, _, ruleSet) <- runRWST (unRulesM rules) env state + (_, _, ruleSet) <- runRWST (unRules rules) env state return $ nubCompilers ruleSet where state = RuleState {rulesNextIdentifier = 0} diff --git a/src/Hakyll/Core/Writable.hs b/src/Hakyll/Core/Writable.hs index d2c9a02..c37c630 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 a) where +instance Writable Identifier where write p = write p . show |