diff options
| author | Jasper Van der Jeugt <m@jaspervdj.be> | 2012-11-24 13:34:50 +0100 |
|---|---|---|
| committer | Jasper Van der Jeugt <m@jaspervdj.be> | 2012-11-24 13:35:00 +0100 |
| commit | 6e7a80e8a3a4ac5d77a2f520cd8ecc1aba6f32ef (patch) | |
| tree | 28bbc77da81f485db5aa696d658e69c142c13bdf /src/Hakyll/Core/Identifier | |
| parent | 0a6b2b259862b90ccca11281de89091e2e01cb4d (diff) | |
| download | hakyll-6e7a80e8a3a4ac5d77a2f520cd8ecc1aba6f32ef.tar.gz | |
Simpler rules
Diffstat (limited to 'src/Hakyll/Core/Identifier')
| -rw-r--r-- | src/Hakyll/Core/Identifier/Pattern.hs | 30 |
1 files changed, 27 insertions, 3 deletions
diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs index eb9da374..97806d5 100644 --- a/src/Hakyll/Core/Identifier/Pattern.hs +++ b/src/Hakyll/Core/Identifier/Pattern.hs @@ -48,6 +48,7 @@ module Hakyll.Core.Identifier.Pattern -- * Manipulating patterns , complement , withVersion + , fromLiteral -- * Applying patterns , matches @@ -143,8 +144,18 @@ instance IsString Pattern where -------------------------------------------------------------------------------- instance Monoid Pattern where - mempty = Everything - mappend = And + mempty = Everything + mappend x y = optimize $ And x y + + +-------------------------------------------------------------------------------- +-- | THis is necessary for good 'isLiteral' results +optimize :: Pattern -> Pattern +optimize (Complement x) = Complement (optimize x) +optimize (And x Everything) = x +optimize (And Everything y) = y +optimize (And x y) = And (optimize x) (optimize y) +optimize p = p -------------------------------------------------------------------------------- @@ -197,7 +208,20 @@ complement = Complement -- -- > "foo/*.markdown" `withVersion` "pdf" withVersion :: Pattern -> String -> Pattern -withVersion p v = And p $ fromVersion $ Just v +withVersion p v = optimize $ And p $ fromVersion $ Just v + + +-------------------------------------------------------------------------------- +-- | Check if a pattern is a literal. @"*.markdown"@ is not a literal but +-- @"posts.markdown"@ is. +fromLiteral :: Pattern -> Maybe Identifier +fromLiteral pattern = case pattern of + Glob p -> fmap fromFilePath $ foldr fromLiteral' (Just "") p + _ -> Nothing + where + fromLiteral' (Literal x) (Just y) = Just $ x ++ y + fromLiteral' _ _ = Nothing + -------------------------------------------------------------------------------- |