summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Hakyll/Core/Identifier/Pattern.hs101
1 files changed, 59 insertions, 42 deletions
diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs
index a1e36df..52b998b 100644
--- a/src/Hakyll/Core/Identifier/Pattern.hs
+++ b/src/Hakyll/Core/Identifier/Pattern.hs
@@ -1,4 +1,12 @@
-- | Module providing pattern matching and capturing on 'Identifier's.
+-- 'Pattern's come in two kinds:
+--
+-- * Simple glob patterns, like @foo\/*@;
+--
+-- * Custom, arbitrary predicates of the type @Identifier -> Bool@.
+--
+-- They both have advantages and disadvantages. By default, globs are used,
+-- unless you construct your 'Pattern' using the 'predicate' function.
--
-- A very simple pattern could be, for example, @foo\/bar@. This pattern will
-- only match the exact @foo\/bar@ identifier.
@@ -20,15 +28,15 @@
--
-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.
--
--- The 'match' function allows the user to get access to the elements captured
+-- The 'capture' function allows the user to get access to the elements captured
-- by the capture elements in the pattern.
--
module Hakyll.Core.Identifier.Pattern
( Pattern
- , parsePattern
- , match
- , doesMatch
+ , parseGlob
, matches
+ , filterMatches
+ , capture
, fromCapture
, fromCaptureString
, fromCaptures
@@ -46,23 +54,23 @@ import Hakyll.Core.Identifier
-- | One base element of a pattern
--
-data PatternComponent = Capture
- | CaptureMany
- | Literal String
- deriving (Eq, Show)
+data GlobComponent = Capture
+ | CaptureMany
+ | Literal String
+ deriving (Eq, Show)
-- | Type that allows matching on identifiers
--
-newtype Pattern = Pattern {unPattern :: [PatternComponent]}
- deriving (Eq, Show)
+data Pattern = Glob [GlobComponent]
+ | Predicate (Identifier -> Bool)
instance IsString Pattern where
- fromString = parsePattern
+ fromString = parseGlob
-- | Parse a pattern from a string
--
-parsePattern :: String -> Pattern
-parsePattern = Pattern . parse' -- undefined -- Pattern . map toPattern . unIdentifier . parseIdentifier
+parseGlob :: String -> Pattern
+parseGlob = Glob . parse'
where
parse' str =
let (chunk, rest) = break (`elem` "\\*") str
@@ -72,20 +80,16 @@ parsePattern = Pattern . parse' -- undefined -- Pattern . map toPattern . unIden
('*' : xs) -> Literal chunk : Capture : parse' xs
xs -> Literal chunk : Literal xs : []
--- | Match an identifier against a pattern, generating a list of captures
---
-match :: Pattern -> Identifier -> Maybe [Identifier]
-match p (Identifier i) = fmap (map Identifier) $ match' (unPattern p) i
-
-- | Check if an identifier matches a pattern
--
-doesMatch :: Pattern -> Identifier -> Bool
-doesMatch p = isJust . match p
+matches :: Pattern -> Identifier -> Bool
+matches (Glob p) = isJust . capture (Glob p)
+matches (Predicate p) = (p $)
-- | Given a list of identifiers, retain only those who match the given pattern
--
-matches :: Pattern -> [Identifier] -> [Identifier]
-matches p = filter (doesMatch p)
+filterMatches :: Pattern -> [Identifier] -> [Identifier]
+filterMatches = filter . matches
-- | Split a list at every possible point, generate a list of (init, tail)
-- cases. The result is sorted with inits decreasing in length.
@@ -93,30 +97,35 @@ matches p = filter (doesMatch p)
splits :: [a] -> [([a], [a])]
splits = inits &&& tails >>> uncurry zip >>> reverse
--- | Internal verion of 'match'
+-- | Match a glob against a pattern, generating a list of captures
--
-match' :: [PatternComponent] -> String -> Maybe [String]
-match' [] [] = Just [] -- An empty match
-match' [] _ = Nothing -- No match
--- match' _ [] = Nothing -- No match
-match' (Literal l : ms) str
+capture :: Pattern -> Identifier -> Maybe [Identifier]
+capture (Glob p) (Identifier i) = fmap (map Identifier) $ capture' p i
+capture (Predicate _) _ = Nothing
+
+-- | Internal verion of 'capture'
+--
+capture' :: [GlobComponent] -> String -> Maybe [String]
+capture' [] [] = Just [] -- An empty match
+capture' [] _ = Nothing -- No match
+capture' (Literal l : ms) str
-- Match the literal against the string
- | l `isPrefixOf` str = match' ms $ drop (length l) str
+ | l `isPrefixOf` str = capture' ms $ drop (length l) str
| otherwise = Nothing
-match' (Capture : ms) str =
+capture' (Capture : ms) str =
-- Match until the next /
let (chunk, rest) = break (== '/') str
- in msum $ [ fmap (i :) (match' ms (t ++ rest)) | (i, t) <- splits chunk ]
-match' (CaptureMany : ms) str =
+ in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]
+capture' (CaptureMany : ms) str =
-- Match everything
- msum $ [ fmap (i :) (match' ms t) | (i, t) <- splits str ]
+ msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
-- | Create an identifier from a pattern by filling in the captures with a given
-- string
--
-- Example:
--
--- > fromCapture (parsePattern "tags/*") (parseIdentifier "foo")
+-- > fromCapture (parseGlob "tags/*") (parseIdentifier "foo")
--
-- Result:
--
@@ -128,7 +137,7 @@ fromCapture pattern = fromCaptures pattern . repeat
-- | Simplified version of 'fromCapture' which takes a 'String' instead of an
-- 'Identifier'
--
--- > fromCaptureString (parsePattern "tags/*") "foo"
+-- > fromCaptureString (parseGlob "tags/*") "foo"
--
-- Result:
--
@@ -141,11 +150,19 @@ fromCaptureString pattern = fromCapture pattern . parseIdentifier
-- given list of strings
--
fromCaptures :: Pattern -> [Identifier] -> Identifier
-fromCaptures (Pattern []) _ = mempty
-fromCaptures (Pattern (m : ms)) [] = case m of
- Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) []
- _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures: "
+fromCaptures (Glob p) = fromCaptures' p
+fromCaptures (Predicate _) = error $
+ "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures called on a " ++
+ "predicate instead of a glob"
+
+-- | Internally used version of 'fromCaptures'
+--
+fromCaptures' :: [GlobComponent] -> [Identifier] -> Identifier
+fromCaptures' [] _ = mempty
+fromCaptures' (m : ms) [] = case m of
+ Literal l -> Identifier l `mappend` fromCaptures' ms []
+ _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "
++ "identifier list exhausted"
-fromCaptures (Pattern (m : ms)) ids@(i : is) = case m of
- Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) ids
- _ -> i `mappend` fromCaptures (Pattern ms) is
+fromCaptures' (m : ms) ids@(i : is) = case m of
+ Literal l -> Identifier l `mappend` fromCaptures' ms ids
+ _ -> i `mappend` fromCaptures' ms is