diff options
| -rw-r--r-- | src/Hakyll/Core/Identifier.hs | 47 | ||||
| -rw-r--r-- | src/Hakyll/Core/Identifier/Pattern.hs | 91 | ||||
| -rw-r--r-- | tests/Hakyll/Core/DirectedGraph/Tests.hs | 24 | ||||
| -rw-r--r-- | tests/Hakyll/Core/Identifier/Tests.hs | 29 | ||||
| -rw-r--r-- | tests/TestSuite.hs | 3 |
5 files changed, 182 insertions, 12 deletions
diff --git a/src/Hakyll/Core/Identifier.hs b/src/Hakyll/Core/Identifier.hs new file mode 100644 index 0000000..609e722 --- /dev/null +++ b/src/Hakyll/Core/Identifier.hs @@ -0,0 +1,47 @@ +-- | An identifier is a type used to uniquely identify a resource, target... +-- +-- One can think of an identifier as something similar to a file path. An +-- identifier is a path as well, with the different elements in the path +-- separated by @/@ characters. Examples of identifiers are: +-- +-- * @posts/foo.markdown@ +-- +-- * @index@ +-- +-- * @error/404@ +-- +module Hakyll.Core.Identifier + ( Identifier (..) + , parseIdentifier + , toFilePath + ) where + +import Control.Arrow (second) + +import GHC.Exts (IsString, fromString) +import System.FilePath (joinPath) + +-- | An identifier used to uniquely identify a value +-- +newtype Identifier = Identifier {unIdentifier :: [String]} + deriving (Eq, Ord) + +instance Show Identifier where + show = toFilePath + +instance IsString Identifier where + fromString = parseIdentifier + +-- | Parse an identifier from a string +-- +parseIdentifier :: String -> Identifier +parseIdentifier = Identifier . filter (not . null) . split' + where + split' [] = [[]] + split' str = let (pre, post) = second (drop 1) $ break (== '/') str + in pre : split' post + +-- | Convert an identifier to a relative 'FilePath' +-- +toFilePath :: Identifier -> FilePath +toFilePath = joinPath . unIdentifier diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs new file mode 100644 index 0000000..02b023f --- /dev/null +++ b/src/Hakyll/Core/Identifier/Pattern.hs @@ -0,0 +1,91 @@ +-- | Module providing pattern matching and capturing on 'Identifier's. +-- +-- TODO: Documentation +-- +module Hakyll.Core.Identifier.Pattern + ( Pattern + , parsePattern + , match + , doesMatch + , matches + ) where + +import Data.List (intercalate) +import Control.Monad (msum) +import Data.Maybe (isJust) + +import GHC.Exts (IsString, fromString) + +import Hakyll.Core.Identifier + +-- | One base element of a pattern +-- +data PatternComponent = CaptureOne + | CaptureMany + | Literal String + deriving (Eq) + +instance Show PatternComponent where + show CaptureOne = "*" + show CaptureMany = "**" + show (Literal s) = s + +-- | Type that allows matching on identifiers +-- +newtype Pattern = Pattern {unPattern :: [PatternComponent]} + deriving (Eq) + +instance Show Pattern where + show = intercalate "/" . map show . unPattern + +instance IsString Pattern where + fromString = parsePattern + +-- | Parse a pattern from a string +-- +parsePattern :: String -> Pattern +parsePattern = Pattern . map toPattern . unIdentifier . parseIdentifier + where + toPattern x | x == "*" = CaptureOne + | x == "**" = CaptureMany + | otherwise = Literal x + +-- | Match an identifier against a pattern, generating a list of captures +-- +match :: Pattern -> Identifier -> Maybe [[String]] +match (Pattern p) (Identifier i) = match' p i + +-- | Check if an identifier matches a pattern +-- +doesMatch :: Pattern -> Identifier -> Bool +doesMatch p = isJust . match p + +-- | Given a list of identifiers, retain only those who match the given pattern +-- +matches :: Pattern -> [Identifier] -> [Identifier] +matches p = filter (doesMatch p) + +-- | Split a list at every possible point, generate a list of (init, tail) cases +-- +splits :: [a] -> [([a], [a])] +splits ls = reverse $ splits' [] ls + where + splits' lx ly = (lx, ly) : case ly of + [] -> [] + (y : ys) -> splits' (lx ++ [y]) ys + +-- | Internal verion of 'match' +-- +match' :: [PatternComponent] -> [String] -> Maybe [[String]] +match' [] [] = Just [] -- An empty match +match' [] _ = Nothing -- No match +match' _ [] = Nothing -- No match +match' (m : ms) (s : ss) = case m of + -- Take one string and one literal, fail on mismatch + Literal l -> if s == l then match' ms ss else Nothing + -- Take one string and one capture + CaptureOne -> fmap ([s] :) $ match' ms ss + -- Take one string, and one or many captures + CaptureMany -> + let take' (i, t) = fmap (i :) $ match' ms t + in msum $ map take' $ splits (s : ss) diff --git a/tests/Hakyll/Core/DirectedGraph/Tests.hs b/tests/Hakyll/Core/DirectedGraph/Tests.hs index 4ce5944..1a9b406 100644 --- a/tests/Hakyll/Core/DirectedGraph/Tests.hs +++ b/tests/Hakyll/Core/DirectedGraph/Tests.hs @@ -15,9 +15,9 @@ import Hakyll.Core.DirectedGraph.ObsoleteFilter tests :: [Test] tests = - [ testCase "solveDependencies01" solveDependencies01 - , testCase "filterObsolete01" filterObsolete01 - , testCase "filterObsolete02" filterObsolete02 + [ testCase "solveDependencies [1]" solveDependencies1 + , testCase "filterObsolete [1]" filterObsolete1 + , testCase "filterObsolete [2]" filterObsolete2 ] node :: Ord a => a -> [a] -> (a, Set a) @@ -32,17 +32,17 @@ testGraph01 = fromList , node 3 [] ] -solveDependencies01 :: Assertion -solveDependencies01 = result == [3, 4, 2, 6, 8] || result == [3, 4, 2, 6, 8] - @? "solveDependencies01" +solveDependencies1 :: Assertion +solveDependencies1 = result == [3, 4, 2, 6, 8] || result == [3, 4, 2, 6, 8] + @? "solveDependencies1" where result = solveDependencies testGraph01 -filterObsolete01 :: Assertion -filterObsolete01 = nodes (filterObsolete [6] testGraph01) == S.fromList [6, 8] - @? "filterObsolete01" +filterObsolete1 :: Assertion +filterObsolete1 = nodes (filterObsolete [6] testGraph01) == S.fromList [6, 8] + @? "filterObsolete1" -filterObsolete02 :: Assertion -filterObsolete02 = +filterObsolete2 :: Assertion +filterObsolete2 = nodes (filterObsolete [4] testGraph01) == S.fromList [4, 2, 6, 8] - @? "filterObsolete02" + @? "filterObsolete2" diff --git a/tests/Hakyll/Core/Identifier/Tests.hs b/tests/Hakyll/Core/Identifier/Tests.hs new file mode 100644 index 0000000..910bca3 --- /dev/null +++ b/tests/Hakyll/Core/Identifier/Tests.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +module Hakyll.Core.Identifier.Tests + ( tests + ) where + +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) + +import Hakyll.Core.Identifier.Pattern + +tests :: [Test] +tests = zipWith testCase names matchCases + where + names = map (\n -> "match [" ++ show n ++ "]") [1 :: Int ..] + +-- | Collection of simple cases +-- +matchCases :: [Assertion] +matchCases = + [ Just [["bar"]] @=? match "foo/**" "foo/bar" + , Just [["foo", "bar"]] @=? match "**" "foo/bar" + , Nothing @=? match "*" "foo/bar" + , Just [] @=? match "foo" "foo" + , Just [["foo"]] @=? match "*/bar" "foo/bar" + , Just [["foo", "bar"]] @=? match "**/qux" "foo/bar/qux" + , Just [["foo", "bar"], ["qux"]] @=? match "**/*" "foo/bar/qux" + , Just [["foo"], ["bar", "qux"]] @=? match "*/**" "foo/bar/qux" + ] diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index 26b26f0..f75001f 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -3,9 +3,12 @@ module TestSuite where import Test.Framework (defaultMain, testGroup) import qualified Hakyll.Core.DirectedGraph.Tests +import qualified Hakyll.Core.Identifier.Tests main :: IO () main = defaultMain [ testGroup "Hakyll.Core.DirectedGraph.Tests" Hakyll.Core.DirectedGraph.Tests.tests + , testGroup "Hakyll.Core.Identifier.Tests" + Hakyll.Core.Identifier.Tests.tests ] |