Add fromCapture(s)

src/Hakyll/Core/Identifier.hs

@@ -10,6 +10,7 @@
 --
 -- * @error/404@
 --
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Hakyll.Core.Identifier
     ( Identifier (..)
     , parseIdentifier
@@ -17,6 +18,7 @@ module Hakyll.Core.Identifier
     ) where
 
 import Control.Arrow (second)
+import Data.Monoid (Monoid)
 
 import GHC.Exts (IsString, fromString)
 import System.FilePath (joinPath)
@@ -24,7 +26,7 @@ import System.FilePath (joinPath)
 -- | An identifier used to uniquely identify a value
 --
 newtype Identifier = Identifier {unIdentifier :: [String]}
-                   deriving (Eq, Ord)
+                   deriving (Eq, Ord, Monoid)
 
 instance Show Identifier where
     show = toFilePath

src/Hakyll/Core/Identifier/Pattern.hs

@@ -34,11 +34,14 @@ module Hakyll.Core.Identifier.Pattern
     , match
     , doesMatch
     , matches
+    , fromCapture
+    , fromCaptures
     ) where
 
 import Data.List (intercalate)
 import Control.Monad (msum)
 import Data.Maybe (isJust)
+import Data.Monoid (mempty, mappend)
 
 import GHC.Exts (IsString, fromString)
 
@@ -78,8 +81,8 @@ parsePattern = Pattern . map toPattern . unIdentifier . parseIdentifier
 
 -- | Match an identifier against a pattern, generating a list of captures
 --
-match :: Pattern -> Identifier -> Maybe [[String]]
-match (Pattern p) (Identifier i) = match' p i
+match :: Pattern -> Identifier -> Maybe [Identifier]
+match (Pattern p) (Identifier i) = fmap (map Identifier) $ match' p i
 
 -- | Check if an identifier matches a pattern
 --
@@ -115,3 +118,22 @@ match' (m : ms) (s : ss) = case m of
     CaptureMany ->
         let take' (i, t) = fmap (i :) $ match' ms t
         in msum $ map take' $ splits (s : ss)
+
+-- | Create an identifier from a pattern by filling in the captures with a given
+-- string
+--
+fromCapture :: Pattern -> Identifier -> 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 -> [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: "
+                       ++ "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