e2cce1b · hakyll · git.iko.soy

git.iko.soy/hakyll

Merge branch 'master' into type-safe-identifiers

commite2cce1b341fdbf65c270c7e64bb2f5264b8a4468 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateFri 27 May 2011, 18:25 (15 years ago) parent0807e4c 5849ab3

9 files changed+120−15

compare with master

unifiedsplit

examples/README.markdown+14 src/Hakyll/Core/Compiler.hs+6 src/Hakyll/Core/Logger.hs+8−7 src/Hakyll/Core/Resource/Provider/Dummy.hs+5−3 src/Hakyll/Core/Run.hs+1−1 tests/Hakyll/Core/Store/Tests.hs+5−4 tests/Hakyll/Core/UnixFilter/Tests.hs+50 tests/TestSuite.hs+3 tests/TestSuite/Util.hs+28

examples/README.markdownnew file+14

@@ -0,0 +1,14 @@

1+Hakyll examples

2+===============

4+In order of increasing complexity:

6+ brochure/ A very simple brochure site

7+ morepages/ Slightly more complicated brochure site with partials

8+ simpleblog/ A simple blog

9+ feedblog/ Adds an RSS feed to the simple blog

10+ tagblog/ Adds tags to the simple blog

11+

12+In no real category:

13+

14+ hakyll/ The hakyll website (some custom pandoc options)

src/Hakyll/Core/Compiler.hs+6

@@ -93,6 +93,7 @@ module Hakyll.Core.Compiler

