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