260e4e2 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Context?

260e4e2Jasper Van der Jeugt14 years ago

src/Hakyll/Core/DirectedGraph.hs+21−10

compare with master

unifiedsplit

@@ -1,6 +1,6 @@

1+--------------------------------------------------------------------------------

1-- | Representation of a directed graph. In Hakyll, this is used for dependency

2-- | Representation of a directed graph. In Hakyll, this is used for dependency

2-- tracking.

3-- tracking.

3−--

4module Hakyll.Core.DirectedGraph

5 ( DirectedGraph

6 , fromList

@@ -12,6 +12,8 @@ module Hakyll.Core.DirectedGraph

12 , reachableNodes

13 ) where

15+

16+--------------------------------------------------------------------------------

15import Prelude hiding (reverse)

17import Prelude hiding (reverse)

16import Control.Arrow (second)

18import Control.Arrow (second)

17import Data.Monoid (mconcat)

19import Data.Monoid (mconcat)

@@ -20,47 +22,55 @@ import Data.Maybe (fromMaybe)

20import qualified Data.Map as M

22import qualified Data.Map as M

21import qualified Data.Set as S

23import qualified Data.Set as S

25+

26+--------------------------------------------------------------------------------

23import Hakyll.Core.DirectedGraph.Internal

27import Hakyll.Core.DirectedGraph.Internal

29+

30+--------------------------------------------------------------------------------

25-- | Construction of directed graphs

31-- | Construction of directed graphs

26−--

27fromList :: Ord a

32fromList :: Ord a

28 => [(a, Set a)] -- ^ List of (node, reachable neighbours)

33 => [(a, Set a)] -- ^ List of (node, reachable neighbours)

29 -> DirectedGraph a -- ^ Resulting directed graph

34 -> DirectedGraph a -- ^ Resulting directed graph

30fromList = DirectedGraph . M.fromList . map (\(t, d) -> (t, Node t d))

35fromList = DirectedGraph . M.fromList . map (\(t, d) -> (t, Node t d))

37+

38+--------------------------------------------------------------------------------

32-- | Deconstruction of directed graphs

39-- | Deconstruction of directed graphs

33−--

34toList :: DirectedGraph a

40toList :: DirectedGraph a

35 -> [(a, Set a)]

41 -> [(a, Set a)]

36toList = map (second nodeNeighbours) . M.toList . unDirectedGraph

42toList = map (second nodeNeighbours) . M.toList . unDirectedGraph

44+

45+--------------------------------------------------------------------------------

38-- | Check if a node lies in the given graph

46-- | Check if a node lies in the given graph

39−--

40member :: Ord a

47member :: Ord a

41 => a -- ^ Node to check for

48 => a -- ^ Node to check for

42 -> DirectedGraph a -- ^ Directed graph to check in

49 -> DirectedGraph a -- ^ Directed graph to check in

43 -> Bool -- ^ If the node lies in the graph

50 -> Bool -- ^ If the node lies in the graph

44member n = M.member n . unDirectedGraph

51member n = M.member n . unDirectedGraph

53+

54+--------------------------------------------------------------------------------

46-- | Get all nodes in the graph

55-- | Get all nodes in the graph

47−--

48nodes :: Ord a

56nodes :: Ord a

49 => DirectedGraph a -- ^ Graph to get the nodes from

57 => DirectedGraph a -- ^ Graph to get the nodes from

50 -> Set a -- ^ All nodes in the graph

58 -> Set a -- ^ All nodes in the graph

51nodes = M.keysSet . unDirectedGraph

59nodes = M.keysSet . unDirectedGraph

61+

62+--------------------------------------------------------------------------------

53-- | Get a set of reachable neighbours from a directed graph

63-- | Get a set of reachable neighbours from a directed graph

54−--

55neighbours :: Ord a

64neighbours :: Ord a

56 => a -- ^ Node to get the neighbours of

65 => a -- ^ Node to get the neighbours of

57 -> DirectedGraph a -- ^ Graph to search in

66 -> DirectedGraph a -- ^ Graph to search in

58 -> Set a -- ^ Set containing the neighbours

67 -> Set a -- ^ Set containing the neighbours

59−neighbours x = fromMaybe S.empty . fmap nodeNeighbours

68+neighbours x = fromMaybe S.empty . fmap nodeNeighbours .

60− . M.lookup x . unDirectedGraph

69+ M.lookup x . unDirectedGraph

71+

72+--------------------------------------------------------------------------------

62-- | Reverse a directed graph (i.e. flip all edges)

73-- | Reverse a directed graph (i.e. flip all edges)

63−--

64reverse :: Ord a

74reverse :: Ord a

65 => DirectedGraph a

75 => DirectedGraph a

66 -> DirectedGraph a

76 -> DirectedGraph a

@@ -69,8 +79,9 @@ reverse = mconcat . map reverse' . M.toList . unDirectedGraph

69 reverse' (id', Node _ neighbours') = fromList $

79 reverse' (id', Node _ neighbours') = fromList $