9393 ( Compiler

9494 , runCompiler

9595 , getIdentifier

96+ , getResource

9697 , getRoute

9798 , getRouteFor

9899 , getResourceString

@@ -175,6 +176,11 @@ getIdentifier :: Compiler a (Identifier b)

175176getIdentifier = fromJob $ const $ CompilerM $

176177 castIdentifier . compilerIdentifier <$> ask

177178

179+-- | Get the resource that is currently being compiled

180+--

181+getResource :: Compiler a Resource

182+getResource = getIdentifier >>> arr fromIdentifier

183+

178184-- | Get the route we are using for this item

179185--

180186getRoute :: Compiler a (Maybe FilePath)

src/Hakyll/Core/Logger.hs+8−7

@@ -13,7 +13,7 @@ module Hakyll.Core.Logger

1313

1414import Control.Monad (forever)

1515import Control.Monad.Trans (MonadIO, liftIO)

16−import Control.Applicative ((<$>), (<*>))

16+import Control.Applicative (pure, (<$>), (<*>))

1717import Control.Concurrent (forkIO)

1818import Control.Concurrent.Chan.Strict (Chan, newChan, readChan, writeChan)

1919import Control.Concurrent.MVar.Strict (MVar, newEmptyMVar, takeMVar, putMVar)

@@ -24,15 +24,16 @@ import Data.Time (getCurrentTime, diffUTCTime)

2424-- | Logger structure. Very complicated.

2525--

2626data Logger = Logger

27− { loggerChan :: Chan (Maybe String) -- Nothing marks the end

28− , loggerSync :: MVar () -- Used for sync on quit

27+ { loggerChan :: Chan (Maybe String) -- ^ Nothing marks the end

28+ , loggerSync :: MVar () -- ^ Used for sync on quit

29+ , loggerSink :: String -> IO () -- ^ Out sink

2930 }

3031

3132-- | Create a new logger

3233--

33−makeLogger :: IO Logger

34−makeLogger = do

35− logger <- Logger <$> newChan <*> newEmptyMVar

34+makeLogger :: (String -> IO ()) -> IO Logger

35+makeLogger sink = do

36+ logger <- Logger <$> newChan <*> newEmptyMVar <*> pure sink

3637 _ <- forkIO $ loggerThread logger

3738 return logger

3839 where

@@ -42,7 +43,7 @@ makeLogger = do

4243 -- Stop: sync

4344 Nothing -> putMVar (loggerSync logger) ()

4445 -- Print and continue

45− Just m -> putStrLn m

46+ Just m -> loggerSink logger m

4647

4748-- | Flush the logger (blocks until flushed)

4849--

src/Hakyll/Core/Resource/Provider/Dummy.hs+5−3

@@ -7,15 +7,17 @@ module Hakyll.Core.Resource.Provider.Dummy

77import Data.Map (Map)

88import qualified Data.Map as M

10−import qualified Data.ByteString.Lazy.Char8 as LBC

10+import qualified Data.Text.Lazy as TL

11+import qualified Data.Text.Lazy.Encoding as TL

12+import Data.ByteString.Lazy (ByteString)

1113

1214import Hakyll.Core.Resource

1315import Hakyll.Core.Resource.Provider

1416

1517-- | Create a dummy 'ResourceProvider'

1618--

17−dummyResourceProvider :: Map String String -> IO ResourceProvider

19+dummyResourceProvider :: Map String ByteString -> IO ResourceProvider

1820dummyResourceProvider vfs = makeResourceProvider

1921 (map Resource (M.keys vfs))

22+ (return . TL.unpack . TL.decodeUtf8 . (vfs M.!) . unResource)

2023 (return . (vfs M.!) . unResource)

21− (return . LBC.pack . (vfs M.!) . unResource)

src/Hakyll/Core/Run.hs+1−1

@@ -37,7 +37,7 @@ import Hakyll.Core.Logger

3737--

3838run :: HakyllConfiguration -> Rules -> IO RuleSet

3939run configuration rules = do

40− logger <- makeLogger

40+ logger <- makeLogger putStrLn

4141

4242 section logger "Initialising"

4343 store <- timed logger "Creating store" $

tests/Hakyll/Core/Store/Tests.hs+5−4

@@ -15,6 +15,7 @@ import qualified Test.HUnit as H

1515

1616import Hakyll.Core.Identifier

1717import Hakyll.Core.Store

18+import TestSuite.Util

1819

1920tests :: [Test]

2021tests =

@@ -28,7 +29,7 @@ simpleSetGet = monadicIO $ do

2829 identifier <- parseIdentifier . unFileName <$> pick arbitrary

2930 FileName name <- pick arbitrary

3031 value <- pick arbitrary

31− store <- run $ makeStore "_store"

32+ store <- run $ makeStoreTest

3233 run $ storeSet store name identifier (value :: String)

3334 value' <- run $ storeGet store name identifier

3435 assert $ Found value == value'

@@ -38,16 +39,16 @@ persistentSetGet = monadicIO $ do

3839 identifier <- parseIdentifier . unFileName <$> pick arbitrary

3940 FileName name <- pick arbitrary

4041 value <- pick arbitrary

41− store1 <- run $ makeStore "_store"

42+ store1 <- run $ makeStoreTest

4243 run $ storeSet store1 name identifier (value :: String)

4344 -- Now Create another store from the same dir to test persistence

44− store2 <- run $ makeStore "_store"

45+ store2 <- run $ makeStoreTest

4546 value' <- run $ storeGet store2 name identifier

4647 assert $ Found value == value'

4748

4849wrongType :: H.Assertion

4950wrongType = do

50− store <- makeStore "_store"

51+ store <- makeStoreTest

5152 -- Store a string and try to fetch an int

5253 storeSet store "foo" "bar" ("qux" :: String)

5354 value <- storeGet store "foo" "bar" :: IO (StoreGet Int)

tests/Hakyll/Core/UnixFilter/Tests.hsnew file+50

@@ -0,0 +1,50 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module Hakyll.Core.UnixFilter.Tests

3+ where

5+import Control.Arrow ((>>>))

6+import qualified Data.Map as M

8+import Test.Framework (Test)

9+import Test.Framework.Providers.HUnit (testCase)

10+import qualified Test.HUnit as H

11+import qualified Data.Text.Lazy as TL

12+import qualified Data.Text.Lazy.Encoding as TL

13+

14+import Hakyll.Core.Compiler

15+import Hakyll.Core.Resource.Provider.Dummy

16+import Hakyll.Core.UnixFilter

17+import TestSuite.Util

18+

19+tests :: [Test]

20+tests =

21+ [ testCase "unixFilter rev" unixFilterRev

22+ ]

23+

24+unixFilterRev :: H.Assertion

25+unixFilterRev = do

26+ provider <- dummyResourceProvider $ M.singleton "foo" $

27+ TL.encodeUtf8 $ TL.pack text

28+ output <- runCompilerJobTest compiler "foo" provider ["foo"]

29+ H.assert $ rev text == lines output

30+ where

31+ compiler = getResource >>> getResourceString >>> unixFilter "rev" []

32+ rev = map reverse . lines

33+

34+text :: String

35+text = unlines

36+ [ "Статья 18"

37+ , ""

38+ , "Каждый человек имеет право на свободу мысли, совести и религии; это"

39+ , "право включает свободу менять свою религию или убеждения и свободу"

40+ , "исповедовать свою религию или убеждения как единолично, так и сообща с"

41+ , "другими, публичным или частным порядком в учении, богослужении и"

42+ , "выполнении религиозных и ритуальных обрядов."

43+ , ""

44+ , "Статья 19"

45+ , ""

46+ , "Каждый человек имеет право на свободу убеждений и на свободное выражение"

47+ , "их; это право включает свободу беспрепятственно придерживаться своих"

48+ , "убеждений и свободу искать, получать и распространять информацию и идеи"

49+ , "любыми средствами и независимо от государственных границ."

50+ ]

tests/TestSuite.hs+3

@@ -7,6 +7,7 @@ import qualified Hakyll.Core.Identifier.Tests

77import qualified Hakyll.Core.Routes.Tests

88import qualified Hakyll.Core.Rules.Tests

99import qualified Hakyll.Core.Store.Tests

10+import qualified Hakyll.Core.UnixFilter.Tests

1011import qualified Hakyll.Web.Page.Tests

1112import qualified Hakyll.Web.Page.Metadata.Tests

1213import qualified Hakyll.Web.RelativizeUrls.Tests

@@ -25,6 +26,8 @@ main = defaultMain

2526 Hakyll.Core.Rules.Tests.tests

2627 , testGroup "Hakyll.Core.Store.Tests"

2728 Hakyll.Core.Store.Tests.tests

29+ , testGroup "Hakyll.Core.UnixFilter.Tests"

30+ Hakyll.Core.UnixFilter.Tests.tests

2831 , testGroup "Hakyll.Web.Page.Tests"

2932 Hakyll.Web.Page.Tests.tests

3033 , testGroup "Hakyll.Web.Page.Metadata.Tests"

tests/TestSuite/Util.hs+28

@@ -2,15 +2,43 @@

22--

33module TestSuite.Util

44 ( fromAssertions

5+ , makeStoreTest

6+ , runCompilerJobTest

57 ) where

9+import Data.Monoid (mempty)

10+

711import Test.Framework

812import Test.Framework.Providers.HUnit

913import Test.HUnit hiding (Test)

1014

15+import Hakyll.Core.Compiler.Internal

16+import Hakyll.Core.Identifier

17+import Hakyll.Core.Logger

18+import Hakyll.Core.Resource.Provider

19+import Hakyll.Core.Store

20+

1121fromAssertions :: String -- ^ Name

1222 -> [Assertion] -- ^ Cases

1323 -> [Test] -- ^ Result tests

1424fromAssertions name = zipWith testCase names

1525 where

1626 names = map (\n -> name ++ " [" ++ show n ++ "]") [1 :: Int ..]

27+

28+-- | Create a store for testing

29+--

30+makeStoreTest :: IO Store

31+makeStoreTest = makeStore "_store"

32+

33+-- | Testing for 'runCompilerJob'

34+--

35+runCompilerJobTest :: Compiler () a

36+ -> Identifier

37+ -> ResourceProvider

38+ -> [Identifier]

39+ -> IO a

40+runCompilerJobTest compiler id' provider uni = do

41+ store <- makeStoreTest

42+ logger <- makeLogger $ const $ return ()

43+ Right x <- runCompilerJob compiler id' provider uni mempty store True logger

44+ return x