diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Hakyll/Core/Identifier.hs | 26 | ||||
| -rw-r--r-- | src/Hakyll/Core/Identifier/Pattern.hs | 33 |
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 |