8602f23 · hakyll · git.iko.soy

hakyll.cabal+1

compare with master

unifiedsplit

@@ -49,3 +49,4 @@ library

49 Text.Hakyll.Regex

50 Network.Hakyll.SimpleServer

51 other-modules: Text.Hakyll.Render.Internal

52+ Text.Hakyll.Internal.Cache

src/Text/Hakyll.hs+21−24

@@ -4,7 +4,7 @@ module Text.Hakyll

4 , hakyllWithConfiguration

5 ) where

6

7−import Control.Monad.Reader (runReaderT)

7+import Control.Monad.Reader (runReaderT, liftIO)

8import Control.Monad (when)

9import qualified Data.Map as M

10import System.Environment (getArgs, getProgName)

@@ -17,6 +17,8 @@ import Text.Hakyll.Hakyll

17defaultHakyllConfiguration :: HakyllConfiguration

18defaultHakyllConfiguration = HakyllConfiguration

19 { additionalContext = M.empty

20+ , siteDirectory = "_site"

21+ , cacheDirectory = "_cache"

20 }

22 }

21

23

22-- | Hakyll with a default configuration.

24-- | Hakyll with a default configuration.

@@ -27,32 +29,27 @@ hakyll = hakyllWithConfiguration defaultHakyllConfiguration

27hakyllWithConfiguration :: HakyllConfiguration -> Hakyll () -> IO ()

29hakyllWithConfiguration :: HakyllConfiguration -> Hakyll () -> IO ()

28hakyllWithConfiguration configuration buildFunction = do

30hakyllWithConfiguration configuration buildFunction = do

29 args <- getArgs

31 args <- getArgs

30− case args of ["build"] -> build'

32+ let f = case args of ["build"] -> buildFunction

31− ["clean"] -> clean

33+ ["clean"] -> clean

32− ["preview", p] -> build' >> server (read p)

34+ ["preview", p] -> buildFunction >> server (read p)

33− ["preview"] -> build' >> server 8000

35+ ["preview"] -> buildFunction >> server 8000

34− ["server", p] -> server (read p)

36+ ["server", p] -> server (read p)

35− ["server"] -> server 8000

37+ ["server"] -> server 8000

36− _ -> help

38+ _ -> help

37− where

38− build' = build configuration buildFunction

39−

40−-- | Build the site.

41−build :: HakyllConfiguration -> Hakyll () -> IO ()

42−build configuration buildFunction = do putStrLn "Generating..."

43− runReaderT buildFunction configuration

39+ runReaderT f configuration

44

40

45-- | Clean up directories.

41-- | Clean up directories.

46−clean :: IO ()

42+clean :: Hakyll ()

47−clean = remove' "_site"

43+clean = do askHakyll siteDirectory >>= remove'

44+ askHakyll cacheDirectory >>= remove'

48 where

45 where

49− remove' dir = do putStrLn $ "Removing " ++ dir ++ "..."

46+ remove' dir = liftIO $ do putStrLn $ "Removing " ++ dir ++ "..."

50− exists <- doesDirectoryExist dir

47+ exists <- doesDirectoryExist dir

51− when exists $ removeDirectoryRecursive dir

48+ when exists $ removeDirectoryRecursive dir

52

49

53-- | Show usage information.

50-- | Show usage information.

54−help :: IO ()

51+help :: Hakyll ()

55−help = do

52+help = liftIO $ do

56 name <- getProgName

53 name <- getProgName

57 putStrLn $ "This is a Hakyll site generator program. You should always\n"

54 putStrLn $ "This is a Hakyll site generator program. You should always\n"

58 ++ "run it from the project root directory.\n"

55 ++ "run it from the project root directory.\n"

@@ -64,5 +61,5 @@ help = do

64 ++ name ++ " preview [port] Generate site, then start a server.\n"

61 ++ name ++ " preview [port] Generate site, then start a server.\n"

65 ++ name ++ " server [port] Run a local test server.\n"

62 ++ name ++ " server [port] Run a local test server.\n"

66

63

67−server :: Integer -> IO ()

64+server :: Integer -> Hakyll ()

68−server p = simpleServer (fromIntegral p) "_site"

65+server p = askHakyll siteDirectory >>= liftIO . simpleServer (fromIntegral p)

src/Text/Hakyll/File.hs+20−11

@@ -2,13 +2,14 @@

2-- files and directories.

3module Text.Hakyll.File

