git.iko.soy/hakyll
on 3fdf8ab help sign in
hakyll/src/Hakyll/Core/Identifier/Pattern.hs
91 lines 2.6 kB history raw
1-- | Module providing pattern matching and capturing on 'Identifier's.
2--
3-- TODO: Documentation
4--
5module Hakyll.Core.Identifier.Pattern
6 ( Pattern
7 , parsePattern
8 , match
9 , doesMatch
10 , matches
11 ) where
13import Data.List (intercalate)
14import Control.Monad (msum)
15import Data.Maybe (isJust)
17import GHC.Exts (IsString, fromString)
19import Hakyll.Core.Identifier
21-- | One base element of a pattern
22--
23data PatternComponent = CaptureOne
24 | CaptureMany
25 | Literal String
26 deriving (Eq)
28instance Show PatternComponent where
29 show CaptureOne = "*"
30 show CaptureMany = "**"
31 show (Literal s) = s
33-- | Type that allows matching on identifiers
34--
35newtype Pattern = Pattern {unPattern :: [PatternComponent]}
36 deriving (Eq)
38instance Show Pattern where
39 show = intercalate "/" . map show . unPattern
41instance IsString Pattern where
42 fromString = parsePattern
44-- | Parse a pattern from a string
45--
46parsePattern :: String -> Pattern
47parsePattern = Pattern . map toPattern . unIdentifier . parseIdentifier
48 where
49 toPattern x | x == "*" = CaptureOne
50 | x == "**" = CaptureMany
51 | otherwise = Literal x
53-- | Match an identifier against a pattern, generating a list of captures
54--
55match :: Pattern -> Identifier -> Maybe [[String]]
56match (Pattern p) (Identifier i) = match' p i
58-- | Check if an identifier matches a pattern
59--
60doesMatch :: Pattern -> Identifier -> Bool
61doesMatch p = isJust . match p
63-- | Given a list of identifiers, retain only those who match the given pattern
64--
65matches :: Pattern -> [Identifier] -> [Identifier]
66matches p = filter (doesMatch p)
68-- | Split a list at every possible point, generate a list of (init, tail) cases
69--
70splits :: [a] -> [([a], [a])]
71splits ls = reverse $ splits' [] ls
72 where
73 splits' lx ly = (lx, ly) : case ly of
74 [] -> []
75 (y : ys) -> splits' (lx ++ [y]) ys
77-- | Internal verion of 'match'
78--
79match' :: [PatternComponent] -> [String] -> Maybe [[String]]
80match' [] [] = Just [] -- An empty match
81match' [] _ = Nothing -- No match
82match' _ [] = Nothing -- No match
83match' (m : ms) (s : ss) = case m of
84 -- Take one string and one literal, fail on mismatch
85 Literal l -> if s == l then match' ms ss else Nothing
86 -- Take one string and one capture
87 CaptureOne -> fmap ([s] :) $ match' ms ss
88 -- Take one string, and one or many captures
89 CaptureMany ->
90 let take' (i, t) = fmap (i :) $ match' ms t
91 in msum $ map take' $ splits (s : ss)