summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Core/Identifier.hs47
-rw-r--r--src/Hakyll/Core/Identifier/Pattern.hs91
2 files changed, 138 insertions, 0 deletions
diff --git a/src/Hakyll/Core/Identifier.hs b/src/Hakyll/Core/Identifier.hs
new file mode 100644
index 0000000..609e722
--- /dev/null
+++ b/src/Hakyll/Core/Identifier.hs
@@ -0,0 +1,47 @@
+-- | An identifier is a type used to uniquely identify a resource, target...
+--
+-- One can think of an identifier as something similar to a file path. An
+-- identifier is a path as well, with the different elements in the path
+-- separated by @/@ characters. Examples of identifiers are:
+--
+-- * @posts/foo.markdown@
+--
+-- * @index@
+--
+-- * @error/404@
+--
+module Hakyll.Core.Identifier
+ ( Identifier (..)
+ , parseIdentifier
+ , toFilePath
+ ) where
+
+import Control.Arrow (second)
+
+import GHC.Exts (IsString, fromString)
+import System.FilePath (joinPath)
+
+-- | An identifier used to uniquely identify a value
+--
+newtype Identifier = Identifier {unIdentifier :: [String]}
+ deriving (Eq, Ord)
+
+instance Show Identifier where
+ show = toFilePath
+
+instance IsString Identifier where
+ fromString = parseIdentifier
+
+-- | Parse an identifier from a string
+--
+parseIdentifier :: String -> Identifier
+parseIdentifier = Identifier . filter (not . null) . split'
+ where
+ split' [] = [[]]
+ split' str = let (pre, post) = second (drop 1) $ break (== '/') str
+ in pre : split' post
+
+-- | Convert an identifier to a relative 'FilePath'
+--
+toFilePath :: Identifier -> FilePath
+toFilePath = joinPath . unIdentifier
diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs
new file mode 100644
index 0000000..02b023f
--- /dev/null
+++ b/src/Hakyll/Core/Identifier/Pattern.hs
@@ -0,0 +1,91 @@
+-- | Module providing pattern matching and capturing on 'Identifier's.
+--
+-- TODO: Documentation
+--
+module Hakyll.Core.Identifier.Pattern
+ ( Pattern
+ , parsePattern
+ , match
+ , doesMatch
+ , matches
+ ) where
+
+import Data.List (intercalate)
+import Control.Monad (msum)
+import Data.Maybe (isJust)
+
+import GHC.Exts (IsString, fromString)
+
+import Hakyll.Core.Identifier
+
+-- | One base element of a pattern
+--
+data PatternComponent = CaptureOne
+ | CaptureMany
+ | Literal String
+ deriving (Eq)
+
+instance Show PatternComponent where
+ show CaptureOne = "*"
+ show CaptureMany = "**"
+ show (Literal s) = s
+
+-- | Type that allows matching on identifiers
+--
+newtype Pattern = Pattern {unPattern :: [PatternComponent]}
+ deriving (Eq)
+
+instance Show Pattern where
+ show = intercalate "/" . map show . unPattern
+
+instance IsString Pattern where
+ fromString = parsePattern
+
+-- | Parse a pattern from a string
+--
+parsePattern :: String -> Pattern
+parsePattern = Pattern . map toPattern . unIdentifier . parseIdentifier
+ where
+ toPattern x | x == "*" = CaptureOne
+ | x == "**" = CaptureMany
+ | otherwise = Literal x
+
+-- | Match an identifier against a pattern, generating a list of captures
+--
+match :: Pattern -> Identifier -> Maybe [[String]]
+match (Pattern p) (Identifier i) = match' p i
+
+-- | Check if an identifier matches a pattern
+--
+doesMatch :: Pattern -> Identifier -> Bool
+doesMatch p = isJust . match p
+
+-- | Given a list of identifiers, retain only those who match the given pattern
+--
+matches :: Pattern -> [Identifier] -> [Identifier]
+matches p = filter (doesMatch p)
+
+-- | Split a list at every possible point, generate a list of (init, tail) cases
+--
+splits :: [a] -> [([a], [a])]
+splits ls = reverse $ splits' [] ls
+ where
+ splits' lx ly = (lx, ly) : case ly of
+ [] -> []
+ (y : ys) -> splits' (lx ++ [y]) ys
+
+-- | Internal verion of 'match'
+--
+match' :: [PatternComponent] -> [String] -> Maybe [[String]]
+match' [] [] = Just [] -- An empty match
+match' [] _ = Nothing -- No match
+match' _ [] = Nothing -- No match
+match' (m : ms) (s : ss) = case m of
+ -- Take one string and one literal, fail on mismatch
+ Literal l -> if s == l then match' ms ss else Nothing
+ -- Take one string and one capture
+ CaptureOne -> fmap ([s] :) $ match' ms ss
+ -- Take one string, and one or many captures
+ CaptureMany ->
+ let take' (i, t) = fmap (i :) $ match' ms t
+ in msum $ map take' $ splits (s : ss)