4 ( toDestination

5+ , toCache

5 , toURL

6 , toURL

6 , toRoot

7 , toRoot

7 , removeSpaces

8 , removeSpaces

8 , makeDirectories

9 , makeDirectories

9 , getRecursiveContents

10 , getRecursiveContents

10 , havingExtension

11 , havingExtension

11− , isCacheValid

12+ , isMoreRecent

12 , directory

13 , directory

13 ) where

14 ) where

14

15

@@ -18,7 +19,7 @@ import Control.Monad

18import Data.List (isPrefixOf)

19import Data.List (isPrefixOf)

19import Control.Monad.Reader (liftIO)

20import Control.Monad.Reader (liftIO)

20

21

21−import Text.Hakyll.Hakyll (Hakyll)

22+import Text.Hakyll.Hakyll

22

23

23-- | Auxiliary function to remove pathSeparators form the start. We don't deal

24-- | Auxiliary function to remove pathSeparators form the start. We don't deal

24-- with absolute paths here. We also remove $root from the start.

25-- with absolute paths here. We also remove $root from the start.

@@ -31,9 +32,17 @@ removeLeadingSeparator path

31 path' = if "$root" `isPrefixOf` path then drop 5 path

32 path' = if "$root" `isPrefixOf` path then drop 5 path

32 else path

33 else path

33

34

34−-- | Convert a relative filepath to a filepath in the destination (@_site@).

35+-- | Convert a relative filepath to a filepath in the destination

36+-- (default: @_site@).

35−toDestination :: FilePath -> FilePath

37+toDestination :: FilePath -> Hakyll FilePath

38+toDestination path = do dir <- askHakyll siteDirectory

39+ return $ dir </> removeLeadingSeparator path

40+

41+-- | Convert a relative filepath to a filepath in the cache

42+-- (default: @_cache@).

43+toCache :: FilePath -> Hakyll FilePath

44+toCache path = do dir <- askHakyll cacheDirectory

36−toDestination path = "_site" </> removeLeadingSeparator path

45+ return $ dir </> removeLeadingSeparator path

37

46

38-- | Get the url for a given page.

47-- | Get the url for a given page.

39toURL :: FilePath -> FilePath

48toURL :: FilePath -> FilePath

@@ -103,14 +112,14 @@ havingExtension extension = filter ((==) extension . takeExtension)

103directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()

112directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()

104directory action dir = getRecursiveContents dir >>= mapM_ action

113directory action dir = getRecursiveContents dir >>= mapM_ action

105

114

106−-- | Check if a cache file is still valid.

115+-- | Check if a file is newer then a number of given files.

107−isCacheValid :: FilePath -- ^ The cached file.

116+isMoreRecent :: FilePath -- ^ The cached file.

108 -> [FilePath] -- ^ Dependencies of the cached file.

117 -> [FilePath] -- ^ Dependencies of the cached file.

109 -> Hakyll Bool

118 -> Hakyll Bool

110−isCacheValid cache depends = do

119+isMoreRecent file depends = do

111− exists <- liftIO $ doesFileExist cache

120+ exists <- liftIO $ doesFileExist file

112 if not exists

121 if not exists

113 then return False

122 then return False

114 else do dependsModified <- liftIO $ mapM getModificationTime depends

123 else do dependsModified <- liftIO $ mapM getModificationTime depends

115− cacheModified <- liftIO $ getModificationTime cache

124+ fileModified <- liftIO $ getModificationTime file

116− return (cacheModified >= maximum dependsModified)

125+ return (fileModified >= maximum dependsModified)

src/Text/Hakyll/Hakyll.hs+4

@@ -15,6 +15,10 @@ data HakyllConfiguration = HakyllConfiguration

15 { -- | An additional context to use when rendering. This additional context

16 -- is used globally.

17 additionalContext :: Context

18+ , -- | Directory where the site is placed.

19+ siteDirectory :: FilePath

20+ , -- | Directory for cache files.

21+ cacheDirectory :: FilePath

18 }

22 }

19

23

20-- | Our custom monad stack.

24-- | Our custom monad stack.

src/Text/Hakyll/Internal/Cache.hsnew file+12

@@ -0,0 +1,12 @@

1+module Text.Hakyll.Internal.Cache

2+ ( storeInCache

3+ , getFromCache

4+ ) where

5+

6+import Text.Hakyll.Hakyll (Hakyll)

7+

8+storeInCache :: (Show a) => a -> FilePath -> Hakyll ()

