hakyll 4.8.3.2 → 4.9.0.0
raw patch · 31 files changed
+914/−530 lines, 31 filesdep +optparse-applicativedep +tastydep +tasty-hunitdep −HUnitdep −cmdargsdep −snap-coredep ~QuickCheckdep ~http-typesdep ~pandoc-citeprocPVP ok
version bump matches the API change (PVP)
Dependencies added: optparse-applicative, tasty, tasty-hunit, tasty-quickcheck, wai, wai-app-static, warp
Dependencies removed: HUnit, cmdargs, snap-core, snap-server, test-framework, test-framework-hunit, test-framework-quickcheck2
Dependency ranges changed: QuickCheck, http-types, pandoc-citeproc, yaml
API changes (from Hackage documentation)
- Hakyll.Main: instance Data.Data.Data Hakyll.Main.HakyllArgs
- Hakyll.Main: instance GHC.Show.Show Hakyll.Main.HakyllArgs
- Hakyll.Web.Template.Internal: Call :: TemplateKey -> [TemplateExpr] -> TemplateExpr
- Hakyll.Web.Template.Internal: Chunk :: String -> TemplateElement
- Hakyll.Web.Template.Internal: Escaped :: TemplateElement
- Hakyll.Web.Template.Internal: Expr :: TemplateExpr -> TemplateElement
- Hakyll.Web.Template.Internal: For :: TemplateExpr -> Template -> (Maybe Template) -> TemplateElement
- Hakyll.Web.Template.Internal: Ident :: TemplateKey -> TemplateExpr
- Hakyll.Web.Template.Internal: If :: TemplateExpr -> Template -> (Maybe Template) -> TemplateElement
- Hakyll.Web.Template.Internal: Partial :: TemplateExpr -> TemplateElement
- Hakyll.Web.Template.Internal: StringLiteral :: String -> TemplateExpr
- Hakyll.Web.Template.Internal: TemplateKey :: String -> TemplateKey
- Hakyll.Web.Template.Internal: data TemplateElement
- Hakyll.Web.Template.Internal: data TemplateExpr
- Hakyll.Web.Template.Internal: instance Data.Binary.Class.Binary Hakyll.Web.Template.Internal.TemplateElement
- Hakyll.Web.Template.Internal: instance Data.Binary.Class.Binary Hakyll.Web.Template.Internal.TemplateExpr
- Hakyll.Web.Template.Internal: instance Data.Binary.Class.Binary Hakyll.Web.Template.Internal.TemplateKey
- Hakyll.Web.Template.Internal: instance Data.String.IsString Hakyll.Web.Template.Internal.TemplateKey
- Hakyll.Web.Template.Internal: instance GHC.Classes.Eq Hakyll.Web.Template.Internal.TemplateElement
- Hakyll.Web.Template.Internal: instance GHC.Classes.Eq Hakyll.Web.Template.Internal.TemplateExpr
- Hakyll.Web.Template.Internal: instance GHC.Classes.Eq Hakyll.Web.Template.Internal.TemplateKey
- Hakyll.Web.Template.Internal: instance GHC.Show.Show Hakyll.Web.Template.Internal.TemplateElement
- Hakyll.Web.Template.Internal: instance GHC.Show.Show Hakyll.Web.Template.Internal.TemplateExpr
- Hakyll.Web.Template.Internal: instance GHC.Show.Show Hakyll.Web.Template.Internal.TemplateKey
- Hakyll.Web.Template.Internal: newtype TemplateKey
+ Hakyll.Main: instance GHC.Show.Show Hakyll.Main.Command
+ Hakyll.Main: instance GHC.Show.Show Hakyll.Main.Options
+ Hakyll.Web.Template: unsafeReadTemplateFile :: FilePath -> Compiler Template
+ Hakyll.Web.Template.Internal: applyAsTemplate :: Context String -> Item String -> Compiler (Item String)
+ Hakyll.Web.Template.Internal: applyTemplate :: Template -> Context a -> Item a -> Compiler (Item String)
+ Hakyll.Web.Template.Internal: applyTemplate' :: forall a. [TemplateElement] -> Context a -> Item a -> Compiler String
+ Hakyll.Web.Template.Internal: loadAndApplyTemplate :: Identifier -> Context a -> Item a -> Compiler (Item String)
+ Hakyll.Web.Template.Internal: template :: [TemplateElement] -> Template
+ Hakyll.Web.Template.Internal: templateBodyCompiler :: Compiler (Item Template)
+ Hakyll.Web.Template.Internal: templateCompiler :: Compiler (Item Template)
+ Hakyll.Web.Template.Internal: unsafeReadTemplateFile :: FilePath -> Compiler Template
+ Hakyll.Web.Template.Internal.Element: Call :: TemplateKey -> [TemplateExpr] -> TemplateExpr
+ Hakyll.Web.Template.Internal.Element: Chunk :: String -> TemplateElement
+ Hakyll.Web.Template.Internal.Element: Escaped :: TemplateElement
+ Hakyll.Web.Template.Internal.Element: Expr :: TemplateExpr -> TemplateElement
+ Hakyll.Web.Template.Internal.Element: For :: TemplateExpr -> [TemplateElement] -> (Maybe [TemplateElement]) -> TemplateElement
+ Hakyll.Web.Template.Internal.Element: Ident :: TemplateKey -> TemplateExpr
+ Hakyll.Web.Template.Internal.Element: If :: TemplateExpr -> [TemplateElement] -> (Maybe [TemplateElement]) -> TemplateElement
+ Hakyll.Web.Template.Internal.Element: Partial :: TemplateExpr -> TemplateElement
+ Hakyll.Web.Template.Internal.Element: StringLiteral :: String -> TemplateExpr
+ Hakyll.Web.Template.Internal.Element: TemplateKey :: String -> TemplateKey
+ Hakyll.Web.Template.Internal.Element: TrimL :: TemplateElement
+ Hakyll.Web.Template.Internal.Element: TrimR :: TemplateElement
+ Hakyll.Web.Template.Internal.Element: data TemplateElement
+ Hakyll.Web.Template.Internal.Element: data TemplateExpr
+ Hakyll.Web.Template.Internal.Element: instance Data.Binary.Class.Binary Hakyll.Web.Template.Internal.Element.TemplateElement
+ Hakyll.Web.Template.Internal.Element: instance Data.Binary.Class.Binary Hakyll.Web.Template.Internal.Element.TemplateExpr
+ Hakyll.Web.Template.Internal.Element: instance Data.Binary.Class.Binary Hakyll.Web.Template.Internal.Element.TemplateKey
+ Hakyll.Web.Template.Internal.Element: instance Data.String.IsString Hakyll.Web.Template.Internal.Element.TemplateKey
+ Hakyll.Web.Template.Internal.Element: instance GHC.Classes.Eq Hakyll.Web.Template.Internal.Element.TemplateElement
+ Hakyll.Web.Template.Internal.Element: instance GHC.Classes.Eq Hakyll.Web.Template.Internal.Element.TemplateExpr
+ Hakyll.Web.Template.Internal.Element: instance GHC.Classes.Eq Hakyll.Web.Template.Internal.Element.TemplateKey
+ Hakyll.Web.Template.Internal.Element: instance GHC.Show.Show Hakyll.Web.Template.Internal.Element.TemplateElement
+ Hakyll.Web.Template.Internal.Element: instance GHC.Show.Show Hakyll.Web.Template.Internal.Element.TemplateExpr
+ Hakyll.Web.Template.Internal.Element: instance GHC.Show.Show Hakyll.Web.Template.Internal.Element.TemplateKey
+ Hakyll.Web.Template.Internal.Element: newtype TemplateKey
+ Hakyll.Web.Template.Internal.Element: readTemplateElems :: String -> [TemplateElement]
+ Hakyll.Web.Template.Internal.Element: readTemplateElemsFile :: FilePath -> String -> [TemplateElement]
+ Hakyll.Web.Template.Internal.Element: templateElems :: Parser [TemplateElement]
+ Hakyll.Web.Template.Internal.Trim: trim :: [TemplateElement] -> [TemplateElement]
Files
- data/example/templates/default.html +7/−7
- hakyll.cabal +21/−15
- src/Hakyll/Check.hs +24/−15
- src/Hakyll/Commands.hs +1/−3
- src/Hakyll/Core/Util/Parser.hs +9/−2
- src/Hakyll/Main.hs +50/−69
- src/Hakyll/Preview/Server.hs +14/−33
- src/Hakyll/Web/CompressCss.hs +35/−9
- src/Hakyll/Web/Feed.hs +12/−8
- src/Hakyll/Web/Template.hs +24/−133
- src/Hakyll/Web/Template/Internal.hs +128/−146
- src/Hakyll/Web/Template/Internal/Element.hs +298/−0
- src/Hakyll/Web/Template/Internal/Trim.hs +95/−0
- tests/Hakyll/Core/Dependencies/Tests.hs +3/−3
- tests/Hakyll/Core/Identifier/Tests.hs +5/−5
- tests/Hakyll/Core/Provider/Metadata/Tests.hs +3/−3
- tests/Hakyll/Core/Provider/Tests.hs +3/−4
- tests/Hakyll/Core/Routes/Tests.hs +3/−3
- tests/Hakyll/Core/Rules/Tests.hs +3/−3
- tests/Hakyll/Core/Runtime/Tests.hs +16/−3
- tests/Hakyll/Core/Store/Tests.hs +9/−9
- tests/Hakyll/Core/UnixFilter/Tests.hs +5/−5
- tests/Hakyll/Core/Util/String/Tests.hs +3/−3
- tests/Hakyll/Web/CompressCss/Tests.hs +59/−0
- tests/Hakyll/Web/Html/RelativizeUrls/Tests.hs +4/−3
- tests/Hakyll/Web/Html/Tests.hs +4/−4
- tests/Hakyll/Web/Pandoc/FileType/Tests.hs +3/−3
- tests/Hakyll/Web/Template/Context/Tests.hs +4/−5
- tests/Hakyll/Web/Template/Tests.hs +55/−21
- tests/TestSuite.hs +4/−2
- tests/TestSuite/Util.hs +10/−11
data/example/templates/default.html view
@@ -1,11 +1,11 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"-"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">-<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">+<!doctype html>+<html lang="en"> <head>- <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />+ <meta charset="utf-8">+ <meta http-equiv="x-ua-compatible" content="ie=edge">+ <meta name="viewport" content="width=device-width, initial-scale=1"> <title>My Hakyll Blog - $title$</title>- <link rel="stylesheet" type="text/css" href="/css/default.css" />+ <link rel="stylesheet" href="/css/default.css" /> </head> <body> <div id="header">@@ -22,9 +22,9 @@ <div id="content"> <h1>$title$</h1>- $body$ </div>+ <div id="footer"> Site proudly generated by <a href="http://jaspervdj.be/hakyll">Hakyll</a>
hakyll.cabal view
@@ -1,5 +1,5 @@ Name: hakyll-Version: 4.8.3.2+Version: 4.9.0.0 Synopsis: A static website compiler library Description:@@ -116,8 +116,10 @@ Hakyll.Web.Tags Hakyll.Web.Paginate Hakyll.Web.Template- Hakyll.Web.Template.Internal Hakyll.Web.Template.Context+ Hakyll.Web.Template.Internal+ Hakyll.Web.Template.Internal.Element+ Hakyll.Web.Template.Internal.Trim Hakyll.Web.Template.List Other-Modules:@@ -147,7 +149,6 @@ blaze-html >= 0.5 && < 0.9, blaze-markup >= 0.5.1 && < 0.8, bytestring >= 0.9 && < 0.11,- cmdargs >= 0.10 && < 0.11, containers >= 0.3 && < 0.6, cryptohash >= 0.7 && < 0.12, data-default >= 0.4 && < 0.8,@@ -173,12 +174,15 @@ time-locale-compat >= 0.1 && < 0.2, unordered-containers >= 0.2 && < 0.3, vector >= 0.11 && < 0.12,- yaml >= 0.8 && < 0.9+ yaml >= 0.8 && < 0.9,+ optparse-applicative >= 0.12 && < 0.13 If flag(previewServer) Build-depends:- snap-core >= 0.6 && < 0.10,- snap-server >= 0.6 && < 0.10,+ wai >= 3.2 && < 3.3,+ warp >= 3.2 && < 3.3,+ wai-app-static >= 3.1 && < 3.2,+ http-types >= 0.9 && < 0.10, fsnotify >= 0.2 && < 0.3, system-filepath >= 0.4.6 && <= 0.5 Cpp-options:@@ -219,6 +223,7 @@ Hakyll.Core.Store.Tests Hakyll.Core.UnixFilter.Tests Hakyll.Core.Util.String.Tests+ Hakyll.Web.CompressCss.Tests Hakyll.Web.Html.RelativizeUrls.Tests Hakyll.Web.Html.Tests Hakyll.Web.Pandoc.FileType.Tests@@ -227,18 +232,16 @@ TestSuite.Util Build-Depends:- HUnit >= 1.2 && < 1.4,- QuickCheck >= 2.4 && < 2.9,- test-framework >= 0.4 && < 0.9,- test-framework-hunit >= 0.3 && < 0.4,- test-framework-quickcheck2 >= 0.3 && < 0.4,+ QuickCheck >= 2.8 && < 2.9,+ tasty >= 0.11 && < 0.12,+ tasty-hunit >= 0.9 && < 0.10,+ tasty-quickcheck >= 0.8 && < 0.9, -- Copy pasted from hakyll dependencies: base >= 4.8 && < 5, binary >= 0.5 && < 0.9, blaze-html >= 0.5 && < 0.9, blaze-markup >= 0.5.1 && < 0.8, bytestring >= 0.9 && < 0.11,- cmdargs >= 0.10 && < 0.11, containers >= 0.3 && < 0.6, cryptohash >= 0.7 && < 0.12, data-default >= 0.4 && < 0.8,@@ -264,12 +267,15 @@ time-locale-compat >= 0.1 && < 0.2, unordered-containers >= 0.2 && < 0.3, vector >= 0.11 && < 0.12,- yaml >= 0.8 && < 0.9+ yaml >= 0.8.11 && < 0.9,+ optparse-applicative >= 0.12 && < 0.13 If flag(previewServer) Build-depends:- snap-core >= 0.6 && < 0.10,- snap-server >= 0.6 && < 0.10,+ wai >= 3.2 && < 3.3,+ warp >= 3.2 && < 3.3,+ wai-app-static >= 3.1 && < 3.2,+ http-types >= 0.9 && < 0.10, fsnotify >= 0.2 && < 0.3, system-filepath >= 0.4.6 && <= 0.5 Cpp-options:
src/Hakyll/Check.hs view
@@ -14,6 +14,7 @@ import Control.Monad.Trans (liftIO) import Control.Monad.Trans.Resource (runResourceT) import Control.Monad.Writer (tell)+import Data.ByteString.Char8 (unpack) import Data.List (isPrefixOf) import Data.Set (Set) import qualified Data.Set as S@@ -28,9 +29,8 @@ -------------------------------------------------------------------------------- #ifdef CHECK_EXTERNAL-import Control.Exception (AsyncException (..),- SomeException (..), handle,- throw)+import Control.Exception (SomeAsyncException (..),+ SomeException (..), try, throw) import Control.Monad.State (get, modify) import Data.List (intercalate) import Data.Typeable (cast)@@ -162,11 +162,14 @@ tell $ mempty {checkerOk = 1} ---------------------------------------------------------------------------------faulty :: String -> Checker ()-faulty url = do+faulty :: String -> Maybe String -> Checker ()+faulty url reason = do logger <- checkerLogger <$> ask- Logger.error logger $ "Broken link to " ++ show url+ Logger.error logger $ "Broken link to " ++ show url ++ explanation tell $ mempty {checkerFaulty = 1}+ where+ formatExplanation = (" (" ++) . (++ ")")+ explanation = maybe "" formatExplanation reason --------------------------------------------------------------------------------@@ -182,7 +185,7 @@ | otherwise = dir </> url' exists <- checkFileExists filePath- if exists then ok url else faulty url+ if exists then ok url else faulty url Nothing where url' = stripFragments $ unEscapeString url @@ -198,10 +201,10 @@ if not needsCheck || checked then Logger.debug logger "Already checked, skipping" else do- isOk <- liftIO $ handle (failure logger) $ do+ result <- liftIO $ try $ do mgr <- Http.newManager Http.tlsManagerSettings runResourceT $ do- request <- Http.parseUrl urlToCheck+ request <- Http.parseRequest urlToCheck response <- Http.http (settings request) mgr let code = Http.statusCode (Http.responseStatus response) return $ code >= 200 && code < 300@@ -209,7 +212,12 @@ modify $ if schemeRelative url then S.insert urlToCheck . S.insert url else S.insert url- if isOk then ok url else faulty url+ case result of+ Left (SomeException e) ->+ case (cast e :: Maybe SomeAsyncException) of+ Just ae -> throw ae+ _ -> faulty url (Just $ showException e)+ Right _ -> ok url where -- Add additional request info settings r = r@@ -222,14 +230,15 @@ ua = fromString $ "hakyll-check/" ++ (intercalate "." $ map show $ versionBranch $ Paths_hakyll.version) - -- Catch all the things except UserInterrupt- failure logger (SomeException e) = case cast e of- Just UserInterrupt -> throw UserInterrupt- _ -> Logger.error logger (show e) >> return False- -- Check scheme-relative links schemeRelative = isPrefixOf "//" urlToCheck = if schemeRelative url then "http:" ++ url else url++ -- Convert exception to a concise form+ showException e = case cast e of+ Just (Http.StatusCodeException (Http.Status code msg) _ _) ->+ show code ++ " " ++ unpack msg+ _ -> head $ words $ show e #else checkExternalUrl _ = return () #endif
src/Hakyll/Commands.hs view
@@ -121,9 +121,7 @@ #ifdef PREVIEW_SERVER server conf logger host port = do let destination = destinationDirectory conf- staticServer logger destination preServeHook host port- where- preServeHook _ = return ()+ staticServer logger destination host port #else server _ _ _ _ = previewServerDisabled #endif
src/Hakyll/Core/Util/Parser.hs view
@@ -8,7 +8,7 @@ -------------------------------------------------------------------------------- import Control.Applicative ((<|>))-import Control.Monad (mzero)+import Control.Monad (guard, mzero, void) import qualified Text.Parsec as P import Text.Parsec.String (Parser) @@ -16,7 +16,14 @@ -------------------------------------------------------------------------------- metadataKey :: Parser String metadataKey = do- i <- (:) <$> P.letter <*> (P.many $ P.alphaNum <|> P.oneOf "_-.")+ -- Ensure trailing '-' binds to '$' if present.+ let hyphon = P.try $ do+ void $ P.char '-'+ x <- P.lookAhead P.anyChar+ guard $ x /= '$'+ pure '-'++ i <- (:) <$> P.letter <*> P.many (P.alphaNum <|> P.oneOf "_." <|> hyphon) if i `elem` reservedKeys then mzero else return i
src/Hakyll/Main.hs view
@@ -10,13 +10,16 @@ ---------------------------------------------------------------------------------import System.Console.CmdArgs-import qualified System.Console.CmdArgs.Explicit as CA import System.Environment (getProgName) import System.IO.Unsafe (unsafePerformIO) import System.Exit (ExitCode(ExitSuccess), exitWith) + --------------------------------------------------------------------------------+import Options.Applicative+++-------------------------------------------------------------------------------- import qualified Hakyll.Check as Check import qualified Hakyll.Commands as Commands import qualified Hakyll.Core.Configuration as Config@@ -37,88 +40,66 @@ hakyllWithExitCode :: Config.Configuration -> Rules a -> IO ExitCode hakyllWithExitCode conf rules = do- args' <- cmdArgs (hakyllArgs conf)+ args' <- customExecParser (prefs showHelpOnError) (info (helper <*> optionParser conf) (fullDesc <> progDesc (progName ++ " - Static site compiler created with Hakyll")))+ let args'' = optCommand args' - let verbosity' = if verbose args' then Logger.Debug else Logger.Message+ let verbosity' = if verbosity args' then Logger.Debug else Logger.Message check' =- if internal_links args' then Check.InternalLinks else Check.All+ if internal_links args'' then Check.InternalLinks else Check.All logger <- Logger.new verbosity'- case args' of- Build _ -> Commands.build conf logger rules- Check _ _ -> Commands.check conf logger check' >> ok- Clean _ -> Commands.clean conf logger >> ok- Deploy _ -> Commands.deploy conf- Help _ -> showHelp >> ok- Preview _ p -> Commands.preview conf logger rules p >> ok- Rebuild _ -> Commands.rebuild conf logger rules- Server _ _ _ -> Commands.server conf logger (host args') (port args') >> ok- Watch _ _ p s -> Commands.watch conf logger (host args') p (not s) rules >> ok++ case args'' of+ Build -> Commands.build conf logger rules+ Check _ -> Commands.check conf logger check' >> ok+ Clean -> Commands.clean conf logger >> ok+ Deploy -> Commands.deploy conf+ Preview p -> Commands.preview conf logger rules p >> ok+ Rebuild -> Commands.rebuild conf logger rules+ Server _ _ -> Commands.server conf logger (host args'') (port args'') >> ok+ Watch _ p s -> Commands.watch conf logger (host args'') p (not s) rules >> ok where ok = return ExitSuccess ----------------------------------------------------------------------------------- | Show usage information.-showHelp :: IO ()-showHelp = print $ CA.helpText [] CA.HelpFormatOne $ cmdArgsMode (hakyllArgs Config.defaultConfiguration) -----------------------------------------------------------------------------------data HakyllArgs- = Build {verbose :: Bool}- | Check {verbose :: Bool, internal_links :: Bool}- | Clean {verbose :: Bool}- | Deploy {verbose :: Bool}- | Help {verbose :: Bool}- | Preview {verbose :: Bool, port :: Int}- | Rebuild {verbose :: Bool}- | Server {verbose :: Bool, host :: String, port :: Int}- | Watch {verbose :: Bool, host :: String, port :: Int, no_server :: Bool }- deriving (Data, Typeable, Show)+data Options = Options {verbosity :: Bool, optCommand :: Command}+ deriving (Show) +data Command+ = Build+ | Check {internal_links :: Bool}+ | Clean+ | Deploy+ | Preview {port :: Int}+ | Rebuild+ | Server {host :: String, port :: Int}+ | Watch {host :: String, port :: Int, no_server :: Bool }+ deriving (Show) ----------------------------------------------------------------------------------hakyllArgs :: Config.Configuration -> HakyllArgs-hakyllArgs conf = modes- [ (Build $ verboseFlag def) &= help "Generate the site"- , (Check (verboseFlag def) (False &= help "Check internal links only")) &=- help "Validate the site output"- , (Clean $ verboseFlag def) &= help "Clean up and remove cache"- , (Deploy $ verboseFlag def) &= help "Upload/deploy your site"- , (Help $ verboseFlag def) &= help "Show this message" &= auto- , (Preview (verboseFlag def) (portFlag defaultPort)) &=- help "[Deprecated] Please use the watch command"- , (Rebuild $ verboseFlag def) &= help "Clean and build again"- , (Server (verboseFlag def) (hostFlag defaultHost) (portFlag defaultPort)) &=- help "Start a preview server"- , (Watch (verboseFlag def) (hostFlag defaultHost) (portFlag defaultPort) (noServerFlag False) &=- help "Autocompile on changes and start a preview server. You can watch and recompile without running a server with --no-server.")- ] &= help "Hakyll static site compiler" &= program progName+optionParser :: Config.Configuration -> Parser Options+optionParser conf = Options <$> verboseParser <*> (commandParser conf) where- defaultHost = Config.previewHost conf- defaultPort = Config.previewPort conf-----------------------------------------------------------------------------------verboseFlag :: Data a => a -> a-verboseFlag x = x &= help "Run in verbose mode"-{-# INLINE verboseFlag #-}+ verboseParser = switch (long "verbose" <> short 'v' <> help "Run in verbose mode") ----------------------------------------------------------------------------------noServerFlag :: Data a => a -> a-noServerFlag x = x &= help "Disable the built-in web server"-{-# INLINE noServerFlag #-}-----------------------------------------------------------------------------------hostFlag :: Data a => a -> a-hostFlag x = x &= help "Host to bind on"-{-# INLINE hostFlag #-}-----------------------------------------------------------------------------------portFlag :: Data a => a -> a-portFlag x = x &= help "Port to listen on"-{-# INLINE portFlag #-}+commandParser :: Config.Configuration -> Parser Command+commandParser conf = subparser $ foldr ((<>) . produceCommand) mempty commands+ where+ produceCommand (a,b) = command a (info (helper <*> (fst b)) (snd b))+ portParser = option auto (long "port" <> help "Port to listen on" <> value (Config.previewPort conf))+ hostParser = strOption (long "host" <> help "Host to bind on" <> value (Config.previewHost conf))+ commands = [+ ("build",(pure Build,fullDesc <> progDesc "Generate the site")),+ ("check",(pure Check <*> switch (long "internal-links" <> help "Check internal links only"), fullDesc <> progDesc "Validate the site output")),+ ("clean",(pure Clean,fullDesc <> progDesc "Clean up and remove cache")),+ ("deploy",(pure Deploy,fullDesc <> progDesc "Upload/deploy your site")),+ ("preview",(pure Preview <*> portParser,fullDesc <> progDesc "[DEPRECATED] Please use the watch command")),+ ("rebuild",(pure Rebuild,fullDesc <> progDesc "Clean and build again")),+ ("server",(pure Server <*> hostParser <*> portParser,fullDesc <> progDesc "Start a preview server")),+ ("watch",(pure Watch <*> hostParser <*> portParser <*> switch (long "no-server" <> help "Disable the built-in web server"),fullDesc <> progDesc "Autocompile on changes and start a preview server. You can watch and recompile without running a server with --no-server."))+ ] --------------------------------------------------------------------------------
src/Hakyll/Preview/Server.hs view
@@ -7,48 +7,29 @@ ---------------------------------------------------------------------------------import Control.Monad.Trans (liftIO)-import qualified Data.ByteString.Char8 as B-import qualified Snap.Core as Snap-import qualified Snap.Http.Server as Snap-import qualified Snap.Util.FileServe as Snap-+import Data.String+import qualified Network.Wai.Handler.Warp as Warp+import qualified Network.Wai.Application.Static as Static+import qualified Network.Wai as Wai+import Network.HTTP.Types.Status (Status) -------------------------------------------------------------------------------- import Hakyll.Core.Logger (Logger) import qualified Hakyll.Core.Logger as Logger ------------------------------------------------------------------------------------- | Serve a given directory-static :: FilePath -- ^ Directory to serve- -> (FilePath -> IO ()) -- ^ Pre-serve hook- -> Snap.Snap ()-static directory preServe =- Snap.serveDirectoryWith directoryConfig directory- where- directoryConfig :: Snap.DirectoryConfig Snap.Snap- directoryConfig = Snap.fancyDirectoryConfig- { Snap.preServeHook = liftIO . preServe- }-------------------------------------------------------------------------------------- | Main method, runs a static server in the given directory staticServer :: Logger -- ^ Logger -> FilePath -- ^ Directory to serve- -> (FilePath -> IO ()) -- ^ Pre-serve hook -> String -- ^ Host to bind on -> Int -- ^ Port to listen on -> IO () -- ^ Blocks forever-staticServer logger directory preServe host port = do+staticServer logger directory host port = do Logger.header logger $ "Listening on http://" ++ host ++ ":" ++ show port- Snap.httpServe config $ static directory preServe+ Warp.runSettings warpSettings $+ Static.staticApp (Static.defaultFileServerSettings directory) where- -- Snap server config- config = Snap.setBind (B.pack host)- $ Snap.setPort port- $ Snap.setAccessLog Snap.ConfigNoLog- $ Snap.setErrorLog Snap.ConfigNoLog- $ Snap.setVerbose False- $ Snap.emptyConfig+ warpSettings = Warp.setLogger noLog+ $ Warp.setHost (fromString host)+ $ Warp.setPort port Warp.defaultSettings++noLog :: Wai.Request -> Status -> Maybe Integer -> IO ()+noLog _ _ _ = return ()
src/Hakyll/Web/CompressCss.hs view
@@ -8,14 +8,12 @@ ---------------------------------------------------------------------------------import Data.Char (isSpace) import Data.List (isPrefixOf) -------------------------------------------------------------------------------- import Hakyll.Core.Compiler import Hakyll.Core.Item-import Hakyll.Core.Util.String --------------------------------------------------------------------------------@@ -33,27 +31,55 @@ -------------------------------------------------------------------------------- -- | Compresses certain forms of separators. compressSeparators :: String -> String-compressSeparators =- replaceAll "; *}" (const "}") .- replaceAll " *([{};:]) *" (take 1 . dropWhile isSpace) .- replaceAll ";+" (const ";")-+compressSeparators [] = []+compressSeparators str+ | isConstant = head str : retainConstants compressSeparators (head str) (drop 1 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) [" ", " {", " }", " :", ";;", ";}"]+ stripSecond = or $ map (isOfPrefix str) ["{ ", "} ", ": ", "; "] -------------------------------------------------------------------------------- -- | Compresses all whitespace. compressWhitespace :: String -> String-compressWhitespace = replaceAll "[ \t\n\r]+" (const " ")-+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", " "] -------------------------------------------------------------------------------- -- | Function that strips CSS comments away. 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'++--------------------------------------------------------------------------------+-- | 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)++--------------------------------------------------------------------------------+-- | Helper function to determine whether a string is a substring.+isOfPrefix :: String -> String -> Bool+isOfPrefix = flip isPrefixOf
src/Hakyll/Web/Feed.hs view
@@ -24,13 +24,10 @@ ---------------------------------------------------------------------------------import Control.Monad ((<=<))----------------------------------------------------------------------------------- import Hakyll.Core.Compiler import Hakyll.Core.Compiler.Internal import Hakyll.Core.Item+import Hakyll.Core.Util.String (replaceAll) import Hakyll.Web.Template import Hakyll.Web.Template.Context import Hakyll.Web.Template.List@@ -65,14 +62,21 @@ -> [Item String] -- ^ Input items -> Compiler (Item String) -- ^ Resulting item renderFeed feedPath itemPath config itemContext items = do- feedTpl <- compilerUnsafeIO $ loadTemplate feedPath- itemTpl <- compilerUnsafeIO $ loadTemplate itemPath+ feedTpl <- loadTemplate feedPath+ itemTpl <- loadTemplate itemPath - body <- makeItem =<< applyTemplateList itemTpl itemContext' items+ protectedItems <- mapM (applyFilter protectCDATA) items+ body <- makeItem =<< applyTemplateList itemTpl itemContext' protectedItems applyTemplate feedTpl feedContext body where+ applyFilter :: (Monad m,Functor f) => (String -> String) -> f String -> m (f String)+ applyFilter tr str = return $ fmap tr str+ protectCDATA :: String -> String+ protectCDATA = replaceAll "]]>" (const "]]>") -- Auxiliary: load a template from a datafile- loadTemplate = fmap readTemplate . readFile <=< getDataFileName+ loadTemplate path = do+ file <- compilerUnsafeIO $ getDataFileName path+ unsafeReadTemplateFile file itemContext' = mconcat [ itemContext
src/Hakyll/Web/Template.hs view
@@ -115,7 +115,29 @@ -- That is, calling @$partial$@ is equivalent to just copying and pasting -- template code. ---{-# LANGUAGE ScopedTypeVariables #-}+-- In the examples above you can see that the outputs contain a lot of leftover+-- whitespace that you may wish to remove. Using @'$-'@ or @'-$'@ instead of+-- @'$'@ in a macro strips all whitespace to the left or right of that clause+-- respectively. Given the context+--+-- > listField "counts" (field "count" (return . itemBody))+-- > (sequence [makeItem "3", makeItem "2", makeItem "1"])+--+-- and a template+--+-- > <p>+-- > $for(counts)-$+-- > $count$+-- > $-sep$...+-- > $-endfor$+-- > </p>+--+-- the resulting page would look like+--+-- > <p>+-- > 3...2...1+-- > </p>+-- module Hakyll.Web.Template ( Template , templateBodyCompiler@@ -124,140 +146,9 @@ , loadAndApplyTemplate , applyAsTemplate , readTemplate+ , unsafeReadTemplateFile ) where ---------------------------------------------------------------------------------import Control.Monad (liftM)-import Control.Monad.Except (MonadError (..))-import Data.List (intercalate)-import Prelude hiding (id)------------------------------------------------------------------------------------import Hakyll.Core.Compiler-import Hakyll.Core.Identifier-import Hakyll.Core.Item-import Hakyll.Web.Template.Context import Hakyll.Web.Template.Internal-------------------------------------------------------------------------------------- | Read a template, without metadata header-templateBodyCompiler :: Compiler (Item Template)-templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do- item <- getResourceBody- return $ fmap readTemplate item------------------------------------------------------------------------------------- | Read complete file contents as a template-templateCompiler :: Compiler (Item Template)-templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do- item <- getResourceString- return $ fmap readTemplate item------------------------------------------------------------------------------------applyTemplate :: Template -- ^ Template- -> Context a -- ^ Context- -> Item a -- ^ Page- -> Compiler (Item String) -- ^ Resulting item-applyTemplate tpl context item = do- body <- applyTemplate' tpl context item- return $ itemSetBody body item------------------------------------------------------------------------------------applyTemplate'- :: forall a.- Template -- ^ Template- -> Context a -- ^ Context- -> Item a -- ^ Page- -> Compiler String -- ^ Resulting item-applyTemplate' tpl context x = go tpl- where- context' :: String -> [String] -> Item a -> Compiler ContextField- context' = unContext (context `mappend` missingField)-- go = liftM concat . mapM applyElem . unTemplate-- ----------------------------------------------------------------------------- applyElem :: TemplateElement -> Compiler String-- applyElem (Chunk c) = return c-- applyElem (Expr e) = applyExpr e >>= getString e-- applyElem Escaped = return "$"-- applyElem (If e t mf) = (applyExpr e >> go t) `catchError` handler- where- handler _ = case mf of- Nothing -> return ""- Just f -> go f-- applyElem (For e b s) = applyExpr e >>= \cf -> case cf of- StringField _ -> fail $- "Hakyll.Web.Template.applyTemplateWith: expected ListField but " ++- "got StringField for expr " ++ show e- ListField c xs -> do- sep <- maybe (return "") go s- bs <- mapM (applyTemplate' b c) xs- return $ intercalate sep bs-- applyElem (Partial e) = do- p <- applyExpr e >>= getString e- tpl' <- loadBody (fromFilePath p)- applyTemplate' tpl' context x-- ----------------------------------------------------------------------------- applyExpr :: TemplateExpr -> Compiler ContextField-- applyExpr (Ident (TemplateKey k)) = context' k [] x-- applyExpr (Call (TemplateKey k) args) = do- args' <- mapM (\e -> applyExpr e >>= getString e) args- context' k args' x-- applyExpr (StringLiteral s) = return (StringField s)-- ------------------------------------------------------------------------------ getString _ (StringField s) = return s- getString e (ListField _ _) = fail $- "Hakyll.Web.Template.applyTemplateWith: expected StringField but " ++- "got ListField for expr " ++ show e-------------------------------------------------------------------------------------- | The following pattern is so common:------ > tpl <- loadBody "templates/foo.html"--- > someCompiler--- > >>= applyTemplate tpl context------ That we have a single function which does this:------ > someCompiler--- > >>= loadAndApplyTemplate "templates/foo.html" context-loadAndApplyTemplate :: Identifier -- ^ Template identifier- -> Context a -- ^ Context- -> Item a -- ^ Page- -> Compiler (Item String) -- ^ Resulting item-loadAndApplyTemplate identifier context item = do- tpl <- loadBody identifier- applyTemplate tpl context item-------------------------------------------------------------------------------------- | It is also possible that you want to substitute @$key$@s within the body of--- an item. This function does that by interpreting the item body as a template,--- and then applying it to itself.-applyAsTemplate :: Context String -- ^ Context- -> Item String -- ^ Item and template- -> Compiler (Item String) -- ^ Resulting item-applyAsTemplate context item =- let tpl = readTemplate $ itemBody item- in applyTemplate tpl context item
src/Hakyll/Web/Template/Internal.hs view
@@ -1,30 +1,39 @@------------------------------------------------------------------------------------ | Module containing the template data structure-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-} module Hakyll.Web.Template.Internal ( Template (..)- , TemplateKey (..)- , TemplateExpr (..)- , TemplateElement (..)+ , template+ , templateBodyCompiler+ , templateCompiler+ , applyTemplate+ , applyTemplate'+ , loadAndApplyTemplate+ , applyAsTemplate , readTemplate+ , unsafeReadTemplateFile++ , module Hakyll.Web.Template.Internal.Element+ , module Hakyll.Web.Template.Internal.Trim ) where ---------------------------------------------------------------------------------import Control.Applicative ((<|>))-import Control.Monad (void)-import Data.Binary (Binary, get, getWord8, put, putWord8)-import Data.Typeable (Typeable)-import Data.List (intercalate)-import GHC.Exts (IsString (..))-import qualified Text.Parsec as P-import qualified Text.Parsec.String as P+import Control.Monad.Except (MonadError (..))+import Data.Binary (Binary)+import Data.List (intercalate)+import Data.Typeable (Typeable)+import GHC.Exts (IsString (..))+import Prelude hiding (id) ---------------------------------------------------------------------------------import Hakyll.Core.Util.Parser+import Hakyll.Core.Compiler+import Hakyll.Core.Identifier+import Hakyll.Core.Item import Hakyll.Core.Writable+import Hakyll.Web.Template.Context+import Hakyll.Web.Template.Internal.Element+import Hakyll.Web.Template.Internal.Trim --------------------------------------------------------------------------------@@ -46,176 +55,149 @@ ---------------------------------------------------------------------------------newtype TemplateKey = TemplateKey String- deriving (Binary, Show, Eq, Typeable)------------------------------------------------------------------------------------instance IsString TemplateKey where- fromString = TemplateKey+-- | Wrap the constructor to ensure trim is called.+template :: [TemplateElement] -> Template+template = Template . trim ----------------------------------------------------------------------------------- | Elements of a template.-data TemplateElement- = Chunk String- | Expr TemplateExpr- | Escaped- | If TemplateExpr Template (Maybe Template) -- expr, then, else- | For TemplateExpr Template (Maybe Template) -- expr, body, separator- | Partial TemplateExpr -- filename- deriving (Show, Eq, Typeable)-+readTemplate :: String -> Template+readTemplate = Template . trim . readTemplateElems ---------------------------------------------------------------------------------instance Binary TemplateElement where- put (Chunk string) = putWord8 0 >> put string- put (Expr e) = putWord8 1 >> put e- put (Escaped) = putWord8 2- put (If e t f ) = putWord8 3 >> put e >> put t >> put f- put (For e b s) = putWord8 4 >> put e >> put b >> put s- put (Partial e) = putWord8 5 >> put e-- get = getWord8 >>= \tag -> case tag of- 0 -> Chunk <$> get- 1 -> Expr <$> get- 2 -> pure Escaped- 3 -> If <$> get <*> get <*> get- 4 -> For <$> get <*> get <*> get- 5 -> Partial <$> get- _ -> error $- "Hakyll.Web.Template.Internal: Error reading cached template"-+-- | Read a template, without metadata header+templateBodyCompiler :: Compiler (Item Template)+templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do+ item <- getResourceBody+ file <- getResourceFilePath+ return $ fmap (template . readTemplateElemsFile file) item ----------------------------------------------------------------------------------- | Expression in a template-data TemplateExpr- = Ident TemplateKey- | Call TemplateKey [TemplateExpr]- | StringLiteral String- deriving (Eq, Typeable)+-- | Read complete file contents as a template+templateCompiler :: Compiler (Item Template)+templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do+ item <- getResourceString+ file <- getResourceFilePath+ return $ fmap (template . readTemplateElemsFile file) item ---------------------------------------------------------------------------------instance Show TemplateExpr where- show (Ident (TemplateKey k)) = k- show (Call (TemplateKey k) as) =- k ++ "(" ++ intercalate ", " (map show as) ++ ")"- show (StringLiteral s) = show s+applyTemplate :: Template -- ^ Template+ -> Context a -- ^ Context+ -> Item a -- ^ Page+ -> Compiler (Item String) -- ^ Resulting item+applyTemplate tpl context item = do+ body <- applyTemplate' (unTemplate tpl) context item+ return $ itemSetBody body item ---------------------------------------------------------------------------------instance Binary TemplateExpr where- put (Ident k) = putWord8 0 >> put k- put (Call k as) = putWord8 1 >> put k >> put as- put (StringLiteral s) = putWord8 2 >> put s+applyTemplate'+ :: forall a.+ [TemplateElement] -- ^ Unwrapped Template+ -> Context a -- ^ Context+ -> Item a -- ^ Page+ -> Compiler String -- ^ Resulting item+applyTemplate' tes context x = go tes+ where+ context' :: String -> [String] -> Item a -> Compiler ContextField+ context' = unContext (context `mappend` missingField) - get = getWord8 >>= \tag -> case tag of- 0 -> Ident <$> get- 1 -> Call <$> get <*> get- 2 -> StringLiteral <$> get- _ -> error $- "Hakyll.Web.Tamplte.Internal: Error reading cached template"+ go = fmap concat . mapM applyElem + trimError = error $ "Hakyll.Web.Template.applyTemplate: template not " +++ "fully trimmed." ----------------------------------------------------------------------------------readTemplate :: String -> Template-readTemplate input = case P.parse template "" input of- Left err -> error $ "Cannot parse template: " ++ show err- Right t -> t+ --------------------------------------------------------------------------- + applyElem :: TemplateElement -> Compiler String ----------------------------------------------------------------------------------template :: P.Parser Template-template = Template <$>- (P.many $ chunk <|> escaped <|> conditional <|> for <|> partial <|> expr)+ applyElem TrimL = trimError + applyElem TrimR = trimError ----------------------------------------------------------------------------------chunk :: P.Parser TemplateElement-chunk = Chunk <$> (P.many1 $ P.noneOf "$")+ applyElem (Chunk c) = return c + applyElem (Expr e) = applyExpr e >>= getString e ----------------------------------------------------------------------------------expr :: P.Parser TemplateElement-expr = P.try $ do- void $ P.char '$'- e <- expr'- void $ P.char '$'- return $ Expr e+ applyElem Escaped = return "$" + applyElem (If e t mf) = (applyExpr e >> go t) `catchError` handler+ where+ handler _ = case mf of+ Nothing -> return ""+ Just f -> go f ----------------------------------------------------------------------------------expr' :: P.Parser TemplateExpr-expr' = stringLiteral <|> call <|> ident+ applyElem (For e b s) = applyExpr e >>= \cf -> case cf of+ StringField _ -> fail $+ "Hakyll.Web.Template.applyTemplateWith: expected ListField but " +++ "got StringField for expr " ++ show e+ ListField c xs -> do+ sep <- maybe (return "") go s+ bs <- mapM (applyTemplate' b c) xs+ return $ intercalate sep bs + applyElem (Partial e) = do+ p <- applyExpr e >>= getString e+ Template tpl' <- loadBody (fromFilePath p)+ applyTemplate' tpl' context x ----------------------------------------------------------------------------------escaped :: P.Parser TemplateElement-escaped = Escaped <$ (P.try $ P.string "$$")+ --------------------------------------------------------------------------- + applyExpr :: TemplateExpr -> Compiler ContextField ----------------------------------------------------------------------------------conditional :: P.Parser TemplateElement-conditional = P.try $ do- void $ P.string "$if("- e <- expr'- void $ P.string ")$"- thenBranch <- template- elseBranch <- P.optionMaybe $ P.try (P.string "$else$") >> template- void $ P.string "$endif$"- return $ If e thenBranch elseBranch+ applyExpr (Ident (TemplateKey k)) = context' k [] x + applyExpr (Call (TemplateKey k) args) = do+ args' <- mapM (\e -> applyExpr e >>= getString e) args+ context' k args' x ----------------------------------------------------------------------------------for :: P.Parser TemplateElement-for = P.try $ do- void $ P.string "$for("- e <- expr'- void $ P.string ")$"- body <- template- sep <- P.optionMaybe $ P.try (P.string "$sep$") >> template- void $ P.string "$endfor$"- return $ For e body sep+ applyExpr (StringLiteral s) = return (StringField s) + ---------------------------------------------------------------------------- ----------------------------------------------------------------------------------partial :: P.Parser TemplateElement-partial = P.try $ do- void $ P.string "$partial("- e <- expr'- void $ P.string ")$"- return $ Partial e+ getString _ (StringField s) = return s+ getString e (ListField _ _) = fail $+ "Hakyll.Web.Template.applyTemplateWith: expected StringField but " +++ "got ListField for expr " ++ show e ---------------------------------------------------------------------------------ident :: P.Parser TemplateExpr-ident = P.try $ Ident <$> key+-- | The following pattern is so common:+--+-- > tpl <- loadBody "templates/foo.html"+-- > someCompiler+-- > >>= applyTemplate tpl context+--+-- That we have a single function which does this:+--+-- > someCompiler+-- > >>= loadAndApplyTemplate "templates/foo.html" context+loadAndApplyTemplate :: Identifier -- ^ Template identifier+ -> Context a -- ^ Context+ -> Item a -- ^ Page+ -> Compiler (Item String) -- ^ Resulting item+loadAndApplyTemplate identifier context item = do+ tpl <- loadBody identifier+ applyTemplate tpl context item ---------------------------------------------------------------------------------call :: P.Parser TemplateExpr-call = P.try $ do- f <- key- void $ P.char '('- P.spaces- as <- P.sepBy expr' (P.spaces >> P.char ',' >> P.spaces)- P.spaces- void $ P.char ')'- return $ Call f as+-- | It is also possible that you want to substitute @$key$@s within the body of+-- an item. This function does that by interpreting the item body as a template,+-- and then applying it to itself.+applyAsTemplate :: Context String -- ^ Context+ -> Item String -- ^ Item and template+ -> Compiler (Item String) -- ^ Resulting item+applyAsTemplate context item =+ let tpl = template $ readTemplateElemsFile file (itemBody item)+ file = toFilePath $ itemIdentifier item+ in applyTemplate tpl context item ---------------------------------------------------------------------------------stringLiteral :: P.Parser TemplateExpr-stringLiteral = do- void $ P.char '\"'- str <- P.many $ do- x <- P.noneOf "\""- if x == '\\' then P.anyChar else return x- void $ P.char '\"'- return $ StringLiteral str-+unsafeReadTemplateFile :: FilePath -> Compiler Template+unsafeReadTemplateFile file = do+ tpl <- unsafeCompiler $ readFile file+ pure $ template $ readTemplateElemsFile file tpl ----------------------------------------------------------------------------------key :: P.Parser TemplateKey-key = TemplateKey <$> metadataKey
+ src/Hakyll/Web/Template/Internal/Element.hs view
@@ -0,0 +1,298 @@+--------------------------------------------------------------------------------+-- | Module containing the elements used in a template. A template is generally+-- just a list of these elements.+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Hakyll.Web.Template.Internal.Element+ ( TemplateKey (..)+ , TemplateExpr (..)+ , TemplateElement (..)+ , templateElems+ , readTemplateElems+ , readTemplateElemsFile+ ) where+++--------------------------------------------------------------------------------+import Control.Applicative ((<|>))+import Control.Monad (void)+import Data.Binary (Binary, get, getWord8, put, putWord8)+import Data.List (intercalate)+import Data.Maybe (isJust)+import Data.Typeable (Typeable)+import GHC.Exts (IsString (..))+import qualified Text.Parsec as P+import qualified Text.Parsec.String as P+++--------------------------------------------------------------------------------+import Hakyll.Core.Util.Parser+++--------------------------------------------------------------------------------+newtype TemplateKey = TemplateKey String+ deriving (Binary, Show, Eq, Typeable)+++--------------------------------------------------------------------------------+instance IsString TemplateKey where+ fromString = TemplateKey+++--------------------------------------------------------------------------------+-- | Elements of a template.+data TemplateElement+ = Chunk String+ | Expr TemplateExpr+ | Escaped+ -- expr, then, else+ | If TemplateExpr [TemplateElement] (Maybe [TemplateElement])+ -- expr, body, separator+ | For TemplateExpr [TemplateElement] (Maybe [TemplateElement])+ -- filename+ | Partial TemplateExpr+ | TrimL+ | TrimR+ deriving (Show, Eq, Typeable)+++--------------------------------------------------------------------------------+instance Binary TemplateElement where+ put (Chunk string) = putWord8 0 >> put string+ put (Expr e) = putWord8 1 >> put e+ put Escaped = putWord8 2+ put (If e t f) = putWord8 3 >> put e >> put t >> put f+ put (For e b s) = putWord8 4 >> put e >> put b >> put s+ put (Partial e) = putWord8 5 >> put e+ put TrimL = putWord8 6+ put TrimR = putWord8 7++ get = getWord8 >>= \tag -> case tag of+ 0 -> Chunk <$> get+ 1 -> Expr <$> get+ 2 -> pure Escaped+ 3 -> If <$> get <*> get <*> get+ 4 -> For <$> get <*> get <*> get+ 5 -> Partial <$> get+ 6 -> pure TrimL+ 7 -> pure TrimR+ _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"+++--------------------------------------------------------------------------------+-- | Expression in a template+data TemplateExpr+ = Ident TemplateKey+ | Call TemplateKey [TemplateExpr]+ | StringLiteral String+ deriving (Eq, Typeable)+++--------------------------------------------------------------------------------+instance Show TemplateExpr where+ show (Ident (TemplateKey k)) = k+ show (Call (TemplateKey k) as) =+ k ++ "(" ++ intercalate ", " (map show as) ++ ")"+ show (StringLiteral s) = show s+++--------------------------------------------------------------------------------+instance Binary TemplateExpr where+ put (Ident k) = putWord8 0 >> put k+ put (Call k as) = putWord8 1 >> put k >> put as+ put (StringLiteral s) = putWord8 2 >> put s++ get = getWord8 >>= \tag -> case tag of+ 0 -> Ident <$> get+ 1 -> Call <$> get <*> get+ 2 -> StringLiteral <$> get+ _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"+++--------------------------------------------------------------------------------+readTemplateElems :: String -> [TemplateElement]+readTemplateElems = readTemplateElemsFile "{literal}"+++--------------------------------------------------------------------------------+readTemplateElemsFile :: FilePath -> String -> [TemplateElement]+readTemplateElemsFile file input = case P.parse templateElems file input of+ Left err -> error $ "Cannot parse template: " ++ show err+ Right t -> t+++--------------------------------------------------------------------------------+templateElems :: P.Parser [TemplateElement]+templateElems = mconcat <$> P.many (P.choice [ lift chunk+ , lift escaped+ , conditional+ , for+ , partial+ , expr+ ])+ where lift = fmap (:[])+++--------------------------------------------------------------------------------+chunk :: P.Parser TemplateElement+chunk = Chunk <$> P.many1 (P.noneOf "$")+++--------------------------------------------------------------------------------+expr :: P.Parser [TemplateElement]+expr = P.try $ do+ trimLExpr <- trimOpen+ e <- expr'+ trimRExpr <- trimClose+ return $ [TrimL | trimLExpr] ++ [Expr e] ++ [TrimR | trimRExpr]+++--------------------------------------------------------------------------------+expr' :: P.Parser TemplateExpr+expr' = stringLiteral <|> call <|> ident+++--------------------------------------------------------------------------------+escaped :: P.Parser TemplateElement+escaped = Escaped <$ P.try (P.string "$$")+++--------------------------------------------------------------------------------+trimOpen :: P.Parser Bool+trimOpen = do+ void $ P.char '$'+ trimLIf <- P.optionMaybe $ P.try (P.char '-')+ pure $ isJust trimLIf+++--------------------------------------------------------------------------------+trimClose :: P.Parser Bool+trimClose = do+ trimIfR <- P.optionMaybe $ P.try (P.char '-')+ void $ P.char '$'+ pure $ isJust trimIfR+++--------------------------------------------------------------------------------+conditional :: P.Parser [TemplateElement]+conditional = P.try $ do+ -- if+ trimLIf <- trimOpen+ void $ P.string "if("+ e <- expr'+ void $ P.char ')'+ trimRIf <- trimClose+ -- then+ thenBranch <- templateElems+ -- else+ elseParse <- opt "else"+ -- endif+ trimLEnd <- trimOpen+ void $ P.string "endif"+ trimREnd <- trimClose++ -- As else is optional we need to sort out where any Trim_s need to go.+ let (thenBody, elseBody) = maybe (thenNoElse, Nothing) thenElse elseParse+ where thenNoElse =+ [TrimR | trimRIf] ++ thenBranch ++ [TrimL | trimLEnd]++ thenElse (trimLElse, elseBranch, trimRElse) = (thenB, elseB)+ where thenB = [TrimR | trimRIf]+ ++ thenBranch+ ++ [TrimL | trimLElse]++ elseB = Just $ [TrimR | trimRElse]+ ++ elseBranch+ ++ [TrimL | trimLEnd]++ pure $ [TrimL | trimLIf] ++ [If e thenBody elseBody] ++ [TrimR | trimREnd]+++--------------------------------------------------------------------------------+for :: P.Parser [TemplateElement]+for = P.try $ do+ -- for+ trimLFor <- trimOpen+ void $ P.string "for("+ e <- expr'+ void $ P.char ')'+ trimRFor <- trimClose+ -- body+ bodyBranch <- templateElems+ -- sep+ sepParse <- opt "sep"+ -- endfor+ trimLEnd <- trimOpen+ void $ P.string "endfor"+ trimREnd <- trimClose++ -- As sep is optional we need to sort out where any Trim_s need to go.+ let (forBody, sepBody) = maybe (forNoSep, Nothing) forSep sepParse+ where forNoSep =+ [TrimR | trimRFor] ++ bodyBranch ++ [TrimL | trimLEnd]++ forSep (trimLSep, sepBranch, trimRSep) = (forB, sepB)+ where forB = [TrimR | trimRFor]+ ++ bodyBranch+ ++ [TrimL | trimLSep]++ sepB = Just $ [TrimR | trimRSep]+ ++ sepBranch+ ++ [TrimL | trimLEnd]++ pure $ [TrimL | trimLFor] ++ [For e forBody sepBody] ++ [TrimR | trimREnd]+++--------------------------------------------------------------------------------+partial :: P.Parser [TemplateElement]+partial = P.try $ do+ trimLPart <- trimOpen+ void $ P.string "partial("+ e <- expr'+ void $ P.char ')'+ trimRPart <- trimClose++ pure $ [TrimL | trimLPart] ++ [Partial e] ++ [TrimR | trimRPart]+++--------------------------------------------------------------------------------+ident :: P.Parser TemplateExpr+ident = P.try $ Ident <$> key+++--------------------------------------------------------------------------------+call :: P.Parser TemplateExpr+call = P.try $ do+ f <- key+ void $ P.char '('+ P.spaces+ as <- P.sepBy expr' (P.spaces >> P.char ',' >> P.spaces)+ P.spaces+ void $ P.char ')'+ return $ Call f as+++--------------------------------------------------------------------------------+stringLiteral :: P.Parser TemplateExpr+stringLiteral = do+ void $ P.char '\"'+ str <- P.many $ do+ x <- P.noneOf "\""+ if x == '\\' then P.anyChar else return x+ void $ P.char '\"'+ return $ StringLiteral str+++--------------------------------------------------------------------------------+key :: P.Parser TemplateKey+key = TemplateKey <$> metadataKey+++--------------------------------------------------------------------------------+opt :: String -> P.Parser (Maybe (Bool, [TemplateElement], Bool))+opt clause = P.optionMaybe $ P.try $ do+ trimL <- trimOpen+ void $ P.string clause+ trimR <- trimClose+ branch <- templateElems+ pure (trimL, branch, trimR)+
+ src/Hakyll/Web/Template/Internal/Trim.hs view
@@ -0,0 +1,95 @@+--------------------------------------------------------------------------------+-- | Module for trimming whitespace from tempaltes.+module Hakyll.Web.Template.Internal.Trim+ ( trim+ ) where+++--------------------------------------------------------------------------------+import Data.Char (isSpace)+import Data.List (dropWhileEnd)+++--------------------------------------------------------------------------------+import Hakyll.Web.Template.Internal.Element+++--------------------------------------------------------------------------------+trim :: [TemplateElement] -> [TemplateElement]+trim = cleanse . canonicalize+++--------------------------------------------------------------------------------+-- | Apply the Trim nodes to the Chunks.+cleanse :: [TemplateElement] -> [TemplateElement]+cleanse = recurse cleanse . process+ where process [] = []+ process (TrimR:Chunk str:ts) = let str' = dropWhile isSpace str+ in if null str'+ then process ts+ -- Might need to TrimL.+ else process $ Chunk str':ts++ process (Chunk str:TrimL:ts) = let str' = dropWhileEnd isSpace str+ in if null str'+ then process ts+ else Chunk str':process ts++ process (t:ts) = t:process ts++--------------------------------------------------------------------------------+-- | Enforce the invariant that:+--+-- * Every 'TrimL' has a 'Chunk' to its left.+-- * Every 'TrimR' has a 'Chunk' to its right.+--+canonicalize :: [TemplateElement] -> [TemplateElement]+canonicalize = go+ where go t = let t' = redundant . swap $ dedupe t+ in if t == t' then t else go t'+++--------------------------------------------------------------------------------+-- | Remove the 'TrimR' and 'TrimL's that are no-ops.+redundant :: [TemplateElement] -> [TemplateElement]+redundant = recurse redundant . process+ where -- Remove the leading 'TrimL's.+ process (TrimL:ts) = process ts+ -- Remove trailing 'TrimR's.+ process ts = foldr trailing [] ts+ where trailing TrimR [] = []+ trailing x xs = x:xs+++--------------------------------------------------------------------------------+-- >>> swap $ [TrimR, TrimL]+-- [TrimL, TrimR]+swap :: [TemplateElement] -> [TemplateElement]+swap = recurse swap . process+ where process [] = []+ process (TrimR:TrimL:ts) = TrimL:process (TrimR:ts)+ process (t:ts) = t:process ts+++--------------------------------------------------------------------------------+-- | Remove 'TrimR' and 'TrimL' duplication.+dedupe :: [TemplateElement] -> [TemplateElement]+dedupe = recurse dedupe . process+ where process [] = []+ process (TrimR:TrimR:ts) = process (TrimR:ts)+ process (TrimL:TrimL:ts) = process (TrimL:ts)+ process (t:ts) = t:process ts+++--------------------------------------------------------------------------------+-- | @'recurse' f t@ applies f to every '[TemplateElement]' in t.+recurse :: ([TemplateElement] -> [TemplateElement])+ -> [TemplateElement]+ -> [TemplateElement]+recurse _ [] = []+recurse f (x:xs) = process x:recurse f xs+ where process y = case y of+ If e tb eb -> If e (f tb) (f <$> eb)+ For e t s -> For e (f t) (f <$> s)+ _ -> y+
tests/Hakyll/Core/Dependencies/Tests.hs view
@@ -9,8 +9,8 @@ import Data.List (delete) import qualified Data.Map as M import qualified Data.Set as S-import Test.Framework (Test, testGroup)-import Test.HUnit (Assertion, (@=?))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (Assertion, (@=?)) --------------------------------------------------------------------------------@@ -20,7 +20,7 @@ ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Core.Dependencies.Tests" $ fromAssertions "analyze" [case01, case02, case03]
tests/Hakyll/Core/Identifier/Tests.hs view
@@ -6,8 +6,8 @@ ---------------------------------------------------------------------------------import Test.Framework (Test, testGroup)-import Test.HUnit ((@=?))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit ((@=?)) --------------------------------------------------------------------------------@@ -17,7 +17,7 @@ ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Core.Identifier.Tests" $ concat [ captureTests , matchesTests@@ -25,7 +25,7 @@ ---------------------------------------------------------------------------------captureTests :: [Test]+captureTests :: [TestTree] captureTests = fromAssertions "capture" [ Just ["bar"] @=? capture "foo/**" "foo/bar" , Just ["foo/bar"] @=? capture "**" "foo/bar"@@ -46,7 +46,7 @@ ---------------------------------------------------------------------------------matchesTests :: [Test]+matchesTests :: [TestTree] matchesTests = fromAssertions "matches" [ True @=? matches (fromList ["foo.markdown"]) "foo.markdown" , False @=? matches (fromList ["foo"]) (setVersion (Just "x") "foo")
tests/Hakyll/Core/Provider/Metadata/Tests.hs view
@@ -10,13 +10,13 @@ import qualified Data.Yaml as Yaml import Hakyll.Core.Metadata import Hakyll.Core.Provider.Metadata-import Test.Framework (Test, testGroup)-import Test.HUnit (Assertion, (@=?), assertFailure)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (Assertion, assertFailure, (@=?)) import TestSuite.Util ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Core.Provider.Metadata.Tests" $ fromAssertions "page" [testPage01, testPage02]
tests/Hakyll/Core/Provider/Tests.hs view
@@ -8,14 +8,13 @@ -------------------------------------------------------------------------------- import Hakyll.Core.Metadata import Hakyll.Core.Provider-import Test.Framework (Test, testGroup)-import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit (Assertion, assert, (@=?))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (Assertion, assert, testCase, (@=?)) import TestSuite.Util ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Core.Provider.Tests" [ testCase "case01" case01 ]
tests/Hakyll/Core/Routes/Tests.hs view
@@ -11,13 +11,13 @@ import Hakyll.Core.Metadata import Hakyll.Core.Routes import System.FilePath ((</>))-import Test.Framework (Test, testGroup)-import Test.HUnit (Assertion, (@=?))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (Assertion, (@=?)) import TestSuite.Util ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Core.Routes.Tests" $ fromAssertions "runRoutes" [ testRoutes "foo.html" (setExtension "html") "foo" , testRoutes "foo.html" (setExtension ".html") "foo"
tests/Hakyll/Core/Rules/Tests.hs view
@@ -19,13 +19,13 @@ import Hakyll.Core.Rules.Internal import Hakyll.Web.Pandoc import System.FilePath ((</>))-import Test.Framework (Test, testGroup)-import Test.HUnit (Assertion, assert, (@=?))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (Assertion, assert, (@=?)) import TestSuite.Util ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Core.Rules.Tests" $ fromAssertions "runRules" [case01]
tests/Hakyll/Core/Runtime/Tests.hs view
@@ -8,8 +8,8 @@ -------------------------------------------------------------------------------- import qualified Data.ByteString as B import System.FilePath ((</>))-import Test.Framework (Test, testGroup)-import Test.HUnit (Assertion, (@?=))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (Assertion, (@?=)) --------------------------------------------------------------------------------@@ -20,7 +20,7 @@ ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Core.Runtime.Tests" $ fromAssertions "run" [case01, case02] @@ -41,6 +41,15 @@ >>= saveSnapshot "raw" >>= renderPandoc + match (fromList ["partial.html", "partial-helper.html"]) $+ compile templateCompiler+ create ["partial.html.out"] $ do+ route idRoute+ compile $ do+ example <- loadSnapshotBody "example.md" "raw"+ makeItem example+ >>= loadAndApplyTemplate "partial.html" defaultContext+ create ["bodies.txt"] $ do route idRoute compile $ do@@ -59,6 +68,10 @@ bodies <- readFile $ destinationDirectory testConfiguration </> "bodies.txt" head (lines bodies) @?= "This is an example."++ partial <- readFile $ providerDirectory testConfiguration </> "partial.html.out"+ partial' <- readFile $ destinationDirectory testConfiguration </> "partial.html.out"+ partial @?= partial' cleanTestEnv
tests/Hakyll/Core/Store/Tests.hs view
@@ -6,22 +6,22 @@ ---------------------------------------------------------------------------------import Data.Typeable (typeOf)-import Test.Framework (Test, testGroup)-import Test.Framework.Providers.HUnit (testCase)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import qualified Test.HUnit as H-import qualified Test.QuickCheck as Q-import qualified Test.QuickCheck.Monadic as Q+import Data.Typeable (typeOf)+import qualified Test.QuickCheck as Q+import qualified Test.QuickCheck.Monadic as Q+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase)+import qualified Test.Tasty.HUnit as H+import Test.Tasty.QuickCheck (testProperty) ---------------------------------------------------------------------------------import qualified Hakyll.Core.Store as Store+import qualified Hakyll.Core.Store as Store import TestSuite.Util ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Core.Store.Tests" [ testProperty "simple get . set" simpleSetGet , testProperty "persistent get . set" persistentSetGet
tests/Hakyll/Core/UnixFilter/Tests.hs view
@@ -6,10 +6,10 @@ ---------------------------------------------------------------------------------import Data.List (isInfixOf)-import Test.Framework (Test, testGroup)-import Test.Framework.Providers.HUnit (testCase)-import qualified Test.HUnit as H+import Data.List (isInfixOf)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase)+import qualified Test.Tasty.HUnit as H --------------------------------------------------------------------------------@@ -21,7 +21,7 @@ ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Core.UnixFilter.Tests" [ testCase "unixFilter rev" unixFilterRev , testCase "unixFilter false" unixFilterFalse
tests/Hakyll/Core/Util/String/Tests.hs view
@@ -5,8 +5,8 @@ ---------------------------------------------------------------------------------import Test.Framework (Test, testGroup)-import Test.HUnit ((@=?))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit ((@=?)) --------------------------------------------------------------------------------@@ -15,7 +15,7 @@ ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Core.Util.String.Tests" $ concat [ fromAssertions "trim" [ "foo" @=? trim " foo\n\t "
+ tests/Hakyll/Web/CompressCss/Tests.hs view
@@ -0,0 +1,59 @@+--------------------------------------------------------------------------------+module Hakyll.Web.CompressCss.Tests+ ( tests+ ) where+++--------------------------------------------------------------------------------+import Data.Char (toUpper)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assert, (@=?))+++--------------------------------------------------------------------------------+import Hakyll.Web.CompressCss+import TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Web.CompressCss.Tests" $ concat+ [ fromAssertions "compressCss"+ [+ -- compress whitespace+ " something something " @=?+ compressCss " something \n\t\r something "+ -- do not compress whitespace in constants+ , "abc \" \t\n\r \" xyz" @=?+ compressCss "abc \" \t\n\r \" xyz"+ , "abc ' \t\n\r ' xyz" @=?+ compressCss "abc ' \t\n\r ' xyz"++ -- strip comments+ , "before after" @=? compressCss "before /* abc { } ;; \n\t\r */ after"+ -- don't strip comments inside constants+ , "before \"/* abc { } ;; \n\t\r */\" after"+ @=? compressCss "before \"/* abc { } ;; \n\t\r */\" after"++ -- compress separators+ , "}" @=? compressCss "; }"+ , "{};" @=? compressCss " { } ; "+ -- compress whitespace even after this curly brace+ , "}" @=? compressCss "; } "+ -- but do not compress separators inside of constants+ , "\" { } ; \"" @=? compressCss "\" { } ; \""+ -- don't compress separators at the start or end of constants+ , "\" }\"" @=? compressCss "\" }\""+ , "\"{ \"" @=? compressCss "\"{ \""+ -- don't get irritated by the wrong constant terminator+ , "\" ' \"" @=? compressCss "\" ' \""+ , "' \" '" @=? compressCss "' \" '"+ -- don't compress whitespace around separators in constants in the middle of a string+ , "abc '{ '" @=? compressCss "abc '{ '"+ , "abc \"{ \"" @=? compressCss "abc \"{ \""+ -- compress whitespace after colons+ , "abc:xyz" @=? compressCss "abc : xyz"+ -- compress multiple semicolons+ , ";" @=? compressCss ";;;;;;;"+ ]+ ]
tests/Hakyll/Web/Html/RelativizeUrls/Tests.hs view
@@ -6,16 +6,17 @@ ---------------------------------------------------------------------------------import Test.Framework (Test, testGroup)-import Test.HUnit ((@=?))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit ((@=?)) + -------------------------------------------------------------------------------- import Hakyll.Web.Html.RelativizeUrls import TestSuite.Util ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Web.Html.RelativizeUrls.Tests" $ fromAssertions "relativizeUrls" [ "<a href=\"../foo\">bar</a>" @=?
tests/Hakyll/Web/Html/Tests.hs view
@@ -5,9 +5,9 @@ ---------------------------------------------------------------------------------import Data.Char (toUpper)-import Test.Framework (Test, testGroup)-import Test.HUnit (assert, (@=?))+import Data.Char (toUpper)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assert, (@=?)) --------------------------------------------------------------------------------@@ -16,7 +16,7 @@ ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Web.Html.Tests" $ concat [ fromAssertions "demoteHeaders" [ "<h2>A h1 title</h2>" @=?
tests/Hakyll/Web/Pandoc/FileType/Tests.hs view
@@ -6,8 +6,8 @@ ---------------------------------------------------------------------------------import Test.Framework (Test, testGroup)-import Test.HUnit ((@=?))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit ((@=?)) --------------------------------------------------------------------------------@@ -16,7 +16,7 @@ ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Web.Pandoc.FileType.Tests" $ fromAssertions "fileType" [ Markdown @=? fileType "index.md"
tests/Hakyll/Web/Template/Context/Tests.hs view
@@ -6,22 +6,21 @@ ---------------------------------------------------------------------------------import Test.Framework (Test, testGroup)-import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit (Assertion, (@=?))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (Assertion, testCase, (@=?)) -------------------------------------------------------------------------------- import Hakyll.Core.Compiler import Hakyll.Core.Identifier import Hakyll.Core.Provider-import Hakyll.Core.Store (Store)+import Hakyll.Core.Store (Store) import Hakyll.Web.Template.Context import TestSuite.Util ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Core.Template.Context.Tests" [ testCase "testDateField" testDateField ]
tests/Hakyll/Web/Template/Tests.hs view
@@ -6,14 +6,14 @@ ---------------------------------------------------------------------------------import Data.Monoid (mconcat)-import Test.Framework (Test, testGroup)-import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit (Assertion, (@=?), (@?=))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (Assertion, testCase, (@=?),+ (@?=)) -------------------------------------------------------------------------------- import Hakyll.Core.Compiler+import Hakyll.Core.Identifier import Hakyll.Core.Item import Hakyll.Core.Provider import Hakyll.Web.Pandoc@@ -25,34 +25,69 @@ ---------------------------------------------------------------------------------tests :: Test+tests :: TestTree tests = testGroup "Hakyll.Core.Template.Tests" $ concat- [ [ testCase "case01" case01+ [ [ testCase "case01" $ test ("template.html.out", "template.html", "example.md")+ , testCase "case02" $ test ("strip.html.out", "strip.html", "example.md") , testCase "applyJoinTemplateList" testApplyJoinTemplateList ] , fromAssertions "readTemplate"- [ Template [Chunk "Hello ", Expr (Call "guest" [])]- @=? readTemplate "Hello $guest()$"- , Template- [If (Call "a" [StringLiteral "bar"])- (Template [Chunk "foo"])- Nothing]- @=? readTemplate "$if(a(\"bar\"))$foo$endif$"+ [ [Chunk "Hello ", Expr (Call "guest" [])]+ @=? readTemplateElems "Hello $guest()$"+ , [If (Call "a" [StringLiteral "bar"]) [Chunk "foo"] Nothing]+ @=? readTemplateElems "$if(a(\"bar\"))$foo$endif$"+ -- 'If' trim check.+ , [ TrimL+ , If (Ident (TemplateKey "body"))+ [ TrimR+ , Chunk "\n"+ , Expr (Ident (TemplateKey "body"))+ , Chunk "\n"+ , TrimL+ ]+ (Just [ TrimR+ , Chunk "\n"+ , Expr (Ident (TemplateKey "body"))+ , Chunk "\n"+ , TrimL+ ])+ , TrimR+ ]+ @=? readTemplateElems "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"+ -- 'For' trim check.+ , [ TrimL+ , For (Ident (TemplateKey "authors"))+ [TrimR, Chunk "\n body \n", TrimL]+ Nothing+ , TrimR+ ]+ @=? readTemplateElems "$-for(authors)-$\n body \n$-endfor-$"+ -- 'Partial' trim check.+ , [ TrimL+ , Partial (StringLiteral "path")+ , TrimR+ ]+ @=? readTemplateElems "$-partial(\"path\")-$"+ -- 'Expr' trim check.+ , [ TrimL+ , Expr (Ident (TemplateKey "foo"))+ , TrimR+ ]+ @=? readTemplateElems "$-foo-$" ] ] ---------------------------------------------------------------------------------case01 :: Assertion-case01 = do+test :: (Identifier, Identifier, Identifier) -> Assertion+test (outf, tplf, itemf) = do store <- newTestStore provider <- newTestProvider store - out <- resourceString provider "template.html.out"- tpl <- testCompilerDone store provider "template.html" $- templateBodyCompiler- item <- testCompilerDone store provider "example.md" $+ out <- resourceString provider outf+ tpl <- testCompilerDone store provider tplf templateBodyCompiler+ item <- testCompilerDone store provider itemf $ pandocCompiler >>= applyTemplate (itemBody tpl) testContext out @=? itemBody item@@ -69,7 +104,6 @@ return [n1, n2] , functionField "rev" $ \args _ -> return $ unwords $ map reverse args ]- where --------------------------------------------------------------------------------@@ -85,4 +119,4 @@ where i1 = Item "item1" "Hello" i2 = Item "item2" "World"- tpl = Template [Chunk "<b>", Expr (Ident "body"), Chunk "</b>"]+ tpl = readTemplate "<b>$body$</b>"
tests/TestSuite.hs view
@@ -5,7 +5,7 @@ ---------------------------------------------------------------------------------import Test.Framework (defaultMain)+import Test.Tasty (defaultMain, testGroup) --------------------------------------------------------------------------------@@ -19,6 +19,7 @@ import qualified Hakyll.Core.Store.Tests import qualified Hakyll.Core.UnixFilter.Tests import qualified Hakyll.Core.Util.String.Tests+import qualified Hakyll.Web.CompressCss.Tests import qualified Hakyll.Web.Html.RelativizeUrls.Tests import qualified Hakyll.Web.Html.Tests import qualified Hakyll.Web.Pandoc.FileType.Tests@@ -28,7 +29,7 @@ -------------------------------------------------------------------------------- main :: IO ()-main = defaultMain+main = defaultMain $ testGroup "Hakyll" [ Hakyll.Core.Dependencies.Tests.tests , Hakyll.Core.Identifier.Tests.tests , Hakyll.Core.Provider.Metadata.Tests.tests@@ -39,6 +40,7 @@ , Hakyll.Core.Store.Tests.tests , Hakyll.Core.UnixFilter.Tests.tests , Hakyll.Core.Util.String.Tests.tests+ , Hakyll.Web.CompressCss.Tests.tests , Hakyll.Web.Html.RelativizeUrls.Tests.tests , Hakyll.Web.Html.Tests.tests , Hakyll.Web.Pandoc.FileType.Tests.tests
tests/TestSuite/Util.hs view
@@ -12,30 +12,29 @@ ---------------------------------------------------------------------------------import Data.List (intercalate)-import Data.Monoid (mempty)-import qualified Data.Set as S-import Test.Framework-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)-import Text.Printf (printf)+import Data.List (intercalate)+import Data.Monoid (mempty)+import qualified Data.Set as S+import Test.Tasty+import Test.Tasty.HUnit+import Text.Printf (printf) -------------------------------------------------------------------------------- import Hakyll.Core.Compiler.Internal import Hakyll.Core.Configuration import Hakyll.Core.Identifier-import qualified Hakyll.Core.Logger as Logger+import qualified Hakyll.Core.Logger as Logger import Hakyll.Core.Provider-import Hakyll.Core.Store (Store)-import qualified Hakyll.Core.Store as Store+import Hakyll.Core.Store (Store)+import qualified Hakyll.Core.Store as Store import Hakyll.Core.Util.File -------------------------------------------------------------------------------- fromAssertions :: String -- ^ Name -> [Assertion] -- ^ Cases- -> [Test] -- ^ Result tests+ -> [TestTree] -- ^ Result tests fromAssertions name = zipWith testCase [printf "[%2d] %s" n name | n <- [1 :: Int ..]]