From b1f70c339e031c1f6abf04ff63566f2cb9757a07 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 19 Nov 2012 15:52:51 +0100 Subject: Support old directory versions... --- src/Hakyll/Core/DependencyAnalyzer.hs | 144 ---------------------------------- src/Hakyll/Core/DirectedGraph.hs | 90 --------------------- src/Hakyll/Core/DirectedGraph/Dot.hs | 36 --------- src/Hakyll/Core/Provider/Modified.hs | 21 ++++- 4 files changed, 18 insertions(+), 273 deletions(-) delete mode 100644 src/Hakyll/Core/DependencyAnalyzer.hs delete mode 100644 src/Hakyll/Core/DirectedGraph.hs delete mode 100644 src/Hakyll/Core/DirectedGraph/Dot.hs (limited to 'src') diff --git a/src/Hakyll/Core/DependencyAnalyzer.hs b/src/Hakyll/Core/DependencyAnalyzer.hs deleted file mode 100644 index be470b3..0000000 --- a/src/Hakyll/Core/DependencyAnalyzer.hs +++ /dev/null @@ -1,144 +0,0 @@ --------------------------------------------------------------------------------- -module Hakyll.Core.DependencyAnalyzer - ( Analysis (..) - , analyze - ) where - - --------------------------------------------------------------------------------- -import Control.Applicative ((<$>)) -import Control.DeepSeq (NFData (..)) -import Control.Monad (filterM, forM_, msum, when) -import Control.Monad.Reader (ask) -import Control.Monad.RWS (RWS, runRWS) -import Control.Monad.State (evalState, get, modify) -import Control.Monad.Writer (tell) -import qualified Data.Map as M -import Data.Set (Set) -import qualified Data.Set as S - - --------------------------------------------------------------------------------- -import Hakyll.Core.DirectedGraph - - --------------------------------------------------------------------------------- -data Analysis a - = Cycle [a] - | Order [a] - deriving (Show) - - --------------------------------------------------------------------------------- -instance NFData a => NFData (Analysis a) where - rnf (Cycle c) = rnf c `seq` () - rnf (Order o) = rnf o `seq` () - - --------------------------------------------------------------------------------- -analyze :: Ord a - => DirectedGraph a -- ^ Old graph - -> DirectedGraph a -- ^ New graph - -> (a -> Bool) -- ^ Out of date? - -> Analysis a -- ^ Result -analyze old new ood = case findCycle new of - Just c -> Cycle c - Nothing -> Order $ findOrder old new ood - - --------------------------------------------------------------------------------- --- | Simple algorithm do find a cycle in a graph, if any exists. This one can --- still be optimised by a lot. -findCycle :: Ord a - => DirectedGraph a - -> Maybe [a] -findCycle dg = fmap reverse $ msum - [ findCycle' [x] x n - | x <- S.toList $ nodes dg - , n <- neighbours x dg - ] - where - findCycle' stack start x - | x == start = Just (x : stack) - | otherwise = msum - [ findCycle' (x : stack) start n - | n <- neighbours x dg - ] - - --------------------------------------------------------------------------------- --- | Do not call this on graphs with cycles -findOrder :: Ord a - => DirectedGraph a - -> DirectedGraph a - -> (a -> Bool) - -> [a] -findOrder old new ood = ls - where - -- Make an extension of ood: an item is ood when it is actually ood OR if - -- the list of its dependencies has changed. Based on that, create a set of - -- dirty items. - ood' x = ood x || neighbours x old /= neighbours x new - dirty' = dirty ood' new - - -- Run all walks in our own little monad... - (_, _, ls) = runRWS walks new dirty' - - --------------------------------------------------------------------------------- -type Analyzer i a = RWS (DirectedGraph i) [i] (Set i) a - - --------------------------------------------------------------------------------- -isDirty :: Ord a => a -> Analyzer a Bool -isDirty x = (x `S.member`) <$> get - - --------------------------------------------------------------------------------- -walks :: Ord a - => Analyzer a () -walks = do - dirty' <- get - if S.null dirty' - then return () - else do - walk $ S.findMin dirty' - walks - - --------------------------------------------------------------------------------- --- | Invariant: given node to walk /must/ be dirty -walk :: Ord a - => a - -> Analyzer a () -walk x = do - -- Determine dirty neighbours and walk them - dg <- ask - forM_ (neighbours x dg) $ \n -> do - d <- isDirty n - when d $ walk n - - -- Once all dirty neighbours are done, we're safe to go - tell [x] - modify $ S.delete x - - --------------------------------------------------------------------------------- --- | This auxiliary function checks which nodes are dirty: a node is dirty if --- it's out-of-date or if one of its dependencies is dirty. -dirty :: Ord a - => (a -> Bool) -- ^ Out of date? - -> DirectedGraph a -- ^ Graph - -> Set a -- ^ All dirty items -dirty ood dg = S.fromList $ flip evalState M.empty $ - filterM go $ S.toList $ nodes dg - where - go x = do - m <- get - case M.lookup x m of - Just d -> return d - Nothing -> do - nd <- mapM go $ neighbours x dg - let d = ood x || or nd - modify $ M.insert x d - return d diff --git a/src/Hakyll/Core/DirectedGraph.hs b/src/Hakyll/Core/DirectedGraph.hs deleted file mode 100644 index bc2a234..0000000 --- a/src/Hakyll/Core/DirectedGraph.hs +++ /dev/null @@ -1,90 +0,0 @@ --------------------------------------------------------------------------------- --- | Representation of a directed graph. In Hakyll, this is used for dependency --- tracking. -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Hakyll.Core.DirectedGraph - ( DirectedGraph - - , fromList - , toList - - , member - , nodes - , neighbours - ) where - - --------------------------------------------------------------------------------- -import Control.Arrow (second) -import Control.DeepSeq (NFData) -import Data.Binary (Binary) -import Data.Map (Map) -import qualified Data.Map as M -import Data.Maybe (fromMaybe) -import Data.Monoid (Monoid (..)) -import Data.Set (Set) -import qualified Data.Set as S -import Data.Typeable (Typeable) -import Prelude hiding (reverse) - - --------------------------------------------------------------------------------- --- | Type used to represent a directed graph -newtype DirectedGraph a = DirectedGraph {unDirectedGraph :: Map a [a]} - deriving (Show, Binary, NFData, Typeable) - - --------------------------------------------------------------------------------- --- | Allow users to concatenate different graphs -instance Ord a => Monoid (DirectedGraph a) where - mempty = DirectedGraph M.empty - mappend (DirectedGraph m1) (DirectedGraph m2) = DirectedGraph $ - M.unionWith (\x y -> sortUnique (x ++ y)) m1 m2 - - --------------------------------------------------------------------------------- --- | Construction of directed graphs -fromList :: Ord a - => [(a, [a])] -- ^ List of (node, reachable neighbours) - -> DirectedGraph a -- ^ Resulting directed graph -fromList = DirectedGraph . M.fromList . map (second sortUnique) - - --------------------------------------------------------------------------------- --- | Deconstruction of directed graphs -toList :: DirectedGraph a - -> [(a, [a])] -toList = M.toList . unDirectedGraph - - --------------------------------------------------------------------------------- --- | Check if a node lies in the given graph -member :: Ord a - => a -- ^ Node to check for - -> DirectedGraph a -- ^ Directed graph to check in - -> Bool -- ^ If the node lies in the graph -member n = M.member n . unDirectedGraph - - --------------------------------------------------------------------------------- --- | Get all nodes in the graph -nodes :: Ord a - => DirectedGraph a -- ^ Graph to get the nodes from - -> Set a -- ^ All nodes in the graph -nodes = M.keysSet . unDirectedGraph - - --------------------------------------------------------------------------------- --- | Get a set of reachable neighbours from a directed graph -neighbours :: Ord a - => a -- ^ Node to get the neighbours of - -> DirectedGraph a -- ^ Graph to search in - -> [a] -- ^ Set containing the neighbours -neighbours x dg = fromMaybe [] $ M.lookup x $ unDirectedGraph dg - - --------------------------------------------------------------------------------- --- | Sort and make unique -sortUnique :: Ord a => [a] -> [a] -sortUnique = S.toAscList . S.fromList diff --git a/src/Hakyll/Core/DirectedGraph/Dot.hs b/src/Hakyll/Core/DirectedGraph/Dot.hs deleted file mode 100644 index 06198e4..0000000 --- a/src/Hakyll/Core/DirectedGraph/Dot.hs +++ /dev/null @@ -1,36 +0,0 @@ --------------------------------------------------------------------------------- --- | Dump a directed graph in dot format. Used for debugging purposes -module Hakyll.Core.DirectedGraph.Dot - ( toDot - , writeDot - ) where - - --------------------------------------------------------------------------------- -import qualified Data.Set as S -import Hakyll.Core.DirectedGraph - - --------------------------------------------------------------------------------- --- | Convert a directed graph into dot format for debugging purposes -toDot :: Ord a - => (a -> String) -- ^ Convert nodes to dot names - -> DirectedGraph a -- ^ Graph to dump - -> String -- ^ Resulting string -toDot showTag graph = unlines $ concat - [ return "digraph dependencies {" - , map showNode (S.toList $ nodes graph) - , concatMap showEdges (S.toList $ nodes graph) - , return "}" - ] - where - showNode node = " \"" ++ showTag node ++ "\";" - showEdges node = map (showEdge node) $ neighbours node graph - showEdge x y = " \"" ++ showTag x ++ "\" -> \"" ++ showTag y ++ "\";" - - --------------------------------------------------------------------------------- --- | Write out the @.dot@ file to a given file path. See 'toDot' for more --- information. -writeDot :: Ord a => FilePath -> (a -> String) -> DirectedGraph a -> IO () -writeDot path showTag = writeFile path . toDot showTag diff --git a/src/Hakyll/Core/Provider/Modified.hs b/src/Hakyll/Core/Provider/Modified.hs index 08bb66a..8fad96a 100644 --- a/src/Hakyll/Core/Provider/Modified.hs +++ b/src/Hakyll/Core/Provider/Modified.hs @@ -1,4 +1,5 @@ -------------------------------------------------------------------------------- +{-# LANGUAGE CPP #-} module Hakyll.Core.Provider.Modified ( resourceModified , resourceModificationTime @@ -15,7 +16,15 @@ import Data.IORef import qualified Data.Map as M import Data.Time (UTCTime) import System.Directory (getModificationTime) -import System.FilePath (()) + + +-------------------------------------------------------------------------------- +#if !MIN_VERSION_directory(1,2,0) +import Data.Time (readTime) +import System.Locale (defaultTimeLocale) +import System.Time (formatCalendarTime, + toCalendarTime) +#endif -------------------------------------------------------------------------------- @@ -82,5 +91,11 @@ fileDigest = fmap MD5.hashlazy . BL.readFile -------------------------------------------------------------------------------- resourceModificationTime :: Provider -> Identifier -> IO UTCTime -resourceModificationTime p i = - getModificationTime $ providerDirectory p toFilePath i +resourceModificationTime p i = do +#if MIN_VERSION_directory(1,2,0) + getModificationTime $ resourceFilePath p i +#else + ct <- toCalendarTime =<< getModificationTime (resourceFilePath p i) + let str = formatCalendarTime defaultTimeLocale "%s" ct + return $ readTime defaultTimeLocale "%s" str +#endif -- cgit v1.2.3