1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
-- | This internal module is mostly here to prevent CPP conflicting with Haskell
-- comments.
module Hakyll.Core.Identifier.Pattern.Internal
( GlobComponent (..)
, Pattern (..)
) where
--------------------------------------------------------------------------------
import Data.Binary (Binary (..), getWord8, putWord8)
import Data.Set (Set)
--------------------------------------------------------------------------------
import Hakyll.Core.Identifier
--------------------------------------------------------------------------------
-- | Elements of a glob pattern
data GlobComponent
= Capture
| CaptureMany
| Literal String
deriving (Eq, Show)
--------------------------------------------------------------------------------
instance Binary GlobComponent where
put Capture = putWord8 0
put CaptureMany = putWord8 1
put (Literal s) = putWord8 2 >> put s
get = getWord8 >>= \t -> case t of
0 -> pure Capture
1 -> pure CaptureMany
2 -> Literal <$> get
_ -> error "Data.Binary.get: Invalid GlobComponent"
--------------------------------------------------------------------------------
-- | Type that allows matching on identifiers
data Pattern
= Everything
| Complement Pattern
| And Pattern Pattern
| Glob [GlobComponent]
| List (Set Identifier)
| Regex String
| Version (Maybe String)
deriving (Show)
--------------------------------------------------------------------------------
instance Binary Pattern where
put Everything = putWord8 0
put (Complement p) = putWord8 1 >> put p
put (And x y) = putWord8 2 >> put x >> put y
put (Glob g) = putWord8 3 >> put g
put (List is) = putWord8 4 >> put is
put (Regex r) = putWord8 5 >> put r
put (Version v) = putWord8 6 >> put v
get = getWord8 >>= \t -> case t of
0 -> pure Everything
1 -> Complement <$> get
2 -> And <$> get <*> get
3 -> Glob <$> get
4 -> List <$> get
5 -> Regex <$> get
_ -> Version <$> get
--------------------------------------------------------------------------------
instance Semigroup Pattern where
(<>) = And
instance Monoid Pattern where
mempty = Everything
mappend = (<>)
|
