diff options
| -rw-r--r-- | .ghci | 2 | ||||
| -rw-r--r-- | src/Hakyll/Core/Compiler.hs | 6 | ||||
| -rw-r--r-- | src/Hakyll/Core/Identifier/Pattern.hs | 50 | ||||
| -rw-r--r-- | src/Hakyll/Core/Routes.hs | 2 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules.hs | 4 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules/Internal.hs | 4 |
6 files changed, 38 insertions, 30 deletions
@@ -1 +1 @@ -:set -isrc -isrc-inotify -itests -idist/build/autogen +:set -isrc -isrc-interval -itests -idist/build/autogen diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index 2164dda..6237d5a 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -258,7 +258,7 @@ 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 @@ -271,7 +271,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 +279,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 >>>) diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs index cee4bbc..a7a534e 100644 --- a/src/Hakyll/Core/Identifier/Pattern.hs +++ b/src/Hakyll/Core/Identifier/Pattern.hs @@ -33,6 +33,7 @@ -- module Hakyll.Core.Identifier.Pattern ( Pattern + , castPattern , parseGlob , predicate , regex @@ -64,21 +65,27 @@ data GlobComponent = Capture -- | Type that allows matching on identifiers -- -data Pattern = Glob [GlobComponent] - | Predicate (Identifier -> Bool) +data Pattern a = Glob [GlobComponent] + | Predicate (Identifier -> Bool) + | List [Identifier] -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 +castPattern (List l) = List l -- | Parse a pattern from a string -- -parseGlob :: String -> Pattern +parseGlob :: String -> Pattern a parseGlob = Glob . parse' where parse' str = @@ -95,7 +102,7 @@ parseGlob = Glob . parse' -- -- > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i)) -- -predicate :: (Identifier -> Bool) -> Pattern +predicate :: (Identifier -> Bool) -> Pattern a predicate = Predicate -- | Create a 'Pattern' from a regex @@ -104,24 +111,25 @@ predicate = Predicate -- -- > 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 -> 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] -> [Identifier] filterMatches = filter . matches -- | Split a list at every possible point, generate a list of (init, tail) @@ -132,9 +140,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 -> Maybe [String] capture (Glob p) (Identifier _ i) = capture' p i -capture (Predicate _) _ = Nothing +capture _ _ = Nothing -- | Internal verion of 'capture' -- @@ -164,17 +172,17 @@ capture' (CaptureMany : ms) str = -- -- > "tags/foo" -- -fromCapture :: Pattern -> String -> Identifier +fromCapture :: Pattern a -> 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 -> [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 +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/Routes.hs b/src/Hakyll/Core/Routes.hs index abbd0a7..0b500b3 100644 --- a/src/Hakyll/Core/Routes.hs +++ b/src/Hakyll/Core/Routes.hs @@ -88,7 +88,7 @@ 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 diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs index fe2c59c..a9e1375 100644 --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -78,11 +78,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 diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs index 83783b5..fe16062 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 (..) @@ -63,7 +63,7 @@ data RuleState = RuleState -- data RuleEnvironment = RuleEnvironment { rulesResourceProvider :: ResourceProvider - , rulesPattern :: Pattern + , rulesPattern :: forall a. Pattern a , rulesGroup :: Maybe String } |