summaryrefslogtreecommitdiff
path: root/src/Hakyll/Core
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Core')
-rw-r--r--src/Hakyll/Core/Dependencies.hs59
-rw-r--r--src/Hakyll/Core/Identifier.hs50
-rw-r--r--src/Hakyll/Core/Identifier/Pattern.hs17
3 files changed, 111 insertions, 15 deletions
diff --git a/src/Hakyll/Core/Dependencies.hs b/src/Hakyll/Core/Dependencies.hs
new file mode 100644
index 0000000..76d9e32
--- /dev/null
+++ b/src/Hakyll/Core/Dependencies.hs
@@ -0,0 +1,59 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE BangPatterns #-}
+module Hakyll.Core.Dependencies
+ (
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Data.List (foldl')
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Set (Set)
+import qualified Data.Set as S
+
+
+--------------------------------------------------------------------------------
+import Hakyll.Core.Identifier
+import Hakyll.Core.Identifier.Pattern
+
+
+--------------------------------------------------------------------------------
+data Dependency
+ = Pattern (Pattern ()) [Identifier ()]
+ | Identifier (Identifier ())
+ deriving (Show)
+
+
+--------------------------------------------------------------------------------
+type DependencyFacts = Map (Identifier ()) [Dependency]
+
+
+--------------------------------------------------------------------------------
+outOfDate
+ :: [Identifier ()] -- ^ All known identifiers
+ -> Set (Identifier ()) -- ^ Initially out-of-date resources
+ -> DependencyFacts -- ^ Old dependency facts
+ -> (Set (Identifier ()), DependencyFacts)
+outOfDate universe ood oldFacts = (ood, oldFacts)
+
+
+--------------------------------------------------------------------------------
+-- | Determine patterns with changed results
+changedPatterns
+ :: [Identifier ()]
+ -> DependencyFacts
+ -> (Set (Identifier ()), DependencyFacts)
+changedPatterns universe facts =
+ M.foldlWithKey' changed (S.empty, facts) facts
+ where
+ changed (!o, !f) id' deps =
+ let (o', deps') = foldr (changed' id') (o, []) deps
+ in (o', M.insert id' deps' f)
+
+ changed' _ (Identifier i) (o, d) = (o, Identifier i : d)
+ changed' id' (Pattern p ls) (o, d)
+ | ls == ls' = (o, Pattern p ls : d)
+ | otherwise = (S.insert id' o, Pattern p ls' : d)
+ where
+ ls' = filterMatches p universe
diff --git a/src/Hakyll/Core/Identifier.hs b/src/Hakyll/Core/Identifier.hs
index 4ea9c8e..2cf8a53 100644
--- a/src/Hakyll/Core/Identifier.hs
+++ b/src/Hakyll/Core/Identifier.hs
@@ -36,30 +36,36 @@ module Hakyll.Core.Identifier
, fromFilePath
, toFilePath
, castIdentifier
+ , identifierVersion
+ , setVersion
) where
--------------------------------------------------------------------------------
-import Control.DeepSeq (NFData)
-import Data.List (intercalate)
-import System.FilePath (dropTrailingPathSeparator, splitPath)
+import Control.Applicative ((<$>), (<*>))
+import Control.DeepSeq (NFData (..))
+import Data.List (intercalate)
+import System.FilePath (dropTrailingPathSeparator, splitPath)
--------------------------------------------------------------------------------
-import Data.Binary (Binary)
-import Data.Typeable (Typeable)
-import GHC.Exts (IsString, fromString)
+import Data.Binary (Binary (..))
+import Data.Typeable (Typeable)
+import GHC.Exts (IsString, fromString)
--------------------------------------------------------------------------------
-- | An identifier used to uniquely identify a value
-newtype Identifier a = Identifier {unIdentifier :: String}
- deriving (Binary, Eq, NFData, Ord, Typeable)
+data Identifier a = Identifier
+ { identifierVersion :: Maybe String
+ , identifierPath :: String
+ } deriving (Eq, Ord, Typeable)
--------------------------------------------------------------------------------
-instance Show (Identifier a) where
- show = toFilePath
+instance Binary (Identifier a) where
+ put (Identifier v p) = put v >> put p
+ get = Identifier <$> get <*> get
--------------------------------------------------------------------------------
@@ -68,9 +74,22 @@ instance IsString (Identifier a) where
--------------------------------------------------------------------------------
+instance NFData (Identifier a) where
+ rnf (Identifier v p) = rnf v `seq` rnf p `seq` ()
+
+
+--------------------------------------------------------------------------------
+instance Show (Identifier a) where
+ show i = case identifierVersion i of
+ Nothing -> toFilePath i
+ Just v -> toFilePath i ++ " (" ++ v ++ ")"
+
+
+--------------------------------------------------------------------------------
-- | Parse an identifier from a string
fromFilePath :: String -> Identifier a
-fromFilePath = Identifier . intercalate "/" . filter (not . null) . split'
+fromFilePath = Identifier Nothing .
+ intercalate "/" . filter (not . null) . split'
where
split' = map dropTrailingPathSeparator . splitPath
@@ -78,11 +97,16 @@ fromFilePath = Identifier . intercalate "/" . filter (not . null) . split'
--------------------------------------------------------------------------------
-- | Convert an identifier to a relative 'FilePath'
toFilePath :: Identifier a -> FilePath
-toFilePath = unIdentifier
+toFilePath = identifierPath
--------------------------------------------------------------------------------
-- | Discard the phantom type parameter of an identifier
castIdentifier :: Identifier a -> Identifier b
-castIdentifier (Identifier x) = Identifier x
+castIdentifier (Identifier v p) = Identifier v p
{-# INLINE castIdentifier #-}
+
+
+--------------------------------------------------------------------------------
+setVersion :: Maybe String -> Identifier a -> Identifier a
+setVersion v i = i {identifierVersion = v}
diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs
index 24aecbd..589bf6a 100644
--- a/src/Hakyll/Core/Identifier/Pattern.hs
+++ b/src/Hakyll/Core/Identifier/Pattern.hs
@@ -46,6 +46,7 @@ module Hakyll.Core.Identifier.Pattern
-- * Manipulating patterns
, complement
+ , withVersion
, castPattern
-- * Applying patterns
@@ -109,6 +110,7 @@ data Pattern a
| Glob [GlobComponent]
| List [Identifier a] -- TODO Maybe use a set here
| Regex String
+ | Version (Maybe String)
deriving (Show)
@@ -120,6 +122,7 @@ instance Binary (Pattern a) where
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
@@ -127,7 +130,8 @@ instance Binary (Pattern a) where
2 -> And <$> get <*> get
3 -> Glob <$> get
4 -> List <$> get
- _ -> Regex <$> get
+ 5 -> Regex <$> get
+ _ -> Version <$> get
--------------------------------------------------------------------------------
@@ -177,12 +181,19 @@ fromRegex = Regex
-- > complement "foo/bar.html"
--
-- will match /anything/ except @\"foo\/bar.html\"@
---
complement :: Pattern a -> Pattern a
complement = Complement
--------------------------------------------------------------------------------
+-- | Specify a version, e.g.
+--
+-- > "foo/*.markdown" `withVersion` "pdf"
+withVersion :: Pattern a -> String -> Pattern a
+withVersion p v = And p $ Version $ Just v
+
+
+--------------------------------------------------------------------------------
-- | Discard the phantom type parameter
castPattern :: Pattern a -> Pattern b
castPattern Everything = Everything
@@ -191,6 +202,7 @@ castPattern (And x y) = And (castPattern x) (castPattern y)
castPattern (Glob g) = Glob g
castPattern (List l) = List $ map castIdentifier l
castPattern (Regex r) = Regex r
+castPattern (Version v) = Version v
--------------------------------------------------------------------------------
@@ -202,6 +214,7 @@ matches (And x y) i = matches x i && matches y i
matches (Glob p) i = isJust $ capture (Glob p) i
matches (List l) i = i `elem` l
matches (Regex r) i = toFilePath i =~ r
+matches (Version v) i = identifierVersion i == v
--------------------------------------------------------------------------------