positiondev · emhoracek · Sep 21, 2019 · Sep 21, 2019
diff --git 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
@@ -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
@@ -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
@@ -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 "<!DOCTYPE html>" "<doctype />" t
       (X.Document _ (X.Element _ _ nodes) _) = D.parseLT ("<div>" <> textWithoutDoctype <> "</div>")
-  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,17 +242,17 @@ 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]
 
 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
@@ -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
@@ -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` "<svg:svg><path></path></svg:svg>"
 
 statefulTests :: SpecWith ()
-statefulTests =
+statefulTests = do
   describe "statefulness" $ do
       it "a fill should be able to affect subsequent fills" $ do
          renderWith (M.fromList [(["default"], parse "<x/><x/>")])
@@ -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 = "<p>missing: <missing>some stuff</missing></p>"
+        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