9+storeInCache = undefined

10+

11+getFromCache :: (Read a) => FilePath -> Hakyll (Maybe a)

12+getFromCache = undefined

src/Text/Hakyll/Render.hs+11−10

@@ -28,7 +28,8 @@ depends :: FilePath -- ^ File to be rendered or created.

28 -> Hakyll () -- ^ IO action to execute when the file is out of date.

29 -> Hakyll ()

30depends file dependencies action = do

31− valid <- isCacheValid (toDestination file) dependencies

31+ destination <- toDestination file

32+ valid <- isMoreRecent destination dependencies

32 unless valid action

33 unless valid action

33

34

34-- | Render to a Page.

35-- | Render to a Page.

@@ -108,17 +109,17 @@ renderChainWith manipulation templatePaths renderable =

108-- | Mark a certain file as static, so it will just be copied when the site is

109-- | Mark a certain file as static, so it will just be copied when the site is

109-- generated.

110-- generated.

110static :: FilePath -> Hakyll ()

111static :: FilePath -> Hakyll ()

112+static source = do destination <- toDestination source

111−static source = depends destination [source] action

113+ depends destination [source] (action destination)

112 where

114 where

113− destination = toDestination source

114− action = do makeDirectories destination

115+ action destination = do makeDirectories destination

115− liftIO $ copyFile source destination

116+ liftIO $ copyFile source destination

116

117

117-- | Render a css file, compressing it.

118-- | Render a css file, compressing it.

118css :: FilePath -> Hakyll ()

119css :: FilePath -> Hakyll ()

120+css source = do destination <- toDestination source

119−css source = depends destination [source] css'

121+ depends destination [source] (css' destination)

120 where

122 where

121− destination = toDestination source

122− css' = do contents <- liftIO $ readFile source

123+ css' destination = do contents <- liftIO $ readFile source

123− makeDirectories destination

124+ makeDirectories destination

124− liftIO $ writeFile destination (compressCSS contents)

125+ liftIO $ writeFile destination (compressCSS contents)

src/Text/Hakyll/Render/Internal.hs+2−2

@@ -85,8 +85,8 @@ pureRenderChainWith manipulation templates context =

85writePage :: Page -> Hakyll ()

86writePage page = do

87 additionalContext' <- askHakyll additionalContext

88− let destination = toDestination url

88+ destination <- toDestination url

89− context = additionalContext' `M.union` M.singleton "root" (toRoot url)

89+ let context = additionalContext' `M.union` M.singleton "root" (toRoot url)

90 makeDirectories destination

91 -- Substitute $root here, just before writing.

92 liftIO $ writeFile destination $ finalSubstitute (getBody page) context

tests/Tests.hs−12

@@ -45,9 +45,6 @@ tests = [ testGroup "Util group"

45 ]

46

47 , testGroup "File group"

48− [ testCase "toDestination 1" test_to_destination1

49− , testCase "toDestination 2" test_to_destination2

50− , testCase "toDestination 3" test_to_destination3

51 , testCase "toRoot 1" test_to_root1

48 , testCase "toRoot 1" test_to_root1

52 , testCase "toRoot 2" test_to_root2

49 , testCase "toRoot 2" test_to_root2

53 , testCase "toRoot 3" test_to_root3

50 , testCase "toRoot 3" test_to_root3

@@ -112,15 +109,6 @@ test_render_date2 = M.lookup "date" rendered @?= Just "Unknown date"

112 rendered = renderDate "date" "%B %e, %Y" "Unknown date" $

109 rendered = renderDate "date" "%B %e, %Y" "Unknown date" $

113 M.singleton "path" "2009-badness-30-a-title.markdown"

110 M.singleton "path" "2009-badness-30-a-title.markdown"

114

111

115−-- toDestination test cases

116−test_to_destination1 = toDestination "/posts/foo.html"

117− @?= "_site/posts/foo.html"

118−

119−test_to_destination2 = toDestination "$root/posts/foo.html"

120− @?= "_site/posts/foo.html"

121−

122−test_to_destination3 = toDestination "foo.html" @?= "_site/foo.html"

123−

124-- toRoot test cases

112-- toRoot test cases

125test_to_root1 = toRoot "/posts/foo.html" @?= ".."

113test_to_root1 = toRoot "/posts/foo.html" @?= ".."

126test_to_root2 = toRoot "posts/foo.html" @?= ".."

114test_to_root2 = toRoot "posts/foo.html" @?= ".."