packages feed

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 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"