70 zip (S.toList neighbours') $ repeat $ S.singleton id'

80 zip (S.toList neighbours') $ repeat $ S.singleton id'

82+

83+--------------------------------------------------------------------------------

72-- | Find all reachable nodes from a given set of nodes in the directed graph

84-- | Find all reachable nodes from a given set of nodes in the directed graph

73−--

74reachableNodes :: Ord a => Set a -> DirectedGraph a -> Set a

85reachableNodes :: Ord a => Set a -> DirectedGraph a -> Set a

75reachableNodes set graph = reachable (setNeighbours set) set

86reachableNodes set graph = reachable (setNeighbours set) set

76 where

87 where

src/Hakyll/Core/DirectedGraph/Dot.hs+9−5

@@ -1,15 +1,18 @@

1+--------------------------------------------------------------------------------

1-- | Dump a directed graph in dot format. Used for debugging purposes

2-- | Dump a directed graph in dot format. Used for debugging purposes

2−--

3module Hakyll.Core.DirectedGraph.Dot

4 ( toDot

5 , writeDot

6 ) where

8−import Hakyll.Core.DirectedGraph

9−import qualified Data.Set as S

9+--------------------------------------------------------------------------------

10+import qualified Data.Set as S

11+import Hakyll.Core.DirectedGraph

12+

13+

14+--------------------------------------------------------------------------------

11-- | Convert a directed graph into dot format for debugging purposes

15-- | Convert a directed graph into dot format for debugging purposes

12−--

13toDot :: Ord a

16toDot :: Ord a

14 => (a -> String) -- ^ Convert nodes to dot names

17 => (a -> String) -- ^ Convert nodes to dot names

15 -> DirectedGraph a -- ^ Graph to dump

18 -> DirectedGraph a -- ^ Graph to dump

@@ -25,8 +28,9 @@ toDot showTag graph = unlines $ concat

25 showEdges node = map (showEdge node) $ S.toList $ neighbours node graph

28 showEdges node = map (showEdge node) $ S.toList $ neighbours node graph

26 showEdge x y = " \"" ++ showTag x ++ "\" -> \"" ++ showTag y ++ "\";"

29 showEdge x y = " \"" ++ showTag x ++ "\" -> \"" ++ showTag y ++ "\";"

31+

32+--------------------------------------------------------------------------------

28-- | Write out the @.dot@ file to a given file path. See 'toDot' for more

33-- | Write out the @.dot@ file to a given file path. See 'toDot' for more

29-- information.

34-- information.

30−--

31writeDot :: Ord a => FilePath -> (a -> String) -> DirectedGraph a -> IO ()

35writeDot :: Ord a => FilePath -> (a -> String) -> DirectedGraph a -> IO ()

32writeDot path showTag = writeFile path . toDot showTag

36writeDot path showTag = writeFile path . toDot showTag

src/Hakyll/Web/Template/Context.hs+49−1

@@ -2,13 +2,26 @@

2module Hakyll.Web.Template.Context

3 ( Context

4 , field

6+ , defaultContext

7+ , bodyField

8+ , urlField

9+ , pathField

10+ , categoryField

11+ , titleField

5 ) where

12 ) where

8--------------------------------------------------------------------------------

15--------------------------------------------------------------------------------

9−import Control.Applicative (empty)

16+import Control.Applicative (empty, (<|>))

10import Control.Arrow

17import Control.Arrow

18+import System.FilePath (takeBaseName, takeDirectory)

19+

20+

21+--------------------------------------------------------------------------------

11import Hakyll.Core.Compiler

22import Hakyll.Core.Compiler

23+import Hakyll.Core.Identifier

24+import Hakyll.Web.Urls

14--------------------------------------------------------------------------------

27--------------------------------------------------------------------------------

@@ -22,3 +35,38 @@ field key value = arr checkKey >>> empty ||| value

22 checkKey (k, x)

35 checkKey (k, x)

23 | k == key = Left ()

36 | k == key = Left ()

24 | otherwise = Right x

37 | otherwise = Right x

38+

39+

40+--------------------------------------------------------------------------------

41+defaultContext :: Context (Identifier String, String)

42+defaultContext =

43+ bodyField "body" <|>

44+ urlField "url" <|>

45+ pathField "path" <|>

46+ categoryField "category" <|>

47+ titleField "title"

48+

49+

50+--------------------------------------------------------------------------------

51+bodyField :: String -> Context (Identifier String, String)

52+bodyField key = field key $ arr snd

53+

54+

55+--------------------------------------------------------------------------------

56+urlField :: String -> Context (Identifier a, a)

57+urlField key = field key $ fst ^>> getRouteFor >>^ maybe empty toUrl

58+

59+

60+--------------------------------------------------------------------------------

61+pathField :: String -> Context (Identifier a, a)

62+pathField key = field key $ arr $ toFilePath . fst

63+

64+

65+--------------------------------------------------------------------------------

66+categoryField :: String -> Context (Identifier a, a)

67+categoryField key = pathField key >>^ (takeBaseName . takeDirectory)

68+

69+

70+--------------------------------------------------------------------------------

71+titleField :: String -> Context (Identifier a, a)

72+titleField key = pathField key >>^ takeBaseName