From f3819ed1afa924894e56bb6e7540d2e8831d554f Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Sat, 21 Sep 2019 16:00:43 -0400 Subject: [PATCH 1/2] Allow users to pass in a logging function when loading templates --- src/Web/Larceny.hs | 7 ++++--- src/Web/Larceny/Internal.hs | 39 +++++++++++++++++++------------------ src/Web/Larceny/Types.hs | 5 ++++- test/Spec.hs | 23 +++++++++++++++++----- 4 files changed, 46 insertions(+), 28 deletions(-) diff --git a/src/Web/Larceny.hs b/src/Web/Larceny.hs index 9742f4d..9267d88 100644 --- a/src/Web/Larceny.hs +++ b/src/Web/Larceny.hs @@ -54,6 +54,7 @@ module Web.Larceny ( Blank(..) , Path , Library , Overrides(..) + , Logger(..) , defaultOverrides , render , renderWith @@ -134,13 +135,13 @@ renderRelative l sub s givenPath targetPath = (_, Nothing) -> return Nothing -- | Load all the templates in some directory into a Library. -loadTemplates :: FilePath -> Overrides -> IO (Library s) -loadTemplates path overrides = +loadTemplates :: FilePath -> Overrides -> Logger -> IO (Library s) +loadTemplates path overrides logger = do tpls <- getAllTemplates path M.fromList <$> mapM (\file -> do content <- ST.readFile (path <> "/" <> file) return (mkPath file, - parseWithOverrides overrides (LT.fromStrict content))) + parseWithOverrides overrides logger (LT.fromStrict content))) tpls where mkPath p = T.splitOn "/" $ T.pack $ dropExtension p diff --git a/src/Web/Larceny/Internal.hs b/src/Web/Larceny/Internal.hs index f71cbe5..ab815e1 100644 --- a/src/Web/Larceny/Internal.hs +++ b/src/Web/Larceny/Internal.hs @@ -25,14 +25,14 @@ import Web.Larceny.Svg (svgNodes) -- | Turn lazy text into templates. parse :: LT.Text -> Template s -parse = parseWithOverrides defaultOverrides +parse = parseWithOverrides defaultOverrides (Logger $ putStrLn . T.unpack) -- | Use overrides when parsing a template. -parseWithOverrides :: Overrides -> LT.Text -> Template s -parseWithOverrides o t = +parseWithOverrides :: Overrides -> Logger -> LT.Text -> Template s +parseWithOverrides o logger t = let textWithoutDoctype = LT.replace "" "" t (X.Document _ (X.Element _ _ nodes) _) = D.parseLT ("
" <> textWithoutDoctype <> "
") - in mk o $! map (toLarcenyNode o) nodes + in mk o logger $! map (toLarcenyNode o) nodes -- | Phases of the template parsing/rendering process: 1. Parse the document -- into HTML (or really, XML) nodes 2. Turn those nodes into Larceny nodes, @@ -93,11 +93,11 @@ toLarcenyNode _ (X.NodeComment c) = NodeComment c toLarcenyNode _ (X.NodeInstruction _) = NodeContent "" -- | Turn HTML nodes and overrides into templates. -mk :: Overrides -> [Node] -> Template s -mk o = f +mk :: Overrides -> Logger -> [Node] -> Template s +mk o logger = f where f nodes = Template $ \pth m l -> - let pc = ProcessContext pth m l o f nodes in + let pc = ProcessContext pth m l o logger f nodes in do s <- get T.concat <$> toUserState (pc s) (process nodes) @@ -113,21 +113,22 @@ toUserState pc f = do s <- get liftIO $ evalStateT f (pc { _pcState = s }) -fillIn :: Blank -> Substitutions s -> Fill s -fillIn tn m = fromMaybe (fallbackFill tn m) (M.lookup tn m) +fillIn :: Blank -> Substitutions s -> Logger -> Fill s +fillIn tn m logger = fromMaybe (fallbackFill tn m logger) (M.lookup tn m) -fallbackFill :: Blank -> Substitutions s -> Fill s -fallbackFill FallbackBlank m = fromMaybe (textFill "") (M.lookup FallbackBlank m) -fallbackFill (Blank tn) m = +fallbackFill :: Blank -> Substitutions s -> Logger -> Fill s +fallbackFill FallbackBlank m _ = fromMaybe (textFill "") (M.lookup FallbackBlank m) +fallbackFill (Blank tn) m (Logger logger) = let fallback = fromMaybe (textFill "") (M.lookup FallbackBlank m) in Fill $ \attr (pth, tpl) lib -> - do liftIO $ putStrLn ("Larceny: Missing fill for blank " <> show tn <> " in template " <> show pth) + do liftIO $ logger $ T.pack ("Larceny: Missing fill for blank " <> show tn <> " in template " <> show pth) unFill fallback attr (pth, tpl) lib data ProcessContext s = ProcessContext { _pcPath :: Path , _pcSubs :: Substitutions s , _pcLib :: Library s , _pcOverrides :: Overrides + , _pcLogger :: Logger , _pcMk :: [Node] -> Template s , _pcNodes :: [Node] , _pcState :: s } @@ -227,10 +228,10 @@ fillAttrs attrs = M.fromList <$> mapM fill (M.toList attrs) fillAttr :: Either Text Blank -> StateT (ProcessContext s) IO Text fillAttr eBlankText = - do (ProcessContext pth m l _ mko _ _) <- get + do (ProcessContext pth m l _ logger mko _ _) <- get toProcessState $ case eBlankText of - Right hole -> unFill (fillIn hole m) mempty (pth, mko []) l + Right hole -> unFill (fillIn hole m logger) mempty (pth, mko []) l Left text -> return text -- Look up the Fill for the hole. Apply the Fill to a map of @@ -241,9 +242,9 @@ processBlank :: Text -> [Node] -> ProcessT s processBlank tagName atr kids = do - (ProcessContext pth m l _ mko _ _) <- get + (ProcessContext pth m l _ logger mko _ _) <- get filled <- fillAttrs atr - sequence [ toProcessState $ unFill (fillIn (Blank tagName) m) + sequence [ toProcessState $ unFill (fillIn (Blank tagName) m logger) filled (pth, add m (mko kids)) l] @@ -251,7 +252,7 @@ processBind :: Attributes -> [Node] -> ProcessT s processBind atr kids = do - (ProcessContext pth m l _ mko nodes _) <- get + (ProcessContext pth m l _ _ mko nodes _) <- get let tagName = atr M.! "tag" newSubs = subs [(tagName, Fill $ \_a _t _l -> runTemplate (mko kids) pth m l)] @@ -266,7 +267,7 @@ processApply :: Attributes -> [Node] -> ProcessT s processApply atr kids = do - (ProcessContext pth m l _ mko _ _) <- get + (ProcessContext pth m l _ _ mko _ _) <- get filledAttrs <- fillAttrs atr let (absolutePath, tplToApply) = findTemplateFromAttrs pth l filledAttrs contentTpl <- toProcessState $ runTemplate (mko kids) pth m l diff --git a/src/Web/Larceny/Types.hs b/src/Web/Larceny/Types.hs index 4fb1ad7..557676c 100644 --- a/src/Web/Larceny/Types.hs +++ b/src/Web/Larceny/Types.hs @@ -14,7 +14,8 @@ module Web.Larceny.Types ( Blank(..) , defaultOverrides , FromAttribute(..) , AttrError(..) - , ApplyError(..)) where + , ApplyError(..) + , Logger(..)) where import Control.Exception import Control.Monad.State (StateT) @@ -25,6 +26,8 @@ import Data.Text (Text) import qualified Data.Text as T import Text.Read (readMaybe) +newtype Logger = Logger { log :: Text -> IO () } + -- | Corresponds to a "blank" in the template that can be filled in -- with some value when the template is rendered. Blanks can be tags -- or they can be all or parts of attribute values in tags. diff --git a/test/Spec.hs b/test/Spec.hs index 94eae1e..09fe70c 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -35,7 +35,8 @@ data LarcenyState = LarcenyState { _lPath :: [Text] , _lSubs :: Substitutions () , _lLib :: Library () - , _lOverrides :: Overrides } + , _lOverrides :: Overrides + , _lLogger :: Logger } lPath :: Lens' LarcenyState [Text] lPath = lens _lPath (\ls p -> ls { _lPath = p }) @@ -45,6 +46,8 @@ lLib :: Lens' LarcenyState (Library ()) lLib = lens _lLib (\ls l -> ls { _lLib = l }) lOverrides :: Lens' LarcenyState Overrides lOverrides = lens _lOverrides (\ls o -> ls { _lOverrides = o }) +lLogger :: Lens' LarcenyState Logger +lLogger = lens _lLogger (\ls l -> ls { _lLogger = l }) type LarcenyHspecM = StateT LarcenyHspecState IO @@ -71,7 +74,7 @@ withLarceny :: SpecWith LarcenyHspecState -> Spec withLarceny spec' = let larcenyHspecState = - LarcenyHspecState (H.Result "" H.Success) (LarcenyState ["default"] mempty mempty mempty) in + LarcenyHspecState (H.Result "" H.Success) (LarcenyState ["default"] mempty mempty mempty (Logger (\str -> return ()))) in afterAll return $ before (return larcenyHspecState) spec' @@ -114,8 +117,8 @@ removeSpaces = T.replace " " "" renderM :: Text -> LarcenyHspecM Text renderM templateText = do - (LarcenyHspecState _ (LarcenyState p s l o)) <- S.get - let tpl = parseWithOverrides o (LT.fromStrict templateText) + (LarcenyHspecState _ (LarcenyState p s l o lo)) <- S.get + let tpl = parseWithOverrides o lo (LT.fromStrict templateText) liftIO $ evalStateT (runTemplate tpl p s l) () shouldRenderM :: Text -> Text -> LarcenyHspecM () @@ -449,7 +452,7 @@ namespaceTests = `shouldRenderM` "" statefulTests :: SpecWith () -statefulTests = +statefulTests = do describe "statefulness" $ do it "a fill should be able to affect subsequent fills" $ do renderWith (M.fromList [(["default"], parse "")]) @@ -478,6 +481,16 @@ statefulTests = 0 ["default"] `shouldReturn` Just "12" + describe "logging" $ do + it "should log the missing blank" $ do + mv <- newEmptyMVar + let logger = Logger (\str -> putMVar mv str) + let tpl = "

missing: some stuff

" + renderWith (M.fromList [(["default"], parseWithOverrides mempty logger tpl)]) + (mempty) + () + ["default"] + takeMVar mv `shouldReturn` "Larceny: Missing fill for blank \"missing\" in template [\"default\"]" doctypeTests :: SpecWith LarcenyHspecState doctypeTests = do From 7818b566e69bcba6d1b2db44f9667ed8db73309f Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Sat, 21 Sep 2019 16:03:14 -0400 Subject: [PATCH 2/2] Update CHANGELOG and version --- CHANGELOG.md | 6 ++++++ larceny.cabal | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d803743..5f820a2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog +## 2019-09-21 + * Remove dependency on fork of xml + * Allow users to pass in a logging function + +## Changelog bankruptcy + ## 2017-9-20 * Add `ifFill`, which allows you to make conditional fills. * Fix doctype bug -- HTML5 doctype is replaced after tagstream strips it out. diff --git a/larceny.cabal b/larceny.cabal index 80e9b37..8dc54f2 100644 --- a/larceny.cabal +++ b/larceny.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: larceny -version: 0.3.2 +version: 0.4.0 -- synopsis: -- description: homepage: http://www.github.com/positiondev/larceny