Add identifierGroup, clean up Pattern API

2 files changed, 30 insertions, 29 deletions

diff --git a/src/Hakyll/Core/Identifier.hs b/src/Hakyll/Core/Identifier.hs
index 46d1350..5b205f1 100644
--- a/src/Hakyll/Core/Identifier.hs
+++ b/src/Hakyll/Core/Identifier.hs
@@ -28,17 +28,30 @@ module Hakyll.Core.Identifier
     ) where
 
 import Control.Arrow (second)
-import Data.Monoid (Monoid)
+import Control.Applicative ((<$>), (<*>))
+import Control.Monad (mplus)
+import Data.Monoid (Monoid, mempty, mappend)
 import Data.List (intercalate)
 
-import Data.Binary (Binary)
+import Data.Binary (Binary, get, put)
 import GHC.Exts (IsString, fromString)
 import Data.Typeable (Typeable)
 
 -- | An identifier used to uniquely identify a value
 --
-newtype Identifier = Identifier {unIdentifier :: String}
-                   deriving (Eq, Ord, Monoid, Binary, Typeable)
+data Identifier = Identifier
+    { identifierGroup :: Maybe String
+    , identifierPath  :: String
+    } deriving (Eq, Ord, Typeable)
+
+instance Monoid Identifier where
+    mempty = Identifier Nothing ""
+    Identifier g1 p1 `mappend` Identifier g2 p2 =
+        Identifier (g1 `mplus` g2) (p1 `mappend` p2)
+
+instance Binary Identifier where
+    put (Identifier g p) = put g >> put p
+    get = Identifier <$> get <*> get
 
 instance Show Identifier where
     show = toFilePath
@@ -49,7 +62,8 @@ instance IsString Identifier where
 -- | Parse an identifier from a string
 --
 parseIdentifier :: String -> Identifier
-parseIdentifier = Identifier . intercalate "/" . filter (not . null) . split'
+parseIdentifier = Identifier Nothing
+                . intercalate "/" . filter (not . null) . split'
   where
     split' [] = [[]]
     split' str = let (pre, post) = second (drop 1) $ break (== '/') str
@@ -58,4 +72,4 @@ parseIdentifier = Identifier . intercalate "/" . filter (not . null) . split'
 -- | Convert an identifier to a relative 'FilePath'
 --
 toFilePath :: Identifier -> FilePath
-toFilePath = unIdentifier
+toFilePath = identifierPath
diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs
index 8f3ac01..348ef46 100644
--- a/src/Hakyll/Core/Identifier/Pattern.hs
+++ b/src/Hakyll/Core/Identifier/Pattern.hs
@@ -40,7 +40,6 @@ module Hakyll.Core.Identifier.Pattern
     , filterMatches
     , capture
     , fromCapture
-    , fromCaptureString
     , fromCaptures
     ) where
 
@@ -126,9 +125,9 @@ splits = inits &&& tails >>> uncurry zip >>> reverse
 
 -- | Match a glob against a pattern, generating a list of captures
 --
-capture :: Pattern -> Identifier -> Maybe [Identifier]
-capture (Glob p) (Identifier i) = fmap (map Identifier) $ capture' p i
-capture (Predicate _) _         = Nothing
+capture :: Pattern -> Identifier -> Maybe [String]
+capture (Glob p) (Identifier _ i) = capture' p i
+capture (Predicate _) _           = Nothing
 
 -- | Internal verion of 'capture'
 --
@@ -152,44 +151,32 @@ capture' (CaptureMany : ms) str =
 --
 -- Example:
 --
--- > fromCapture (parseGlob "tags/*") (parseIdentifier "foo")
+-- > fromCapture (parseGlob "tags/*") "foo"
 --
 -- Result:
 --
 -- > "tags/foo"
 --
-fromCapture :: Pattern -> Identifier -> Identifier
+fromCapture :: Pattern -> String -> Identifier
 fromCapture pattern = fromCaptures pattern . repeat
 
--- | Simplified version of 'fromCapture' which takes a 'String' instead of an
--- 'Identifier'
---
--- > fromCaptureString (parseGlob "tags/*") "foo"
---
--- Result:
---
--- > "tags/foo"
---
-fromCaptureString :: Pattern -> String -> Identifier
-fromCaptureString pattern = fromCapture pattern . parseIdentifier
-
 -- | Create an identifier from a pattern by filling in the captures with the
 -- given list of strings
 --
-fromCaptures :: Pattern -> [Identifier] -> Identifier
-fromCaptures (Glob p)      = fromCaptures' p
+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"
 
 -- | Internally used version of 'fromCaptures'
 --
-fromCaptures' :: [GlobComponent] -> [Identifier] -> Identifier
+fromCaptures' :: [GlobComponent] -> [String] -> String
 fromCaptures' []        _ = mempty
 fromCaptures' (m : ms) [] = case m of
-    Literal l -> Identifier l `mappend` fromCaptures' ms []
+    Literal l -> l `mappend` fromCaptures' ms []
     _         -> error $  "Hakyll.Core.Identifier.Pattern.fromCaptures': "
                        ++ "identifier list exhausted"
 fromCaptures' (m : ms) ids@(i : is) = case m of
-    Literal l -> Identifier l `mappend` fromCaptures' ms ids
+    Literal l -> l `mappend` fromCaptures' ms ids
     _         -> i `mappend` fromCaptures' ms is