git.iko.soy/hakyll
on master help sign in
Add identifier/pattern modules
3fdf8abJasper Van der Jeugt
src/Hakyll/Core/Identifier.hsnew file+47
compare with master
unifiedsplit
@@ -0,0 +1,47 @@
1+-- | An identifier is a type used to uniquely identify a resource, target...
2+--
3+-- One can think of an identifier as something similar to a file path. An
4+-- identifier is a path as well, with the different elements in the path
5+-- separated by @/@ characters. Examples of identifiers are:
6+--
7+-- * @posts/foo.markdown@
8+--
9+-- * @index@
10+--
11+-- * @error/404@
12+--
13+module Hakyll.Core.Identifier
14+ ( Identifier (..)
15+ , parseIdentifier
16+ , toFilePath
17+ ) where
18+
19+import Control.Arrow (second)
20+
21+import GHC.Exts (IsString, fromString)
22+import System.FilePath (joinPath)
23+
24+-- | An identifier used to uniquely identify a value
25+--
26+newtype Identifier = Identifier {unIdentifier :: [String]}
27+ deriving (Eq, Ord)
28+
29+instance Show Identifier where
30+ show = toFilePath
31+
32+instance IsString Identifier where
33+ fromString = parseIdentifier
34+
35+-- | Parse an identifier from a string
36+--
37+parseIdentifier :: String -> Identifier
38+parseIdentifier = Identifier . filter (not . null) . split'
39+ where
40+ split' [] = [[]]
41+ split' str = let (pre, post) = second (drop 1) $ break (== '/') str
42+ in pre : split' post
43+
44+-- | Convert an identifier to a relative 'FilePath'
45+--
46+toFilePath :: Identifier -> FilePath
47+toFilePath = joinPath . unIdentifier
src/Hakyll/Core/Identifier/Pattern.hsnew file+91
@@ -0,0 +1,91 @@
1+-- | Module providing pattern matching and capturing on 'Identifier's.
2+--
3+-- TODO: Documentation
4+--
5+module Hakyll.Core.Identifier.Pattern
6+ ( Pattern
7+ , parsePattern
8+ , match
9+ , doesMatch
10+ , matches
11+ ) where
12+
13+import Data.List (intercalate)
14+import Control.Monad (msum)
15+import Data.Maybe (isJust)
16+
17+import GHC.Exts (IsString, fromString)
18+
19+import Hakyll.Core.Identifier
20+
21+-- | One base element of a pattern
22+--
23+data PatternComponent = CaptureOne
24+ | CaptureMany
25+ | Literal String
26+ deriving (Eq)
27+
28+instance Show PatternComponent where
29+ show CaptureOne = "*"
30+ show CaptureMany = "**"
31+ show (Literal s) = s
32+
33+-- | Type that allows matching on identifiers
34+--
35+newtype Pattern = Pattern {unPattern :: [PatternComponent]}
36+ deriving (Eq)
37+
38+instance Show Pattern where
39+ show = intercalate "/" . map show . unPattern
40+
41+instance IsString Pattern where
42+ fromString = parsePattern
43+
44+-- | Parse a pattern from a string
45+--
46+parsePattern :: String -> Pattern
47+parsePattern = Pattern . map toPattern . unIdentifier . parseIdentifier
48+ where
49+ toPattern x | x == "*" = CaptureOne
50+ | x == "**" = CaptureMany
51+ | otherwise = Literal x
52+
53+-- | Match an identifier against a pattern, generating a list of captures
54+--
55+match :: Pattern -> Identifier -> Maybe [[String]]
56+match (Pattern p) (Identifier i) = match' p i
57+
58+-- | Check if an identifier matches a pattern
59+--
60+doesMatch :: Pattern -> Identifier -> Bool
61+doesMatch p = isJust . match p
62+
63+-- | Given a list of identifiers, retain only those who match the given pattern
64+--
65+matches :: Pattern -> [Identifier] -> [Identifier]
66+matches p = filter (doesMatch p)
67+
68+-- | Split a list at every possible point, generate a list of (init, tail) cases
69+--
70+splits :: [a] -> [([a], [a])]
71+splits ls = reverse $ splits' [] ls
72+ where
73+ splits' lx ly = (lx, ly) : case ly of
74+ [] -> []
75+ (y : ys) -> splits' (lx ++ [y]) ys
76+
77+-- | Internal verion of 'match'
78+--
79+match' :: [PatternComponent] -> [String] -> Maybe [[String]]
80+match' [] [] = Just [] -- An empty match
81+match' [] _ = Nothing -- No match
82+match' _ [] = Nothing -- No match
83+match' (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)
tests/Hakyll/Core/DirectedGraph/Tests.hs+12−12
@@ -15,9 +15,9 @@ import Hakyll.Core.DirectedGraph.ObsoleteFilter
15
15
16tests :: [Test]
16tests :: [Test]
17tests =
17tests =
18− [ testCase "solveDependencies01" solveDependencies01
18+ [ testCase "solveDependencies [1]" solveDependencies1
19− , testCase "filterObsolete01" filterObsolete01
19+ , testCase "filterObsolete [1]" filterObsolete1
20− , testCase "filterObsolete02" filterObsolete02
20+ , testCase "filterObsolete [2]" filterObsolete2
21 ]
21 ]
22
22
23node :: Ord a => a -> [a] -> (a, Set a)
23node :: Ord a => a -> [a] -> (a, Set a)
@@ -32,17 +32,17 @@ testGraph01 = fromList
32 , node 3 []
32 , node 3 []
33 ]
33 ]
34
34
35−solveDependencies01 :: Assertion
35+solveDependencies1 :: Assertion
36−solveDependencies01 = result == [3, 4, 2, 6, 8] || result == [3, 4, 2, 6, 8]
36+solveDependencies1 = result == [3, 4, 2, 6, 8] || result == [3, 4, 2, 6, 8]
37− @? "solveDependencies01"
37+ @? "solveDependencies1"
38 where
38 where
39 result = solveDependencies testGraph01
39 result = solveDependencies testGraph01
40
40
41−filterObsolete01 :: Assertion
41+filterObsolete1 :: Assertion
42−filterObsolete01 = nodes (filterObsolete [6] testGraph01) == S.fromList [6, 8]
42+filterObsolete1 = nodes (filterObsolete [6] testGraph01) == S.fromList [6, 8]
43− @? "filterObsolete01"
43+ @? "filterObsolete1"
44
44
45−filterObsolete02 :: Assertion
45+filterObsolete2 :: Assertion
46−filterObsolete02 =
46+filterObsolete2 =
47 nodes (filterObsolete [4] testGraph01) == S.fromList [4, 2, 6, 8]
47 nodes (filterObsolete [4] testGraph01) == S.fromList [4, 2, 6, 8]
48− @? "filterObsolete02"
48+ @? "filterObsolete2"
tests/Hakyll/Core/Identifier/Tests.hsnew file+29
@@ -0,0 +1,29 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Hakyll.Core.Identifier.Tests
3+ ( tests
4+ ) where
5+
6+import Test.Framework
7+import Test.Framework.Providers.HUnit
8+import Test.HUnit hiding (Test)
9+
10+import Hakyll.Core.Identifier.Pattern
11+
12+tests :: [Test]
13+tests = zipWith testCase names matchCases
14+ where
15+ names = map (\n -> "match [" ++ show n ++ "]") [1 :: Int ..]
16+
17+-- | Collection of simple cases
18+--
19+matchCases :: [Assertion]
20+matchCases =
21+ [ Just [["bar"]] @=? match "foo/**" "foo/bar"
22+ , Just [["foo", "bar"]] @=? match "**" "foo/bar"
23+ , Nothing @=? match "*" "foo/bar"
24+ , Just [] @=? match "foo" "foo"
25+ , Just [["foo"]] @=? match "*/bar" "foo/bar"
26+ , Just [["foo", "bar"]] @=? match "**/qux" "foo/bar/qux"
27+ , Just [["foo", "bar"], ["qux"]] @=? match "**/*" "foo/bar/qux"
28+ , Just [["foo"], ["bar", "qux"]] @=? match "*/**" "foo/bar/qux"
29+ ]
tests/TestSuite.hs+3
@@ -3,9 +3,12 @@ module TestSuite where
3import Test.Framework (defaultMain, testGroup)
3import Test.Framework (defaultMain, testGroup)
4
4
5import qualified Hakyll.Core.DirectedGraph.Tests
5import qualified Hakyll.Core.DirectedGraph.Tests
6+import qualified Hakyll.Core.Identifier.Tests
6
7
7main :: IO ()
8main :: IO ()
8main = defaultMain
9main = defaultMain
9 [ testGroup "Hakyll.Core.DirectedGraph.Tests"
10 [ testGroup "Hakyll.Core.DirectedGraph.Tests"
10 Hakyll.Core.DirectedGraph.Tests.tests
11 Hakyll.Core.DirectedGraph.Tests.tests
12+ , testGroup "Hakyll.Core.Identifier.Tests"
13+ Hakyll.Core.Identifier.Tests.tests
11 ]
14 ]