git.iko.soy/hakyll
on master help sign in
Cleanup identifier and pattern types
86ede74Jasper Van der Jeugt
src/Hakyll/Core/Identifier.hs+33−54
compare with master
unifiedsplit
@@ -1,3 +1,4 @@
1+--------------------------------------------------------------------------------
1-- | An identifier is a type used to uniquely identify a resource, target...
2-- | An identifier is a type used to uniquely identify a resource, target...
2--
3--
3-- One can think of an identifier as something similar to a file path. An
4-- One can think of an identifier as something similar to a file path. An
@@ -28,82 +29,60 @@
28-- function.
29-- function.
29--
30--
30-- If the @a@ type is not known, Hakyll traditionally uses @Identifier ()@.
31-- If the @a@ type is not known, Hakyll traditionally uses @Identifier ()@.
31−--
32+{-# LANGUAGE DeriveDataTypeable #-}
32−{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
33+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
33module Hakyll.Core.Identifier
34module Hakyll.Core.Identifier
34− ( Identifier (..)
35+ ( Identifier
35− , castIdentifier
36− , parseIdentifier
37 , fromFilePath
36 , fromFilePath
38 , toFilePath
37 , toFilePath
39− , setGroup
38+ , castIdentifier
40 ) where
39 ) where
41
40
42−import Control.Applicative ((<$>), (<*>))
43−import Control.DeepSeq (NFData (..))
44−import Control.Monad (mplus)
45−import Data.Monoid (Monoid, mempty, mappend)
46−import Data.List (intercalate)
47−import System.FilePath (dropTrailingPathSeparator, splitPath)
48
41
49−import Data.Binary (Binary, get, put)
42+--------------------------------------------------------------------------------
50−import GHC.Exts (IsString, fromString)
43+import Control.DeepSeq (NFData)
51−import Data.Typeable (Typeable)
44+import Data.List (intercalate)
45+import System.FilePath (dropTrailingPathSeparator, splitPath)
52
46
53−-- | An identifier used to uniquely identify a value
54−--
55−data Identifier a = Identifier
56− { identifierGroup :: Maybe String
57− , identifierPath :: String
58− } deriving (Eq, Ord, Typeable)
59
47
60−instance Monoid (Identifier a) where
48+--------------------------------------------------------------------------------
61− mempty = Identifier Nothing ""
49+import Data.Binary (Binary)
62− Identifier g1 p1 `mappend` Identifier g2 p2 =
50+import Data.Typeable (Typeable)
63− Identifier (g1 `mplus` g2) (p1 `mappend` p2)
51+import GHC.Exts (IsString, fromString)
64
52
65−instance Binary (Identifier a) where
66− put (Identifier g p) = put g >> put p
67− get = Identifier <$> get <*> get
68
53
69−instance Show (Identifier a) where
54+--------------------------------------------------------------------------------
70− show i@(Identifier Nothing _) = toFilePath i
55+-- | An identifier used to uniquely identify a value
71− show i@(Identifier (Just g) _) = toFilePath i ++ " (" ++ g ++ ")"
56+newtype Identifier a = Identifier {unIdentifier :: String}
57+ deriving (Binary, Eq, NFData, Ord, Typeable)
72
58
73−instance IsString (Identifier a) where
74− fromString = parseIdentifier
75
59
60+--------------------------------------------------------------------------------
76−instance NFData (Identifier a) where
61+instance Show (Identifier a) where
77− rnf (Identifier g p) = rnf g `seq` rnf p `seq` ()
62+ show = toFilePath
78
63
79−-- | Discard the phantom type parameter of an identifier
64+
80−--
65+--------------------------------------------------------------------------------
81−castIdentifier :: Identifier a -> Identifier b
66+instance IsString (Identifier a) where
82−castIdentifier (Identifier g p) = Identifier g p
67+ fromString = fromFilePath
83−{-# INLINE castIdentifier #-}
84
68
85
69
86--------------------------------------------------------------------------------
70--------------------------------------------------------------------------------
87-- | Parse an identifier from a string
71-- | Parse an identifier from a string
88−parseIdentifier :: String -> Identifier a
72+fromFilePath :: String -> Identifier a
89−parseIdentifier = Identifier Nothing .
90− intercalate "/" . filter (not . null) . split'
73+fromFilePath = Identifier . intercalate "/" . filter (not . null) . split'
91 where
74 where
92 split' = map dropTrailingPathSeparator . splitPath
75 split' = map dropTrailingPathSeparator . splitPath
93
76
94
77
95−--------------------------------------------------------------------------------
96−-- | Create an identifier from a filepath
97−fromFilePath :: FilePath -> Identifier a
98−fromFilePath = parseIdentifier
99−
100−
101--------------------------------------------------------------------------------
78--------------------------------------------------------------------------------
102-- | Convert an identifier to a relative 'FilePath'
79-- | Convert an identifier to a relative 'FilePath'
103toFilePath :: Identifier a -> FilePath
80toFilePath :: Identifier a -> FilePath
104−toFilePath = identifierPath
81+toFilePath = unIdentifier
105
82
106−-- | Set the identifier group for some identifier
83+
107−--
84+--------------------------------------------------------------------------------
85+-- | Discard the phantom type parameter of an identifier
108−setGroup :: Maybe String -> Identifier a -> Identifier a
86+castIdentifier :: Identifier a -> Identifier b
109−setGroup g (Identifier _ p) = Identifier g p
87+castIdentifier (Identifier x) = Identifier x
88+{-# INLINE castIdentifier #-}
src/Hakyll/Core/Identifier/Pattern.hs+130−73
@@ -1,3 +1,4 @@
1+--------------------------------------------------------------------------------
1-- | Module providing pattern matching and capturing on 'Identifier's.
2-- | Module providing pattern matching and capturing on 'Identifier's.
2-- 'Pattern's come in two kinds:
3-- 'Pattern's come in two kinds:
3--
4--
@@ -34,71 +35,116 @@
34-- Like an 'Identifier', a 'Pattern' also has a type parameter. This is simply
35-- Like an 'Identifier', a 'Pattern' also has a type parameter. This is simply
35-- an extra layer of safety, and can be discarded using the 'castPattern'
36-- an extra layer of safety, and can be discarded using the 'castPattern'
36-- function.
37-- function.
37−--
38module Hakyll.Core.Identifier.Pattern
38module Hakyll.Core.Identifier.Pattern
39 ( -- * The pattern type
39 ( -- * The pattern type
40 Pattern
40 Pattern
41− , castPattern
42
41
43 -- * Creating patterns
42 -- * Creating patterns
44− , parseGlob
43+ , fromGlob
45− , predicate
44+ , fromList
46− , list
45+ , fromRegex
47− , regex
46+
48− , inGroup
47+ -- * Manipulating patterns
49 , complement
48 , complement
49+ , castPattern
50
50
51 -- * Applying patterns
51 -- * Applying patterns
52 , matches
52 , matches
53 , filterMatches
53 , filterMatches
54+
55+ -- * Capturing strings
54 , capture
56 , capture
55 , fromCapture
57 , fromCapture
56 , fromCaptures
58 , fromCaptures
57 ) where
59 ) where
58
60
59−import Data.List (isPrefixOf, inits, tails)
60−import Control.Arrow ((&&&), (>>>))
61−import Control.Monad (msum)
62−import Data.Maybe (isJust, fromMaybe)
63−import Data.Monoid (Monoid, mempty, mappend)
64
61
65−import GHC.Exts (IsString, fromString)
62+--------------------------------------------------------------------------------
66−import Text.Regex.TDFA ((=~~))
63+import Control.Applicative (pure, (<$>), (<*>))
64+import Control.Arrow ((&&&), (>>>))
65+import Control.Monad (msum)
66+import Data.Binary (Binary (..), getWord8, putWord8)
67+import Data.List (inits, isPrefixOf, tails)
68+import Data.Maybe (isJust)
69+import Data.Monoid (Monoid, mappend, mempty)
67
70
68−import Hakyll.Core.Identifier
69
71
72+--------------------------------------------------------------------------------
73+import GHC.Exts (IsString, fromString)
74+import Text.Regex.TDFA ((=~))
75+
76+
77+--------------------------------------------------------------------------------
78+import Hakyll.Core.Identifier
79+
80+
81+--------------------------------------------------------------------------------
70−-- | One base element of a pattern
82+-- | Elements of a glob pattern
71−--
72−data GlobComponent = Capture
83+data GlobComponent
84+ = Capture
73− | CaptureMany
85+ | CaptureMany
74− | Literal String
86+ | Literal String
75− deriving (Eq, Show)
87+ deriving (Eq, Show)
88+
89+
90+--------------------------------------------------------------------------------
91+instance Binary GlobComponent where
92+ put Capture = putWord8 0
93+ put CaptureMany = putWord8 1
94+ put (Literal s) = putWord8 2 >> put s
95+
96+ get = getWord8 >>= \t -> case t of
97+ 0 -> pure Capture
98+ 1 -> pure CaptureMany
99+ 2 -> Literal <$> get
100+ _ -> error "Data.Binary.get: Invalid GlobComponent"
101+
76
102
103+--------------------------------------------------------------------------------
77-- | Type that allows matching on identifiers
104-- | Type that allows matching on identifiers
78−--
105+data Pattern a
106+ = Everything
107+ | Complement (Pattern a)
108+ | And (Pattern a) (Pattern a)
79−data Pattern a = Glob [GlobComponent]
109+ | Glob [GlobComponent]
80− | Predicate (Identifier a -> Bool)
110+ | List [Identifier a] -- TODO Maybe use a set here
81− | List [Identifier a]
111+ | Regex String
112+ deriving (Show)
113+
114+
115+--------------------------------------------------------------------------------
116+instance Binary (Pattern a) where
117+ put Everything = putWord8 0
118+ put (Complement p) = putWord8 1 >> put p
119+ put (And x y) = putWord8 2 >> put x >> put y
120+ put (Glob g) = putWord8 3 >> put g
121+ put (List is) = putWord8 4 >> put is
122+ put (Regex r) = putWord8 5 >> put r
123+
124+ get = getWord8 >>= \t -> case t of
125+ 0 -> pure Everything
126+ 1 -> Complement <$> get
127+ 2 -> And <$> get <*> get
128+ 3 -> Glob <$> get
129+ 4 -> List <$> get
130+ _ -> Regex <$> get
82
131
132+
133+--------------------------------------------------------------------------------
83instance IsString (Pattern a) where
134instance IsString (Pattern a) where
84− fromString = parseGlob
135+ fromString = fromGlob
136+
85
137
138+--------------------------------------------------------------------------------
86instance Monoid (Pattern a) where
139instance Monoid (Pattern a) where
87− mempty = Predicate (const True)
140+ mempty = Everything
88− p1 `mappend` p2 = Predicate $ \i -> matches p1 i && matches p2 i
141+ mappend = And
89
142
90−-- | Discard the phantom type parameter
91−--
92−castPattern :: Pattern a -> Pattern b
93−castPattern (Glob g) = Glob g
94−castPattern (Predicate p) = Predicate $ p . castIdentifier
95−castPattern (List l) = List $ map castIdentifier l
96−{-# INLINE castPattern #-}
97
143
144+--------------------------------------------------------------------------------
98-- | Parse a pattern from a string
145-- | Parse a pattern from a string
99−--
100−parseGlob :: String -> Pattern a
146+fromGlob :: String -> Pattern a
101−parseGlob = Glob . parse'
147+fromGlob = Glob . parse'
102 where
148 where
103 parse' str =
149 parse' str =
104 let (chunk, rest) = break (`elem` "\\*") str
150 let (chunk, rest) = break (`elem` "\\*") str
@@ -108,35 +154,24 @@ parseGlob = Glob . parse'
108 ('*' : xs) -> Literal chunk : Capture : parse' xs
154 ('*' : xs) -> Literal chunk : Capture : parse' xs
109 xs -> Literal chunk : Literal xs : []
155 xs -> Literal chunk : Literal xs : []
110
156
111−-- | Create a 'Pattern' from an arbitrary predicate
112−--
113−-- Example:
114−--
115−-- > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i))
116−--
117−predicate :: (Identifier a -> Bool) -> Pattern a
118−predicate = Predicate
119
157
158+--------------------------------------------------------------------------------
120-- | Create a 'Pattern' from a list of 'Identifier's it should match
159-- | Create a 'Pattern' from a list of 'Identifier's it should match
121−--
122−list :: [Identifier a] -> Pattern a
160+fromList :: [Identifier a] -> Pattern a
123−list = List
161+fromList = List
124
162
163+
164+--------------------------------------------------------------------------------
125-- | Create a 'Pattern' from a regex
165-- | Create a 'Pattern' from a regex
126--
166--
127-- Example:
167-- Example:
128--
168--
129-- > regex "^foo/[^x]*$
169-- > regex "^foo/[^x]*$
130−--
131−regex :: String -> Pattern a
170+fromRegex :: String -> Pattern a
132−regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath
171+fromRegex = Regex
133
172
134−-- | Create a 'Pattern' which matches if the identifier is in a certain group
135−-- (or in no group)
136−--
137−inGroup :: Maybe String -> Pattern a
138−inGroup group = predicate $ (== group) . identifierGroup
139
173
174+--------------------------------------------------------------------------------
140-- | Inverts a pattern, e.g.
175-- | Inverts a pattern, e.g.
141--
176--
142-- > complement "foo/bar.html"
177-- > complement "foo/bar.html"
@@ -144,34 +179,53 @@ inGroup group = predicate $ (== group) . identifierGroup
144-- will match /anything/ except @\"foo\/bar.html\"@
179-- will match /anything/ except @\"foo\/bar.html\"@
145--
180--
146complement :: Pattern a -> Pattern a
181complement :: Pattern a -> Pattern a
147−complement p = predicate (not . matches p)
182+complement = Complement
183+
148
184
185+--------------------------------------------------------------------------------
186+-- | Discard the phantom type parameter
187+castPattern :: Pattern a -> Pattern b
188+castPattern Everything = Everything
189+castPattern (Complement x) = Complement (castPattern x)
190+castPattern (And x y) = And (castPattern x) (castPattern y)
191+castPattern (Glob g) = Glob g
192+castPattern (List l) = List $ map castIdentifier l
193+castPattern (Regex r) = Regex r
194+
195+
196+--------------------------------------------------------------------------------
149-- | Check if an identifier matches a pattern
197-- | Check if an identifier matches a pattern
150−--
151matches :: Pattern a -> Identifier a -> Bool
198matches :: Pattern a -> Identifier a -> Bool
199+matches Everything _ = True
200+matches (Complement p) i = not $ matches p i
201+matches (And x y) i = matches x i && matches y i
152−matches (Glob p) = isJust . capture (Glob p)
202+matches (Glob p) i = isJust $ capture (Glob p) i
153−matches (Predicate p) = (p $)
154−matches (List l) = (`elem` l)
203+matches (List l) i = i `elem` l
204+matches (Regex r) i = toFilePath i =~ r
205+
155
206
207+--------------------------------------------------------------------------------
156-- | Given a list of identifiers, retain only those who match the given pattern
208-- | Given a list of identifiers, retain only those who match the given pattern
157−--
158filterMatches :: Pattern a -> [Identifier a] -> [Identifier a]
209filterMatches :: Pattern a -> [Identifier a] -> [Identifier a]
159filterMatches = filter . matches
210filterMatches = filter . matches
160
211
212+
213+--------------------------------------------------------------------------------
161-- | Split a list at every possible point, generate a list of (init, tail)
214-- | Split a list at every possible point, generate a list of (init, tail)
162-- cases. The result is sorted with inits decreasing in length.
215-- cases. The result is sorted with inits decreasing in length.
163−--
164splits :: [a] -> [([a], [a])]
216splits :: [a] -> [([a], [a])]
165splits = inits &&& tails >>> uncurry zip >>> reverse
217splits = inits &&& tails >>> uncurry zip >>> reverse
166
218
219+
220+--------------------------------------------------------------------------------
167-- | Match a glob against a pattern, generating a list of captures
221-- | Match a glob against a pattern, generating a list of captures
168−--
169capture :: Pattern a -> Identifier a -> Maybe [String]
222capture :: Pattern a -> Identifier a -> Maybe [String]
170−capture (Glob p) (Identifier _ i) = capture' p i
223+capture (Glob p) i = capture' p (toFilePath i)
171−capture _ _ = Nothing
224+capture _ _ = Nothing
172
225
226+
227+--------------------------------------------------------------------------------
173-- | Internal verion of 'capture'
228-- | Internal verion of 'capture'
174−--
175capture' :: [GlobComponent] -> String -> Maybe [String]
229capture' :: [GlobComponent] -> String -> Maybe [String]
176capture' [] [] = Just [] -- An empty match
230capture' [] [] = Just [] -- An empty match
177capture' [] _ = Nothing -- No match
231capture' [] _ = Nothing -- No match
@@ -186,7 +240,9 @@ capture' (Capture : ms) str =
186capture' (CaptureMany : ms) str =
240capture' (CaptureMany : ms) str =
187 -- Match everything
241 -- Match everything
188 msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
242 msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
189−
243+
244+
245+--------------------------------------------------------------------------------
190-- | Create an identifier from a pattern by filling in the captures with a given
246-- | Create an identifier from a pattern by filling in the captures with a given
191-- string
247-- string
192--
248--
@@ -197,21 +253,22 @@ capture' (CaptureMany : ms) str =
197-- Result:
253-- Result:
198--
254--
199-- > "tags/foo"
255-- > "tags/foo"
200−--
201fromCapture :: Pattern a -> String -> Identifier a
256fromCapture :: Pattern a -> String -> Identifier a
202fromCapture pattern = fromCaptures pattern . repeat
257fromCapture pattern = fromCaptures pattern . repeat
203
258
259+
260+--------------------------------------------------------------------------------
204-- | Create an identifier from a pattern by filling in the captures with the
261-- | Create an identifier from a pattern by filling in the captures with the
205-- given list of strings
262-- given list of strings
206−--
207fromCaptures :: Pattern a -> [String] -> Identifier a
263fromCaptures :: Pattern a -> [String] -> Identifier a
208−fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p
264+fromCaptures (Glob p) = fromFilePath . fromCaptures' p
209fromCaptures _ = error $
265fromCaptures _ = error $
210 "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++
266 "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++
211 "on simple globs!"
267 "on simple globs!"
212
268
269+
270+--------------------------------------------------------------------------------
213-- | Internally used version of 'fromCaptures'
271-- | Internally used version of 'fromCaptures'
214−--
215fromCaptures' :: [GlobComponent] -> [String] -> String
272fromCaptures' :: [GlobComponent] -> [String] -> String
216fromCaptures' [] _ = mempty
273fromCaptures' [] _ = mempty
217fromCaptures' (m : ms) [] = case m of
274fromCaptures' (m : ms) [] = case m of