From 63a637f27cc51006c6b432337c232c17bfe0b0c2 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Wed, 25 May 2011 11:23:50 +0200 Subject: Add getResource, customizable sink for logger --- src/Hakyll/Core/Compiler.hs | 6 ++++++ src/Hakyll/Core/Logger.hs | 15 ++++++++------- src/Hakyll/Core/Run.hs | 2 +- 3 files changed, 15 insertions(+), 8 deletions(-) (limited to 'src/Hakyll') diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index 2164dda..6960fd1 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -93,6 +93,7 @@ module Hakyll.Core.Compiler ( Compiler , runCompiler , getIdentifier + , getResource , getRoute , getRouteFor , getResourceString @@ -173,6 +174,11 @@ runCompiler compiler id' provider universe routes store modified logger = do getIdentifier :: Compiler a Identifier getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask +-- | Get the resource that is currently being compiled +-- +getResource :: Compiler a Resource +getResource = getIdentifier >>> arr fromIdentifier + -- | Get the route we are using for this item -- getRoute :: Compiler a (Maybe FilePath) diff --git a/src/Hakyll/Core/Logger.hs b/src/Hakyll/Core/Logger.hs index 5d75fa9..912cc98 100644 --- a/src/Hakyll/Core/Logger.hs +++ b/src/Hakyll/Core/Logger.hs @@ -13,7 +13,7 @@ module Hakyll.Core.Logger import Control.Monad (forever) import Control.Monad.Trans (MonadIO, liftIO) -import Control.Applicative ((<$>), (<*>)) +import Control.Applicative (pure, (<$>), (<*>)) import Control.Concurrent (forkIO) import Control.Concurrent.Chan.Strict (Chan, newChan, readChan, writeChan) import Control.Concurrent.MVar.Strict (MVar, newEmptyMVar, takeMVar, putMVar) @@ -24,15 +24,16 @@ import Data.Time (getCurrentTime, diffUTCTime) -- | Logger structure. Very complicated. -- data Logger = Logger - { loggerChan :: Chan (Maybe String) -- Nothing marks the end - , loggerSync :: MVar () -- Used for sync on quit + { loggerChan :: Chan (Maybe String) -- ^ Nothing marks the end + , loggerSync :: MVar () -- ^ Used for sync on quit + , loggerSink :: String -> IO () -- ^ Out sink } -- | Create a new logger -- -makeLogger :: IO Logger -makeLogger = do - logger <- Logger <$> newChan <*> newEmptyMVar +makeLogger :: (String -> IO ()) -> IO Logger +makeLogger sink = do + logger <- Logger <$> newChan <*> newEmptyMVar <*> pure sink _ <- forkIO $ loggerThread logger return logger where @@ -42,7 +43,7 @@ makeLogger = do -- Stop: sync Nothing -> putMVar (loggerSync logger) () -- Print and continue - Just m -> putStrLn m + Just m -> loggerSink logger m -- | Flush the logger (blocks until flushed) -- diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index 643aa4e..5e29953 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -37,7 +37,7 @@ import Hakyll.Core.Logger -- run :: HakyllConfiguration -> Rules -> IO RuleSet run configuration rules = do - logger <- makeLogger + logger <- makeLogger putStrLn section logger "Initialising" store <- timed logger "Creating store" $ -- cgit v1.2.3 From d004dc19996c5d1a96a36c46c2580c3f0db33261 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Wed, 25 May 2011 11:24:33 +0200 Subject: Test for UnixFilter --- .ghci | 2 +- src/Hakyll/Core/Resource/Provider/Dummy.hs | 8 +++-- tests/Hakyll/Core/Store/Tests.hs | 9 +++--- tests/Hakyll/Core/UnixFilter/Tests.hs | 50 ++++++++++++++++++++++++++++++ tests/TestSuite.hs | 3 ++ tests/TestSuite/Util.hs | 28 +++++++++++++++++ 6 files changed, 92 insertions(+), 8 deletions(-) create mode 100644 tests/Hakyll/Core/UnixFilter/Tests.hs (limited to 'src/Hakyll') diff --git a/.ghci b/.ghci index a42ffe2..5b4f7f1 100644 --- a/.ghci +++ b/.ghci @@ -1 +1 @@ -:set -isrc -isrc-inotify -itests -idist/build/autogen +:set -isrc -isrc-interval -itests -idist/build/autogen diff --git a/src/Hakyll/Core/Resource/Provider/Dummy.hs b/src/Hakyll/Core/Resource/Provider/Dummy.hs index bc0b16d..9f15178 100644 --- a/src/Hakyll/Core/Resource/Provider/Dummy.hs +++ b/src/Hakyll/Core/Resource/Provider/Dummy.hs @@ -7,15 +7,17 @@ module Hakyll.Core.Resource.Provider.Dummy import Data.Map (Map) import qualified Data.Map as M -import qualified Data.ByteString.Lazy.Char8 as LBC +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL +import Data.ByteString.Lazy (ByteString) import Hakyll.Core.Resource import Hakyll.Core.Resource.Provider -- | Create a dummy 'ResourceProvider' -- -dummyResourceProvider :: Map String String -> IO ResourceProvider +dummyResourceProvider :: Map String ByteString -> IO ResourceProvider dummyResourceProvider vfs = makeResourceProvider (map Resource (M.keys vfs)) + (return . TL.unpack . TL.decodeUtf8 . (vfs M.!) . unResource) (return . (vfs M.!) . unResource) - (return . LBC.pack . (vfs M.!) . unResource) diff --git a/tests/Hakyll/Core/Store/Tests.hs b/tests/Hakyll/Core/Store/Tests.hs index 4f35abd..53ad74e 100644 --- a/tests/Hakyll/Core/Store/Tests.hs +++ b/tests/Hakyll/Core/Store/Tests.hs @@ -15,6 +15,7 @@ import qualified Test.HUnit as H import Hakyll.Core.Identifier import Hakyll.Core.Store +import TestSuite.Util tests :: [Test] tests = @@ -28,7 +29,7 @@ simpleSetGet = monadicIO $ do identifier <- parseIdentifier . unFileName <$> pick arbitrary FileName name <- pick arbitrary value <- pick arbitrary - store <- run $ makeStore "_store" + store <- run $ makeStoreTest run $ storeSet store name identifier (value :: String) value' <- run $ storeGet store name identifier assert $ Found value == value' @@ -38,16 +39,16 @@ persistentSetGet = monadicIO $ do identifier <- parseIdentifier . unFileName <$> pick arbitrary FileName name <- pick arbitrary value <- pick arbitrary - store1 <- run $ makeStore "_store" + store1 <- run $ makeStoreTest run $ storeSet store1 name identifier (value :: String) -- Now Create another store from the same dir to test persistence - store2 <- run $ makeStore "_store" + store2 <- run $ makeStoreTest value' <- run $ storeGet store2 name identifier assert $ Found value == value' wrongType :: H.Assertion wrongType = do - store <- makeStore "_store" + store <- makeStoreTest -- Store a string and try to fetch an int storeSet store "foo" "bar" ("qux" :: String) value <- storeGet store "foo" "bar" :: IO (StoreGet Int) diff --git a/tests/Hakyll/Core/UnixFilter/Tests.hs b/tests/Hakyll/Core/UnixFilter/Tests.hs new file mode 100644 index 0000000..0e8d88d --- /dev/null +++ b/tests/Hakyll/Core/UnixFilter/Tests.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} +module Hakyll.Core.UnixFilter.Tests + where + +import Control.Arrow ((>>>)) +import qualified Data.Map as M + +import Test.Framework (Test) +import Test.Framework.Providers.HUnit (testCase) +import qualified Test.HUnit as H +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL + +import Hakyll.Core.Compiler +import Hakyll.Core.Resource.Provider.Dummy +import Hakyll.Core.UnixFilter +import TestSuite.Util + +tests :: [Test] +tests = + [ testCase "unixFilter rev" unixFilterRev + ] + +unixFilterRev :: H.Assertion +unixFilterRev = do + provider <- dummyResourceProvider $ M.singleton "foo" $ + TL.encodeUtf8 $ TL.pack text + output <- runCompilerJobTest compiler "foo" provider ["foo"] + H.assert $ rev text == lines output + where + compiler = getResource >>> getResourceString >>> unixFilter "rev" [] + rev = map reverse . lines + +text :: String +text = unlines + [ "Статья 18" + , "" + , "Каждый человек имеет право на свободу мысли, совести и религии; это" + , "право включает свободу менять свою религию или убеждения и свободу" + , "исповедовать свою религию или убеждения как единолично, так и сообща с" + , "другими, публичным или частным порядком в учении, богослужении и" + , "выполнении религиозных и ритуальных обрядов." + , "" + , "Статья 19" + , "" + , "Каждый человек имеет право на свободу убеждений и на свободное выражение" + , "их; это право включает свободу беспрепятственно придерживаться своих" + , "убеждений и свободу искать, получать и распространять информацию и идеи" + , "любыми средствами и независимо от государственных границ." + ] diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index e459529..fe9012d 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -7,6 +7,7 @@ import qualified Hakyll.Core.Identifier.Tests import qualified Hakyll.Core.Routes.Tests import qualified Hakyll.Core.Rules.Tests import qualified Hakyll.Core.Store.Tests +import qualified Hakyll.Core.UnixFilter.Tests import qualified Hakyll.Web.Page.Tests import qualified Hakyll.Web.Page.Metadata.Tests import qualified Hakyll.Web.RelativizeUrls.Tests @@ -25,6 +26,8 @@ main = defaultMain Hakyll.Core.Rules.Tests.tests , testGroup "Hakyll.Core.Store.Tests" Hakyll.Core.Store.Tests.tests + , testGroup "Hakyll.Core.UnixFilter.Tests" + Hakyll.Core.UnixFilter.Tests.tests , testGroup "Hakyll.Web.Page.Tests" Hakyll.Web.Page.Tests.tests , testGroup "Hakyll.Web.Page.Metadata.Tests" diff --git a/tests/TestSuite/Util.hs b/tests/TestSuite/Util.hs index f32bcad..d82b280 100644 --- a/tests/TestSuite/Util.hs +++ b/tests/TestSuite/Util.hs @@ -2,15 +2,43 @@ -- module TestSuite.Util ( fromAssertions + , makeStoreTest + , runCompilerJobTest ) where +import Data.Monoid (mempty) + import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) +import Hakyll.Core.Compiler.Internal +import Hakyll.Core.Identifier +import Hakyll.Core.Logger +import Hakyll.Core.Resource.Provider +import Hakyll.Core.Store + fromAssertions :: String -- ^ Name -> [Assertion] -- ^ Cases -> [Test] -- ^ Result tests fromAssertions name = zipWith testCase names where names = map (\n -> name ++ " [" ++ show n ++ "]") [1 :: Int ..] + +-- | Create a store for testing +-- +makeStoreTest :: IO Store +makeStoreTest = makeStore "_store" + +-- | Testing for 'runCompilerJob' +-- +runCompilerJobTest :: Compiler () a + -> Identifier + -> ResourceProvider + -> [Identifier] + -> IO a +runCompilerJobTest compiler id' provider uni = do + store <- makeStoreTest + logger <- makeLogger $ const $ return () + Right x <- runCompilerJob compiler id' provider uni mempty store True logger + return x -- cgit v1.2.3