hakyllbars 1.0.0.0 → 1.0.0.1
raw patch · 11 files changed
+97/−164 lines, 11 filesdep −containersdep ~hspecdep ~mtlPVP ok
version bump matches the API change (PVP)
Dependencies removed: containers
Dependency ranges changed: hspec, mtl
API changes (from Hackage documentation)
Files
- hakyllbars.cabal +3/−10
- src/Hakyllbars/Field.hs +35/−1
- src/Hakyllbars/Field/Date.hs +28/−2
- src/Hakyllbars/Field/Git.hs +27/−3
- src/Hakyllbars/Field/Html.hs +2/−0
- src/Hakyllbars/Pandoc.hs +2/−0
- test/Hakyllbars/TestSupport.hs +0/−8
- test/Hakyllbars/TestSupport/Compiler.hs +0/−46
- test/Hakyllbars/TestSupport/Config.hs +0/−12
- test/Hakyllbars/TestSupport/Resource.hs +0/−16
- test/Hakyllbars/TestSupport/TestEnv.hs +0/−66
hakyllbars.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hakyllbars-version: 1.0.0.0+version: 1.0.0.1 synopsis: A Hakyll compiler for Handlebars-like templates description: Hakyllbars brings a handlebars-like template syntax to Hakyll. Please see the README at <https://github.com/keywordsalad/hakyllbars#readme>@@ -100,7 +100,7 @@ , directory >=1.3.6 && <1.4 , filepath >=1.4.2 && <1.5 , hakyll >=4.16.1 && <4.17- , mtl >=2.2.2 && <2.3+ , mtl >=2.2.2 && <3 , network-uri >=2.6.4 && <2.7 , pandoc >=3.0.1 && <3.2 , parsec >=3.1.15 && <3.2@@ -181,10 +181,6 @@ Hakyllbars.Source.ParserSpec Hakyllbars.Source.TestSupport Hakyllbars.TestSupport- Hakyllbars.TestSupport.Compiler- Hakyllbars.TestSupport.Config- Hakyllbars.TestSupport.Resource- Hakyllbars.TestSupport.TestEnv Paths_hakyllbars hs-source-dirs: test@@ -234,10 +230,7 @@ ghc-options: -fprint-potential-instances -Wall -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-packages -Wunused-type-patterns -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.14 && <5- , containers >=0.6.7 && <0.7- , hakyll >=4.16.1 && <4.17 , hakyllbars- , hspec >=2.10.10 && <2.11+ , hspec >=2.10.10 && <3 , parsec >=3.1.15 && <3.2- , time >=1.12.2 && <1.13 default-language: Haskell2010
src/Hakyllbars/Field.hs view
@@ -45,6 +45,7 @@ import Hakyllbars.Util (stripSuffix) import System.FilePath +-- | The default recommended fields to use for your website templates. defaultFields :: String -> String -> Context String defaultFields host siteRoot = mconcat@@ -78,12 +79,15 @@ constField "description" ("" :: String) ] +-- | An empty string context value. emptyString :: ContextValue a emptyString = intoValue ("" :: String) +-- | A context with the given keys and empty string values. defaultKeys :: [String] -> Context a defaultKeys keys = intoContext $ (,"" :: String) <$> keys +-- | Sets a scope in which the given fields are active in the context. withField :: String -> Context String withField key = functionField2 key f where@@ -91,6 +95,7 @@ tplWithContext context do reduceBlocks blocks +-- | Includes the given file in the template. includeField :: String -> Maybe FilePath -> Maybe FilePath -> Context String includeField key basePath extension = functionField key f where@@ -102,6 +107,7 @@ applyTemplate (fromFilePath filePath'') itemValue context <$> tplPopItem +-- | Sets a layout to interpolate the template into. layoutField :: String -> FilePath -> Maybe FilePath -> Context String layoutField key basePath extension = functionField2 key f where@@ -114,12 +120,15 @@ tplWithItem item do reduceBlocks bs +-- | Conditionally renders a block. ifField :: forall a. String -> Context a ifField key = functionField key isTruthy +-- | Context field for iterating over a list of items. forField :: String -> Context String forField key = functionField2 key applyForLoop +-- | Iterates over a list of items, applying their context to the given block. applyForLoop :: ContextValue String -> [Block] -> TemplateRunner String (Maybe String) applyForLoop items blocks = getAsItems items@@ -134,9 +143,11 @@ tplWithItem item do reduceBlocks blocks +-- | Gets a context value as a list of items. getAsItems :: ContextValue String -> TemplateRunner String (Context String, [Item String]) getAsItems = fromValue +-- | Gets a context value as a list of strings. getAsStrings :: ContextValue String -> TemplateRunner String (Context String, [Item String]) getAsStrings x = do bodies <- fromValue x :: TemplateRunner String [String]@@ -157,6 +168,7 @@ StringValue k -> return k _ -> tplFail "forEach: key must be a string or identifier" +-- | Gets a default context value if none is provided. defaultField :: forall a. String -> Context a defaultField key = functionField2 key f where@@ -165,6 +177,7 @@ True -> arg False -> default' +-- | Creates a link with the title to the given item. linkedTitleField :: String -> String -> String -> Context String linkedTitleField key titleKey urlKey = constField key f where@@ -194,9 +207,11 @@ (return . intoValue) (KeyMap.lookup (Key.fromString key) m) +-- | The body of the current item. bodyField :: String -> Context String bodyField key = field key $ return . itemBody +-- | The absolute url to the site root. siteUrlField :: String -> String -> String -> Context a siteUrlField key hostKey siteRootKey = field key f where@@ -206,16 +221,19 @@ siteRoot <- fromValue =<< unContext context siteRootKey return (host ++ siteRoot :: String) +-- | The url path to the given item. urlField :: String -> String -> Context a urlField key siteRootKey = field key f where f = getUri key siteRootKey . itemIdentifier +-- | Gets the url path to the given item file path. getUrlField :: String -> String -> Context a getUrlField key siteRootKey = functionField key f where f = getUri key siteRootKey . fromFilePath +-- | Gets the uri to the given item identifier. getUri :: String -> String -> Identifier -> TemplateRunner a String getUri key siteRootKey id' = do siteRoot <-@@ -231,6 +249,7 @@ let uri = stripSuffix "index.html" definitelyRoute return if null uri then siteRoot else siteRoot ++ uri +-- | Gets the absolute url to the current item. absUrlField :: String -> String -> String -> Context a absUrlField key hostKey urlKey = field key f where@@ -240,6 +259,7 @@ url <- fromValue =<< unContext context urlKey return (host ++ url :: String) +-- | Gets the absolute url to the given item file path. getAbsUrlField :: forall a. String -> String -> String -> Context a getAbsUrlField key hostKey getUrlKey = functionField key f where@@ -250,14 +270,20 @@ url <- getUrl (intoValue filePath :: ContextValue a) return (host ++ url :: String) +-- | Gets the destination path to the current item. pathField :: String -> Context a pathField key = field key $ return . toFilePath . itemIdentifier +-- | Gets the title of the current item from the file name. titleFromFileField :: String -> Context a titleFromFileField = bindField titleFromPath . pathField where titleFromPath = return . takeBaseName +-- | Extracts the teaser from the current item.+--+-- The teaser is noted in the item body with the HTML comment `<!--more-->`. All+-- content preceding this comment is considered the teaser. teaserField :: String -> Snapshot -> Context String teaserField key snapshot = field key f where@@ -273,7 +299,13 @@ | otherwise = go (x : acc) xs go _ [] = Nothing -metadataPriorityField :: String -> [String] -> Context a+-- | Gets the value of the first metadata key that exists.+metadataPriorityField ::+ -- | The context key.+ String ->+ -- | The list of metadata keys to try in order of priority.+ [String] ->+ Context a metadataPriorityField key priorityKeys = field key f where f item =@@ -296,12 +328,14 @@ current <- tplGet name `catchError` \_ -> return [] tplPut $ constField name (value : current) +-- | Puts a block of content into the context by a given name. putBlockField :: String -> Context a putBlockField key = functionField2 key f where f (name :: String) (blocks :: [Block]) = do tplPut $ constField name blocks +-- | Adds a block of content to the given context collection identified by a name. addBlockField :: String -> Context a addBlockField key = functionField2 key f where
src/Hakyllbars/Field/Date.hs view
@@ -24,15 +24,23 @@ import Hakyllbars.Util data DateConfig = DateConfig- { dateConfigLocale :: TimeLocale,+ { -- | The locale to use for date formatting.+ dateConfigLocale :: TimeLocale,+ -- | The current time (or time at which the site generator is running). dateConfigCurrentTime :: ZonedTime,+ -- | The format to use for long dates (i.e. date with time). dateConfigDateLongFormat :: String,+ -- | The format to use for short dates (i.e. date without time). dateConfigDateShortFormat :: String,+ -- | The format to use for time only. dateConfigTimeFormat :: String,+ -- | The format to use for machine-readable dates. dateConfigRobotDateFormat :: String,+ -- | The format to use for machine-readable times. dateConfigRobotTimeFormat :: String } +-- | Creates a default date configuration with the given locale and current time. defaultDateConfigWith :: TimeLocale -> ZonedTime -> DateConfig defaultDateConfigWith locale currentTime = DateConfig@@ -45,6 +53,7 @@ dateConfigRobotTimeFormat = "%Y-%m-%dT%H:%M:%S%Ez" } +-- | Creates a default date fields configuration with the given date config. dateFields :: DateConfig -> Context a dateFields config = mconcat@@ -62,6 +71,7 @@ dateFormatField "dateAs" (dateConfigLocale config) ] +-- | Gets a date formatted with the given format. dateFormatField :: String -> TimeLocale -> Context a dateFormatField key timeLocale = functionField2 key f where@@ -70,6 +80,7 @@ return $ formatTime timeLocale dateFormat date deserializeTime = parseTimeM' timeLocale normalizedDateTimeFormat +-- | Gets the date relative to the configured time locale and current time from the "date" or "published" fields. dateField :: String -> TimeLocale -> ZonedTime -> Context a dateField key timeLocale currentTime = field key f where@@ -81,6 +92,7 @@ maybe (dateFromFilePath timeLocale item) return maybeDateString <|> return (formatTime timeLocale "%Y-%m-%dT%H:%M:%S%Ez" currentTime) +-- | Gets the published date of an item from the metadata fields "published" or "date". publishedField :: String -> TimeLocale -> Context a publishedField key timeLocale = field key f where@@ -93,6 +105,7 @@ . maybe (noResult $ "Tried published field " ++ show key) return . dateFromMetadata timeLocale ["published", "date"] +-- | Gets the updated date of an item from the metadata fields "updated", "published", or "date". updatedField :: String -> TimeLocale -> Context a updatedField key timeLocale = field key f where@@ -105,6 +118,8 @@ . maybe (noResult $ "Tried updated field " ++ show key) return . dateFromMetadata timeLocale ["updated", "published", "date"] +-- | Gets the last modified date of an item from the metadata fields "updated", "published", or "date", or the file path+-- if it contains a date. getLastModifiedDate :: TimeLocale -> Item a -> Compiler ZonedTime getLastModifiedDate timeLocale item = do metadata <- getMetadata $ itemIdentifier item@@ -112,7 +127,14 @@ dateString <- maybe (dateFromFilePath timeLocale item) return maybeDateString parseTimeM' timeLocale "%Y-%m-%dT%H:%M:%S%Ez" dateString -dateFromMetadata :: TimeLocale -> [String] -> Metadata -> Maybe String+-- | Gets a date from the given metadata fields.+dateFromMetadata ::+ -- | The time locale to use.+ TimeLocale ->+ -- | The list of metadata keys to search for.+ [String] ->+ Metadata ->+ Maybe String dateFromMetadata timeLocale sourceKeys metadata = firstAlt $ findDate <$> sourceKeys where@@ -123,6 +145,7 @@ return $ normalizedTime timeLocale date parse = flip $ parseTimeM True timeLocale +-- | Gets a date from the item's file path. dateFromFilePath :: TimeLocale -> Item a -> Compiler String dateFromFilePath timeLocale item = dateFromPath@@ -152,6 +175,7 @@ rfc822DateFormat :: String rfc822DateFormat = "%a, %d %b %Y %H:%M:%S %Z" +-- | Supported date formats to read from metadata. metadataDateFormats :: [String] metadataDateFormats = [ "%Y-%m-%d",@@ -172,6 +196,7 @@ "%b %d, %Y" ] +-- | Gets whether the item is published. isPublishedField :: String -> Context a isPublishedField key = field key f where@@ -180,6 +205,7 @@ <&> isJust . KeyMap.lookup (Key.fromString "published") +-- | Gets whether the item has been updated. isUpdatedField :: String -> Context a isUpdatedField key = field key f where
src/Hakyllbars/Field/Git.hs view
@@ -17,7 +17,13 @@ import System.Exit import System.Process -gitFields :: String -> String -> Context a+-- | The Git fields configuration.+gitFields ::+ -- | The configured hakyll provider directory.+ String ->+ -- | The base url to the online git repository for browsing.+ String ->+ Context a gitFields providerDirectory gitWebUrl = mconcat [ constField "gitWebUrl" gitWebUrl,@@ -30,14 +36,17 @@ gitFileField providerDirectory "isChanged" gitFileIsChanged ] +-- | Gets the git-sha1 hash of the current item. gitSha1Compiler :: String -> Item a -> TemplateRunner a String gitSha1Compiler = gitLogField "%h" +-- | Gets the git commit message of the current item. gitMessageCompiler :: String -> Item a -> TemplateRunner a String gitMessageCompiler = gitLogField "%s" type LogFormat = String +-- | Extracts a latest git log field from the current item. gitLogField :: LogFormat -> String -> Item a -> TemplateRunner a String gitLogField format providerDirectory item = lift $ unsafeCompiler do@@ -57,10 +66,25 @@ get = GitFile <$> get <*> get <*> get put (GitFile x y z) = put x >> put y >> put z -gitFileField :: (IntoValue v a) => String -> String -> (GitFile -> v) -> Context a+-- | gets a given field from the git file.+gitFileField ::+ (IntoValue v a) =>+ -- | The hakyll provider directory.+ String ->+ -- | The field name.+ String ->+ -- | The getter for the git file field.+ (GitFile -> v) ->+ Context a gitFileField providerDirectory key f = field key $ fmap f . gitFileCompiler providerDirectory -gitFileCompiler :: String -> Item a -> TemplateRunner a GitFile+-- | Compiles the git file for the given item.+gitFileCompiler ::+ -- | The hakyll provider directory.+ String ->+ -- | The item to compile.+ Item a ->+ TemplateRunner a GitFile gitFileCompiler providerDirectory item = lift $ GitFile gitFilePath
src/Hakyllbars/Field/Html.hs view
@@ -8,11 +8,13 @@ import Hakyllbars.Context import Network.URI (escapeURIString, isUnescapedInURI) +-- | Escapes HTML before interpolating in a template. escapeHtmlField :: Context String escapeHtmlField = functionField "escapeHtml" f where f = return . escapeHtml +-- | Escapes HTML URI before interpolating in a template. escapeHtmlUriField :: Context String escapeHtmlUriField = functionField "escapeHtmlUri" f where
src/Hakyllbars/Pandoc.hs view
@@ -4,9 +4,11 @@ import System.FilePath import Text.Pandoc +-- | Compiles an item using the pandoc renderer with the default options if it isn't already HTML. pandocCompiler :: Item String -> Compiler (Item String) pandocCompiler = pandocCompilerWith defaultHakyllReaderOptions defaultHakyllWriterOptions +-- | Compiles an item using the pandoc renderer with the given options if it isn't already HTML. pandocCompilerWith :: ReaderOptions -> WriterOptions -> Item String -> Compiler (Item String) pandocCompilerWith readerOpts writerOpts item@(Item id' _) = do let ext = takeExtension $ toFilePath id'
test/Hakyllbars/TestSupport.hs view
@@ -1,16 +1,8 @@ module Hakyllbars.TestSupport ( module Hakyllbars.Common,- module Hakyllbars.TestSupport.Compiler,- module Hakyllbars.TestSupport.Config,- module Hakyllbars.TestSupport.Resource,- module Hakyllbars.TestSupport.TestEnv, module Test.Hspec, ) where import Hakyllbars.Common-import Hakyllbars.TestSupport.Compiler-import Hakyllbars.TestSupport.Config-import Hakyllbars.TestSupport.Resource-import Hakyllbars.TestSupport.TestEnv import Test.Hspec
− test/Hakyllbars/TestSupport/Compiler.hs
@@ -1,46 +0,0 @@-module Hakyllbars.TestSupport.Compiler where--import Data.Set as S-import Hakyll as H-import Hakyll.Core.Compiler.Internal-import qualified Hakyll.Core.Logger as Logger-import Hakyllbars.TestSupport.TestEnv-import Test.Hspec--type RunCompiler a = Compiler a -> Identifier -> IO (CompilerResult a)--runCompilerSpec :: TestEnv -> (RunCompiler a -> IO b) -> IO b-runCompilerSpec testEnv f = do- let run compiler identifier = do- logger <- Logger.new Logger.Debug- let compilerRead =- CompilerRead- { compilerConfig = testHakyllConfig testEnv,- compilerUnderlying = identifier,- compilerProvider = testProvider testEnv,- compilerUniverse = S.empty,- compilerRoutes = mempty,- compilerStore = testStore testEnv,- compilerLogger = logger- }- result <- runCompiler compiler compilerRead- Logger.flush logger- return result- f run--shouldProduce :: (Eq a, Show a) => CompilerResult (Item a) -> a -> Expectation-shouldProduce (CompilerDone item _) expected =- itemBody item `shouldBe` expected-shouldProduce (CompilerSnapshot snapshot _) _ =- expectationFailure $ "Compiler did not complete, received snapshot " ++ snapshot-shouldProduce (CompilerRequire dependencies _) _ =- expectationFailure $ "Compiler did not complete, produced dependencies on " ++ show dependencies-shouldProduce (CompilerError errors) _ = expectationFailure message- where- message = case errors of- CompilationFailure exceptions -> "Compiler failed with exceptions: " ++ show exceptions- CompilationNoResult [] -> "Compiler produced no result"- CompilationNoResult exceptions -> "Compiler produced no result with exceptions: " ++ show exceptions--compileBody :: (Item String -> Compiler (Item String)) -> Compiler (Item String)-compileBody compiler = getResourceBody >>= compiler
− test/Hakyllbars/TestSupport/Config.hs
@@ -1,12 +0,0 @@-module Hakyllbars.TestSupport.Config where--import Hakyll (Configuration (..), defaultConfiguration)--defaultHakyllConfig :: Configuration-defaultHakyllConfig =- defaultConfiguration- { destinationDirectory = "_test/site",- storeDirectory = "_test/store",- tmpDirectory = "_test/tmp",- providerDirectory = "test/data"- }
− test/Hakyllbars/TestSupport/Resource.hs
@@ -1,16 +0,0 @@-module Hakyllbars.TestSupport.Resource where---- | Creates a spec resource dependent on a bracketed resource and runs the spec with it------ Example Usage:--- >>> around (withBracketedResource `providing` thisComponent) do--- >>> describe "this thing" do-providing ::- -- | The factory providing the bracketed resource- ((a -> m c) -> m c) ->- -- | The factory providing the spec resource dependent on the bracketed resource- (a -> (b -> m c) -> m c) ->- -- | The spec requiring the dependent resource- (b -> m c) ->- m c-providing withResource thingForSpec theSpec = withResource (`thingForSpec` theSpec)
− test/Hakyllbars/TestSupport/TestEnv.hs
@@ -1,66 +0,0 @@-module Hakyllbars.TestSupport.TestEnv where--import Data.Foldable-import Data.Time-import Hakyll (Configuration (..), removeDirectory)-import qualified Hakyll.Core.Provider as HP-import qualified Hakyll.Core.Store as HS-import Hakyllbars.Common-import Hakyllbars.Field.Date-import Hakyllbars.TestSupport.Config--data TestEnv = TestEnv- { testTime :: ZonedTime,- testHakyllConfig :: Configuration,- testStore :: HS.Store,- testProvider :: HP.Provider,- testDateConfig :: DateConfig- }--newStoreAndProvider :: Configuration -> IO (HS.Store, HP.Provider)-newStoreAndProvider hakyllConfig = do- store <- newStore- provider <- newProvider store- return (store, provider)- where- newStore = HS.new True (storeDirectory hakyllConfig)- newProvider store = HP.newProvider store (const (return False)) (providerDirectory hakyllConfig)--createTestEnv :: Configuration -> IO TestEnv-createTestEnv hakyllConfig = do- time <- defaultTestTime- (store, provider) <- newStoreAndProvider hakyllConfig- return- TestEnv- { testTime = time,- testHakyllConfig = hakyllConfig,- testStore = store,- testProvider = provider,- testDateConfig = defaultDateConfigWith defaultTimeLocale time- }--cleanTestEnv :: TestEnv -> IO ()-cleanTestEnv testEnv =- let hakyllConfig = testHakyllConfig testEnv- in traverse_ (removeDirectory . ($ hakyllConfig)) cleanDirectories- where- cleanDirectories =- [ destinationDirectory,- storeDirectory,- tmpDirectory- ]--withTestEnv :: Configuration -> (TestEnv -> IO a) -> IO a-withTestEnv hakyllConfig = bracket (createTestEnv hakyllConfig) cleanTestEnv--withDefaultTestEnv :: (TestEnv -> IO a) -> IO a-withDefaultTestEnv = withTestEnv defaultHakyllConfig--defaultTestTimeString :: String-defaultTestTimeString = "2023-06-16T21:12:00-07:00"--defaultTestTime :: (MonadFail m) => m ZonedTime-defaultTestTime = timeFromString defaultTestTimeString--timeFromString :: (MonadFail m) => String -> m ZonedTime-timeFromString = parseTimeM True defaultTimeLocale "%FT%T%EZ"