diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,20 @@ # Releases +## Hakyll 4.12.0.0 + +- Add Semigroup instances for existing Monoids (contribution by + Christian Barcenas) +- Fix issue with CPP and comment containing `/*` +- Add `withTagList` (contribution by Oleg Grenrus) +- Improve CSS compression (contribution by Bergi) +- Bump pandoc-citeproc to 0.14 +- Bump resourcet to 1.2 +- Bump time to 1.9 +- Bump http-types to 0.12 +- Bump http-conduit to 2.3 +- Bump tasty-quickcheck to 0.10 + ## Hakyll 4.11.0.0 - Bump binary to 0.9 diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 4.11.0.0 +Version: 4.12.0.0 Synopsis: A static website compiler library Description: @@ -151,6 +151,7 @@ Data.Yaml.Extended Hakyll.Check Hakyll.Core.Compiler.Require + Hakyll.Core.Identifier.Pattern.Internal Hakyll.Core.Item.SomeItem Hakyll.Core.Provider.Internal Hakyll.Core.Provider.MetadataCache @@ -175,17 +176,17 @@ network >= 2.6 && < 2.7, network-uri >= 2.6 && < 2.7, pandoc >= 2.0.5 && < 2.2, - pandoc-citeproc >= 0.13 && < 0.14, + pandoc-citeproc >= 0.14 && < 0.15, parsec >= 3.0 && < 3.2, process >= 1.6 && < 1.7, random >= 1.0 && < 1.2, regex-base >= 0.93 && < 0.94, regex-tdfa >= 1.1 && < 1.3, - resourcet >= 1.1 && < 1.2, + resourcet >= 1.1 && < 1.3, scientific >= 0.3.4 && < 0.4, tagsoup >= 0.13.1 && < 0.15, text >= 0.11 && < 1.3, - time >= 1.8 && < 1.9, + time >= 1.8 && < 1.10, time-locale-compat >= 0.1 && < 0.2, unordered-containers >= 0.2 && < 0.3, vector >= 0.11 && < 0.13, @@ -198,7 +199,7 @@ wai >= 3.2 && < 3.3, warp >= 3.2 && < 3.3, wai-app-static >= 3.1 && < 3.2, - http-types >= 0.9 && < 0.12, + http-types >= 0.9 && < 0.13, fsnotify >= 0.2 && < 0.3 Cpp-options: -DPREVIEW_SERVER @@ -216,8 +217,8 @@ If flag(checkExternal) Build-depends: - http-conduit >= 2.2 && < 2.3, - http-types >= 0.7 && < 0.12 + http-conduit >= 2.2 && < 2.4, + http-types >= 0.7 && < 0.13 Cpp-options: -DCHECK_EXTERNAL @@ -252,7 +253,7 @@ QuickCheck >= 2.8 && < 2.12, tasty >= 0.11 && < 1.1, tasty-hunit >= 0.9 && < 0.11, - tasty-quickcheck >= 0.8 && < 0.10, + tasty-quickcheck >= 0.8 && < 0.11, -- Copy pasted from hakyll dependencies: base >= 4.8 && < 5, binary >= 0.5 && < 0.10, @@ -270,7 +271,7 @@ network >= 2.6 && < 2.7, network-uri >= 2.6 && < 2.7, pandoc >= 2.0.5 && < 2.2, - pandoc-citeproc >= 0.13 && < 0.14, + pandoc-citeproc >= 0.14 && < 0.15, parsec >= 3.0 && < 3.2, process >= 1.6 && < 1.7, random >= 1.0 && < 1.2, @@ -280,7 +281,7 @@ scientific >= 0.3.4 && < 0.4, tagsoup >= 0.13.1 && < 0.15, text >= 0.11 && < 1.3, - time >= 1.8 && < 1.9, + time >= 1.8 && < 1.10, time-locale-compat >= 0.1 && < 0.2, unordered-containers >= 0.2 && < 0.3, vector >= 0.11 && < 0.13, @@ -292,7 +293,7 @@ wai >= 3.2 && < 3.3, warp >= 3.2 && < 3.3, wai-app-static >= 3.1 && < 3.2, - http-types >= 0.9 && < 0.12, + http-types >= 0.9 && < 0.13, fsnotify >= 0.2 && < 0.3 Cpp-options: -DPREVIEW_SERVER @@ -305,8 +306,8 @@ If flag(checkExternal) Build-depends: - http-conduit >= 2.2 && < 2.3, - http-types >= 0.7 && < 0.12 + http-conduit >= 2.2 && < 2.4, + http-types >= 0.7 && < 0.13 Cpp-options: -DCHECK_EXTERNAL diff --git a/lib/Hakyll/Check.hs b/lib/Hakyll/Check.hs --- a/lib/Hakyll/Check.hs +++ b/lib/Hakyll/Check.hs @@ -19,6 +19,9 @@ import Control.Monad.Trans.Resource (runResourceT) import Data.List (isPrefixOf) import qualified Data.Map.Lazy as Map +#if MIN_VERSION_base(4,9,0) +import Data.Semigroup (Semigroup (..)) +#endif import Network.URI (unEscapeString) import System.Directory (doesDirectoryExist, doesFileExist) @@ -85,10 +88,20 @@ -------------------------------------------------------------------------------- +#if MIN_VERSION_base(4,9,0) +instance Semigroup CheckerWrite where + (<>) (CheckerWrite f1 o1) (CheckerWrite f2 o2) = + CheckerWrite (f1 + f2) (o1 + o2) + instance Monoid CheckerWrite where + mempty = CheckerWrite 0 0 + mappend = (<>) +#else +instance Monoid CheckerWrite where mempty = CheckerWrite 0 0 mappend (CheckerWrite f1 o1) (CheckerWrite f2 o2) = CheckerWrite (f1 + f2) (o1 + o2) +#endif -------------------------------------------------------------------------------- diff --git a/lib/Hakyll/Core/Compiler/Internal.hs b/lib/Hakyll/Core/Compiler/Internal.hs --- a/lib/Hakyll/Core/Compiler/Internal.hs +++ b/lib/Hakyll/Core/Compiler/Internal.hs @@ -1,5 +1,6 @@ -------------------------------------------------------------------------------- -- | Internally used compiler module +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -32,6 +33,9 @@ import Control.Exception (SomeException, handle) import Control.Monad (forM_) import Control.Monad.Except (MonadError (..)) +#if MIN_VERSION_base(4,9,0) +import Data.Semigroup (Semigroup (..)) +#endif import Data.Set (Set) import qualified Data.Set as S @@ -83,10 +87,20 @@ -------------------------------------------------------------------------------- +#if MIN_VERSION_base(4,9,0) +instance Semigroup CompilerWrite where + (<>) (CompilerWrite d1 h1) (CompilerWrite d2 h2) = + CompilerWrite (d1 ++ d2) (h1 + h2) + instance Monoid CompilerWrite where + mempty = CompilerWrite [] 0 + mappend = (<>) +#else +instance Monoid CompilerWrite where mempty = CompilerWrite [] 0 mappend (CompilerWrite d1 h1) (CompilerWrite d2 h2) = CompilerWrite (d1 ++ d2) (h1 + h2) +#endif -------------------------------------------------------------------------------- diff --git a/lib/Hakyll/Core/Identifier/Pattern.hs b/lib/Hakyll/Core/Identifier/Pattern.hs --- a/lib/Hakyll/Core/Identifier/Pattern.hs +++ b/lib/Hakyll/Core/Identifier/Pattern.hs @@ -28,6 +28,7 @@ -- -- The 'capture' function allows the user to get access to the elements captured -- by the capture elements in a glob or regex pattern. +{-# OPTIONS_GHC -fno-warn-orphans #-} module Hakyll.Core.Identifier.Pattern ( -- * The pattern type Pattern @@ -57,88 +58,27 @@ -------------------------------------------------------------------------------- -import Control.Arrow ((&&&), (>>>)) -import Control.Monad (msum) -import Data.Binary (Binary (..), getWord8, putWord8) -import Data.List (inits, isPrefixOf, tails) -import Data.Maybe (isJust) -import Data.Set (Set) -import qualified Data.Set as S +import Control.Arrow ((&&&), (>>>)) +import Control.Monad (msum) +import Data.List (inits, isPrefixOf, + tails) +import Data.Maybe (isJust) +import qualified Data.Set as S -------------------------------------------------------------------------------- -import GHC.Exts (IsString, fromString) -import Text.Regex.TDFA ((=~)) +import GHC.Exts (IsString, fromString) +import Text.Regex.TDFA ((=~)) -------------------------------------------------------------------------------- import Hakyll.Core.Identifier - - --------------------------------------------------------------------------------- --- | Elements of a glob pattern -data GlobComponent - = Capture - | CaptureMany - | Literal String - deriving (Eq, Show) - - --------------------------------------------------------------------------------- -instance Binary GlobComponent where - put Capture = putWord8 0 - put CaptureMany = putWord8 1 - put (Literal s) = putWord8 2 >> put s - - get = getWord8 >>= \t -> case t of - 0 -> pure Capture - 1 -> pure CaptureMany - 2 -> Literal <$> get - _ -> error "Data.Binary.get: Invalid GlobComponent" - - --------------------------------------------------------------------------------- --- | Type that allows matching on identifiers -data Pattern - = Everything - | Complement Pattern - | And Pattern Pattern - | Glob [GlobComponent] - | List (Set Identifier) - | Regex String - | Version (Maybe String) - deriving (Show) - - --------------------------------------------------------------------------------- -instance Binary Pattern where - put Everything = putWord8 0 - put (Complement p) = putWord8 1 >> put p - put (And x y) = putWord8 2 >> put x >> put y - put (Glob g) = putWord8 3 >> put g - put (List is) = putWord8 4 >> put is - put (Regex r) = putWord8 5 >> put r - put (Version v) = putWord8 6 >> put v - - get = getWord8 >>= \t -> case t of - 0 -> pure Everything - 1 -> Complement <$> get - 2 -> And <$> get <*> get - 3 -> Glob <$> get - 4 -> List <$> get - 5 -> Regex <$> get - _ -> Version <$> get +import Hakyll.Core.Identifier.Pattern.Internal -------------------------------------------------------------------------------- instance IsString Pattern where fromString = fromGlob - - --------------------------------------------------------------------------------- -instance Monoid Pattern where - mempty = Everything - mappend = (.&&.) -------------------------------------------------------------------------------- diff --git a/lib/Hakyll/Core/Identifier/Pattern/Internal.hs b/lib/Hakyll/Core/Identifier/Pattern/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/Hakyll/Core/Identifier/Pattern/Internal.hs @@ -0,0 +1,92 @@ +-- | This internal module is mostly here to prevent CPP conflicting with Haskell +-- comments. +{-# LANGUAGE CPP #-} +module Hakyll.Core.Identifier.Pattern.Internal + ( GlobComponent (..) + , Pattern (..) + ) where + + +-------------------------------------------------------------------------------- +import Data.Binary (Binary (..), getWord8, putWord8) +import Data.Set (Set) + + +-------------------------------------------------------------------------------- +#if MIN_VERSION_base(4,9,0) +import Data.Semigroup (Semigroup (..)) +#endif + + +-------------------------------------------------------------------------------- +import Hakyll.Core.Identifier + + +-------------------------------------------------------------------------------- +-- | Elements of a glob pattern +data GlobComponent + = Capture + | CaptureMany + | Literal String + deriving (Eq, Show) + + +-------------------------------------------------------------------------------- +instance Binary GlobComponent where + put Capture = putWord8 0 + put CaptureMany = putWord8 1 + put (Literal s) = putWord8 2 >> put s + + get = getWord8 >>= \t -> case t of + 0 -> pure Capture + 1 -> pure CaptureMany + 2 -> Literal <$> get + _ -> error "Data.Binary.get: Invalid GlobComponent" + + +-------------------------------------------------------------------------------- +-- | Type that allows matching on identifiers +data Pattern + = Everything + | Complement Pattern + | And Pattern Pattern + | Glob [GlobComponent] + | List (Set Identifier) + | Regex String + | Version (Maybe String) + deriving (Show) + + +-------------------------------------------------------------------------------- +instance Binary Pattern where + put Everything = putWord8 0 + put (Complement p) = putWord8 1 >> put p + put (And x y) = putWord8 2 >> put x >> put y + put (Glob g) = putWord8 3 >> put g + put (List is) = putWord8 4 >> put is + put (Regex r) = putWord8 5 >> put r + put (Version v) = putWord8 6 >> put v + + get = getWord8 >>= \t -> case t of + 0 -> pure Everything + 1 -> Complement <$> get + 2 -> And <$> get <*> get + 3 -> Glob <$> get + 4 -> List <$> get + 5 -> Regex <$> get + _ -> Version <$> get + + +-------------------------------------------------------------------------------- +#if MIN_VERSION_base(4,9,0) +instance Semigroup Pattern where + (<>) = And + +instance Monoid Pattern where + mempty = Everything + mappend = (<>) +#else +instance Monoid Pattern where + mempty = Everything + mappend = And +#endif diff --git a/lib/Hakyll/Core/Routes.hs b/lib/Hakyll/Core/Routes.hs --- a/lib/Hakyll/Core/Routes.hs +++ b/lib/Hakyll/Core/Routes.hs @@ -25,6 +25,7 @@ -- not appear in your site directory. -- -- * If an item matches multiple routes, the first rule will be chosen. +{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} module Hakyll.Core.Routes ( UsedMetadata @@ -42,6 +43,9 @@ -------------------------------------------------------------------------------- +#if MIN_VERSION_base(4,9,0) +import Data.Semigroup (Semigroup (..)) +#endif import System.FilePath (replaceExtension) @@ -74,13 +78,26 @@ -------------------------------------------------------------------------------- +#if MIN_VERSION_base(4,9,0) +instance Semigroup Routes where + (<>) (Routes f) (Routes g) = Routes $ \p id' -> do + (mfp, um) <- f p id' + case mfp of + Nothing -> g p id' + Just _ -> return (mfp, um) + instance Monoid Routes where + mempty = Routes $ \_ _ -> return (Nothing, False) + mappend = (<>) +#else +instance Monoid Routes where mempty = Routes $ \_ _ -> return (Nothing, False) mappend (Routes f) (Routes g) = Routes $ \p id' -> do (mfp, um) <- f p id' case mfp of Nothing -> g p id' Just _ -> return (mfp, um) +#endif -------------------------------------------------------------------------------- diff --git a/lib/Hakyll/Core/Rules/Internal.hs b/lib/Hakyll/Core/Rules/Internal.hs --- a/lib/Hakyll/Core/Rules/Internal.hs +++ b/lib/Hakyll/Core/Rules/Internal.hs @@ -1,4 +1,5 @@ -------------------------------------------------------------------------------- +{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE Rank2Types #-} module Hakyll.Core.Rules.Internal @@ -16,6 +17,9 @@ import Control.Monad.RWS (RWST, runRWST) import Control.Monad.Trans (liftIO) import qualified Data.Map as M +#if MIN_VERSION_base(4,9,0) +import Data.Semigroup (Semigroup (..)) +#endif import Data.Set (Set) @@ -52,10 +56,20 @@ -------------------------------------------------------------------------------- +#if MIN_VERSION_base(4,9,0) +instance Semigroup RuleSet where + (<>) (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) = + RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2) + instance Monoid RuleSet where + mempty = RuleSet mempty mempty mempty mempty + mappend = (<>) +#else +instance Monoid RuleSet where mempty = RuleSet mempty mempty mempty mempty mappend (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) = RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2) +#endif -------------------------------------------------------------------------------- diff --git a/lib/Hakyll/Core/Util/String.hs b/lib/Hakyll/Core/Util/String.hs --- a/lib/Hakyll/Core/Util/String.hs +++ b/lib/Hakyll/Core/Util/String.hs @@ -27,7 +27,7 @@ -------------------------------------------------------------------------------- -- | A simple (but inefficient) regex replace funcion replaceAll :: String -- ^ Pattern - -> (String -> String) -- ^ Replacement (called on capture) + -> (String -> String) -- ^ Replacement (called on match) -> String -- ^ Source string -> String -- ^ Result replaceAll pattern f source = replaceAll' source diff --git a/lib/Hakyll/Web/CompressCss.hs b/lib/Hakyll/Web/CompressCss.hs --- a/lib/Hakyll/Web/CompressCss.hs +++ b/lib/Hakyll/Web/CompressCss.hs @@ -1,7 +1,6 @@ -------------------------------------------------------------------------------- -- | Module used for CSS compression. The compression is currently in a simple -- state, but would typically reduce the number of bytes by about 25%. -{-# LANGUAGE PatternGuards #-} module Hakyll.Web.CompressCss ( compressCssCompiler , compressCss @@ -9,12 +8,14 @@ -------------------------------------------------------------------------------- -import Data.List (isPrefixOf) +import Data.Char (isSpace) +import Data.List (dropWhileEnd, isPrefixOf) -------------------------------------------------------------------------------- import Hakyll.Core.Compiler import Hakyll.Core.Item +import Hakyll.Core.Util.String -------------------------------------------------------------------------------- @@ -26,79 +27,75 @@ -------------------------------------------------------------------------------- -- | Compress CSS to speed up your site. compressCss :: String -> String -compressCss = compressSeparators . stripComments . compressWhitespace +compressCss = withoutStrings (handleCalcExpressions compressSeparators . compressWhitespace) + . dropWhileEnd isSpace + . dropWhile isSpace + . stripComments -------------------------------------------------------------------------------- -- | Compresses certain forms of separators. compressSeparators :: String -> String -compressSeparators [] = [] -compressSeparators str - | isConstant = head str : retainConstants compressSeparators (head str) (drop 1 str) - | isPrefixOf "calc( " str = "calc(" ++ compressCalcSeparators 1 (drop 6 str) - | isPrefixOf "calc(" str = "calc(" ++ compressCalcSeparators 1 (drop 5 str) - | stripFirst = compressSeparators (drop 1 str) - | stripSecond = compressSeparators (head str : (drop 2 str)) - | otherwise = head str : compressSeparators (drop 1 str) - where - isConstant = or $ map (isOfPrefix str) ["\"", "'"] - stripFirst = or $ map (isOfPrefix str) $ [";;", ";}"] ++ (map (\c -> " " ++ c) separators) - stripSecond = or $ map (isOfPrefix str) $ map (\c -> c ++ " ") separators - separators = [" ", "{", "}", ":", ";", ",", ">", "+", "!"] +compressSeparators = + replaceAll "; *}" (const "}") . + replaceAll ";+" (const ";") . + replaceAll " *[{};,>+~!] *" (take 1 . dropWhile isSpace) . + replaceAll ": *" (take 1) -- not destroying pseudo selectors (#323) --- | Compresses separators when starting inside calc(). -compressCalcSeparators :: Int -> String -> String -compressCalcSeparators 0 str = compressSeparators str -compressCalcSeparators depth str - | stripFirst = compressCalcSeparators depth (tail str) - | stripSecond = compressCalcSeparators depth (head str : (drop 2 str)) - | ('(' : xs) <- str = '(' : compressCalcSeparators (depth + 1) xs - | isPrefixOf "calc( " str = compressCalcSeparators depth ("calc(" ++ (drop 6 str)) - | isPrefixOf "calc(" str = '(' : compressCalcSeparators (depth + 1) (drop 5 str) - | (')' : xs) <- str = ')' : compressCalcSeparators (depth - 1) xs - | otherwise = head str : compressCalcSeparators depth (tail str) +-- | Uses `compressCalcExpression` on all parenthesised calc expressions +-- and applies `transform` to all parts outside of them +handleCalcExpressions :: (String -> String) -> String -> String +handleCalcExpressions transform = top transform where - stripFirst = or $ map (isOfPrefix str) $ map (\c -> " " ++ c) ["*", "/", ")"] - stripSecond = or $ map (isOfPrefix str) $ map (\c -> c ++ " ") ["*", "/", "("] + top f "" = f "" + top f str | "calc(" `isPrefixOf` str = f "calc" ++ nested 0 compressCalcExpression (drop 4 str) + top f (x:xs) = top (f . (x:)) xs + + -- when called with depth=0, the first character must be a '(' + nested :: Int -> (String -> String) -> String -> String + nested _ f "" = f "" -- shouldn't happen, mismatched nesting + nested depth f str | "calc(" `isPrefixOf` str = nested depth f (drop 4 str) + nested 1 f (')':xs) = f ")" ++ top transform xs + nested depth f (x:xs) = nested (case x of + '(' -> depth + 1 + ')' -> depth - 1 -- assert: depth > 1 + _ -> depth + ) (f . (x:)) xs +-- | does not remove whitespace around + and -, which is important in calc() expressions +compressCalcExpression :: String -> String +compressCalcExpression = + replaceAll " *[*/] *| *\\)|\\( *" (take 1 . dropWhile isSpace) + -------------------------------------------------------------------------------- -- | Compresses all whitespace. compressWhitespace :: String -> String -compressWhitespace [] = [] -compressWhitespace str - | isConstant = head str : retainConstants compressWhitespace (head str) (drop 1 str) - | replaceOne = compressWhitespace (' ' : (drop 1 str)) - | replaceTwo = compressWhitespace (' ' : (drop 2 str)) - | otherwise = head str : compressWhitespace (drop 1 str) - where - isConstant = or $ map (isOfPrefix str) ["\"", "'"] - replaceOne = or $ map (isOfPrefix str) ["\t", "\n", "\r"] - replaceTwo = or $ map (isOfPrefix str) [" \t", " \n", " \r", " "] +compressWhitespace = replaceAll "[ \t\n\r]+" (const " ") -------------------------------------------------------------------------------- --- | Function that strips CSS comments away. +-- | Function that strips CSS comments away (outside of strings). stripComments :: String -> String -stripComments [] = [] -stripComments str - | isConstant = head str : retainConstants stripComments (head str) (drop 1 str) - | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str - | otherwise = head str : stripComments (drop 1 str) - where - isConstant = or $ map (isOfPrefix str) ["\"", "'"] - eatComments str' - | null str' = [] - | isPrefixOf "*/" str' = drop 2 str' - | otherwise = eatComments $ drop 1 str' +stripComments "" = "" +stripComments ('/':'*':str) = stripComments $ eatComment str +stripComments (x:xs) | x `elem` "\"'" = retainString x xs stripComments + | otherwise = x : stripComments xs --------------------------------------------------------------------------------- --- | Helper function to handle string constants correctly. -retainConstants :: (String -> String) -> Char -> String -> String -retainConstants f delim str - | null str = [] - | isPrefixOf [delim] str = head str : f (drop 1 str) - | otherwise = head str : retainConstants f delim (drop 1 str) +eatComment :: String -> String +eatComment "" = "" +eatComment ('*':'/':str) = str +eatComment (_:str) = eatComment str + -------------------------------------------------------------------------------- --- | Helper function to determine whether a string is a substring. -isOfPrefix :: String -> String -> Bool -isOfPrefix = flip isPrefixOf +-- | Helper functions to handle string tokens correctly. + +-- TODO: handle backslash escapes +withoutStrings :: (String -> String) -> String -> String +withoutStrings f str = case span (`notElem` "\"'") str of + (text, "") -> f text + (text, d:rest) -> f text ++ retainString d rest (withoutStrings f) + +retainString :: Char -> String -> (String -> String) -> String +retainString delim str cont = case span (/= delim) str of + (val, "") -> delim : val + (val, _:rest) -> delim : val ++ delim : cont rest diff --git a/lib/Hakyll/Web/Html.hs b/lib/Hakyll/Web/Html.hs --- a/lib/Hakyll/Web/Html.hs +++ b/lib/Hakyll/Web/Html.hs @@ -3,6 +3,7 @@ module Hakyll.Web.Html ( -- * Generic withTags + , withTagList -- * Headers , demoteHeaders @@ -36,8 +37,11 @@ -------------------------------------------------------------------------------- -- | Map over all tags in the document withTags :: (TS.Tag String -> TS.Tag String) -> String -> String -withTags f = renderTags' . map f . parseTags' +withTags = withTagList . map +-- | Map over all tags (as list) in the document +withTagList :: ([TS.Tag String] -> [TS.Tag String]) -> String -> String +withTagList f = renderTags' . f . parseTags' -------------------------------------------------------------------------------- -- | Map every @h1@ to an @h2@, @h2@ to @h3@, etc. diff --git a/lib/Hakyll/Web/Pandoc/Binary.hs b/lib/Hakyll/Web/Pandoc/Binary.hs --- a/lib/Hakyll/Web/Pandoc/Binary.hs +++ b/lib/Hakyll/Web/Pandoc/Binary.hs @@ -28,5 +28,6 @@ instance Binary REF.Literal instance Binary REF.RefDate instance Binary REF.RefType +instance Binary REF.Season instance Binary STY.Agent instance Binary STY.Formatted diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs --- a/lib/Hakyll/Web/Template/Context.hs +++ b/lib/Hakyll/Web/Template/Context.hs @@ -35,6 +35,9 @@ import Control.Applicative (Alternative (..)) import Control.Monad (msum) import Data.List (intercalate) +#if MIN_VERSION_base(4,9,0) +import Data.Semigroup (Semigroup (..)) +#endif import Data.Time.Clock (UTCTime (..)) import Data.Time.Format (formatTime) import qualified Data.Time.Format as TF @@ -78,9 +81,18 @@ -------------------------------------------------------------------------------- +#if MIN_VERSION_base(4,9,0) +instance Semigroup (Context a) where + (<>) (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i + instance Monoid (Context a) where + mempty = missingField + mappend = (<>) +#else +instance Monoid (Context a) where mempty = missingField mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i +#endif -------------------------------------------------------------------------------- diff --git a/tests/Hakyll/Web/CompressCss/Tests.hs b/tests/Hakyll/Web/CompressCss/Tests.hs --- a/tests/Hakyll/Web/CompressCss/Tests.hs +++ b/tests/Hakyll/Web/CompressCss/Tests.hs @@ -20,9 +20,9 @@ [ fromAssertions "compressCss" [ -- compress whitespace - " something something " @=? + "something something" @=? compressCss " something \n\t\r something " - -- do not compress whitespace in constants + -- do not compress whitespace in string tokens , "abc \" \t\n\r \" xyz" @=? compressCss "abc \" \t\n\r \" xyz" , "abc ' \t\n\r ' xyz" @=? @@ -30,7 +30,7 @@ -- strip comments , "before after" @=? compressCss "before /* abc { } ;; \n\t\r */ after" - -- don't strip comments inside constants + -- don't strip comments inside string tokens , "before \"/* abc { } ;; \n\t\r */\" after" @=? compressCss "before \"/* abc { } ;; \n\t\r */\" after" @@ -45,19 +45,19 @@ , "calc(1px + 100%/(5 + 3) - (3px + 2px)*5)" @=? compressCss "calc( 1px + 100% / ( 5 + 3) - calc( 3px + 2px ) * 5 )" -- compress whitespace even after this curly brace , "}" @=? compressCss "; } " - -- but do not compress separators inside of constants + -- but do not compress separators inside string tokens , "\" { } ; , \"" @=? compressCss "\" { } ; , \"" - -- don't compress separators at the start or end of constants + -- don't compress separators at the start or end of string tokens , "\" }\"" @=? compressCss "\" }\"" , "\"{ \"" @=? compressCss "\"{ \"" - -- don't get irritated by the wrong constant terminator + -- don't get irritated by the wrong token delimiter , "\" ' \"" @=? compressCss "\" ' \"" , "' \" '" @=? compressCss "' \" '" - -- don't compress whitespace around separators in constants in the middle of a string + -- don't compress whitespace in the middle of a string , "abc '{ '" @=? compressCss "abc '{ '" , "abc \"{ \"" @=? compressCss "abc \"{ \"" - -- compress whitespace around colons - , "abc:xyz" @=? compressCss "abc : xyz" + -- compress whitespace after colons (but not before) + , "abc :xyz" @=? compressCss "abc : xyz" -- compress multiple semicolons , ";" @=? compressCss ";;;;;;;" ]