diff options
| -rw-r--r-- | src/Hakyll/Core/Dependencies.hs | 59 | ||||
| -rw-r--r-- | src/Hakyll/Core/Identifier.hs | 50 | ||||
| -rw-r--r-- | src/Hakyll/Core/Identifier/Pattern.hs | 17 |
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 -------------------------------------------------------------------------------- |