Just messing around

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
 
 
 --------------------------------------------------------------------------------