From efa249a53b1457f86cd93d4d097f094617f0e77b Mon Sep 17 00:00:00 2001 From: tkachenko Date: Thu, 26 Oct 2017 16:22:37 +0300 Subject: [PATCH 1/6] Simple test case for findTemplate --- test/Text/JaTexSpec.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/test/Text/JaTexSpec.hs b/test/Text/JaTexSpec.hs index 14b32a9..6ed13a2 100644 --- a/test/Text/JaTexSpec.hs +++ b/test/Text/JaTexSpec.hs @@ -9,6 +9,8 @@ import qualified Data.Text as Text import Test.Hspec import Text.JaTex +import Text.JaTex.Template.Types +import Text.JaTex.TexWriter spec :: Spec spec = do @@ -40,3 +42,20 @@ spec = do jatsXmlToLaTeXText def {joInputDocument = doc, joTemplate = (templ, "")} output `shouldBe` "% Generated by jats2tex@0.11.1.0\nSomething\n" + it "should find template" $ do + templ <- parseTemplate "" [here|sec: "@@children"|] + trees <- + parseJATS + [here| + +

Something

+ + |] + let doc = trees !! 0 + let findTemplateResult = findTemplate templ doc + case findTemplateResult of + Nothing -> expectationFailure "got nothing" + Just (sub, ct, t) -> do + templateSelector ct `shouldBe` "sec" + templateContent ct `shouldBe` "@@children" + templateHead ct `shouldBe` "" From 5a7c4d9218f8248f21578801ec2f86ba7557e29f Mon Sep 17 00:00:00 2001 From: tkachenko Date: Thu, 26 Oct 2017 16:40:01 +0300 Subject: [PATCH 2/6] Let statements fix --- test/Text/JaTexSpec.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/Text/JaTexSpec.hs b/test/Text/JaTexSpec.hs index 6ed13a2..0eefa6f 100644 --- a/test/Text/JaTexSpec.hs +++ b/test/Text/JaTexSpec.hs @@ -52,10 +52,11 @@ spec = do |] let doc = trees !! 0 - let findTemplateResult = findTemplate templ doc + findTemplateResult = findTemplate templ doc case findTemplateResult of Nothing -> expectationFailure "got nothing" Just (sub, ct, t) -> do + templatePredicate t `shouldBe` "sec" templateSelector ct `shouldBe` "sec" templateContent ct `shouldBe` "@@children" templateHead ct `shouldBe` "" From 8b38bd3a26975b7d13c77f0bfd18c7bd75c7b449 Mon Sep 17 00:00:00 2001 From: tkachenko Date: Fri, 27 Oct 2017 17:59:22 +0300 Subject: [PATCH 3/6] Hindent --- src/Text/JaTex/TexWriter.hs | 340 +++++++++++++++++++----------------- 1 file changed, 177 insertions(+), 163 deletions(-) diff --git a/src/Text/JaTex/TexWriter.hs b/src/Text/JaTex/TexWriter.hs index 395c482..32c90ba 100644 --- a/src/Text/JaTex/TexWriter.hs +++ b/src/Text/JaTex/TexWriter.hs @@ -1,79 +1,80 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -module Text.JaTex.TexWriter - where - -import Control.Monad -import Control.Monad.Catch -import Control.Monad.Identity -import Control.Monad.IO.Class -import Control.Monad.State -import Control.Monad.Writer -import Data.Aeson (Result (..), Value (..), - fromJSON) -import Data.ByteString (ByteString) -import qualified Data.ByteString as ByteStringS -import qualified Data.ByteString.Char8 as ByteString (pack, - unpack) -import qualified Data.ByteString.Lazy.Char8 as ByteStringL -import Data.Either -import Data.FileEmbed -import qualified Data.HashMap.Strict as HashMap -import Data.Maybe -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text (decodeUtf8, - encodeUtf8) -import qualified Data.Text.IO as Text -import qualified Data.Tree.NTree.TypeDefs as HXT -import qualified Data.Yaml as Yaml -import qualified Language.Haskell.Interpreter as Hint +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} + +module Text.JaTex.TexWriter where + +import Control.Monad +import Control.Monad.Catch +import Control.Monad.IO.Class +import Control.Monad.Identity +import Control.Monad.State +import Control.Monad.Writer +import Data.Aeson (Result(..), Value(..), fromJSON) +import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteStringS +import qualified Data.ByteString.Char8 as ByteString (pack, unpack) +import qualified Data.ByteString.Lazy.Char8 as ByteStringL +import Data.Either +import Data.FileEmbed +import qualified Data.HashMap.Strict as HashMap +import Data.Maybe +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text + (decodeUtf8, encodeUtf8) +import qualified Data.Text.IO as Text +import qualified Data.Tree.NTree.TypeDefs as HXT +import qualified Data.Yaml as Yaml +import qualified Language.Haskell.Interpreter as Hint import qualified Language.Haskell.Interpreter.Unsafe as Hint -import qualified Scripting.Lua as Lua -import qualified Scripting.LuaUtils as Lua -import System.Environment -import System.Exit -import System.IO -import System.IO.Unsafe -import System.Process -import Text.JaTex.Parser -import Text.JaTex.Template.Requirements -import Text.JaTex.Template.TemplateInterp -import Text.JaTex.Template.Types -import qualified Text.JaTex.Upgrade as Upgrade -import Text.JaTex.Util -import Text.LaTeX -import Text.LaTeX.Base.Class -import Text.LaTeX.Base.Syntax -import qualified Text.Megaparsec as Megaparsec -import qualified Text.XML.HXT.Core as HXT -import qualified Text.XML.HXT.XPath as HXT +import qualified Scripting.Lua as Lua +import qualified Scripting.LuaUtils as Lua +import System.Environment +import System.Exit +import System.IO +import System.IO.Unsafe +import System.Process +import Text.JaTex.Parser +import Text.JaTex.Template.Requirements +import Text.JaTex.Template.TemplateInterp +import Text.JaTex.Template.Types +import qualified Text.JaTex.Upgrade as Upgrade +import Text.JaTex.Util +import Text.LaTeX +import Text.LaTeX.Base.Class +import Text.LaTeX.Base.Syntax +import qualified Text.Megaparsec as Megaparsec +import qualified Text.XML.HXT.Core as HXT +import qualified Text.XML.HXT.XPath as HXT + -- import Text.XML.Light -import TH.RelativePaths +import TH.RelativePaths emptyState :: TexState -emptyState = TexState { tsBodyRev = mempty - , tsHeadRev = mempty - , tsMetadata = mempty - , tsTemplate = defaultTemplate - , tsFileName = "" - , tsWarnings = True - , tsDebug = False - } +emptyState = + TexState + { tsBodyRev = mempty + , tsHeadRev = mempty + , tsMetadata = mempty + , tsTemplate = defaultTemplate + , tsFileName = "" + , tsWarnings = True + , tsDebug = False + } logWarning :: (MonadState TexState m, MonadIO m) => String -> m () logWarning w = do - TexState{tsWarnings} <- get - when tsWarnings $ liftIO (hPutStrLn stderr ("[warning] " <> w)) + TexState {tsWarnings} <- get + when tsWarnings $ liftIO (hPutStrLn stderr ("[warning] " <> w)) tsHead :: TexState -> [LaTeXT Identity ()] tsHead = reverse . tsHeadRev @@ -83,12 +84,11 @@ tsBody = reverse . tsBodyRev execTexWriter :: Monad m => TexState -> StateT TexState m b -> m b execTexWriter s e = do - (_, _, r) <- runTexWriter s e - return r + (_, _, r) <- runTexWriter s e + return r -runTexWriter - :: Monad m - => TexState -> StateT TexState m t -> m (TexState, LaTeX, t) +runTexWriter :: + Monad m => TexState -> StateT TexState m t -> m (TexState, LaTeX, t) runTexWriter st w = do (o, newState) <- runStateT w st let hCmds = tsHead newState @@ -96,9 +96,13 @@ runTexWriter st w = do (_, r) = runIdentity $ runLaTeXT (sequence_ (hCmds <> bCmds)) return (newState, r, o) -convert - :: (MonadIO m, MonadMask m) => - String -> (Template, FilePath) -> JATSDoc -> Bool -> m LaTeX +convert :: + (MonadIO m, MonadMask m) + => String + -> (Template, FilePath) + -> JATSDoc + -> Bool + -> m LaTeX convert fp tmp i w = do liftIO $ do hSetBuffering stdout LineBuffering @@ -112,13 +116,12 @@ convert fp tmp i w = do debug <- isJust <$> liftIO (lookupEnv "JATS2TEX_DEBUG") (_, !t, _) <- runTexWriter - emptyState {tsFileName = fp, tsTemplate = tmp, tsDebug = debug, tsWarnings = w} + emptyState + {tsFileName = fp, tsTemplate = tmp, tsDebug = debug, tsWarnings = w} (jatsXmlToLaTeX i) return t -jatsXmlToLaTeX - :: MonadTex m - => JATSDoc -> m () +jatsXmlToLaTeX :: MonadTex m => JATSDoc -> m () jatsXmlToLaTeX d = do add $ comment @@ -132,9 +135,7 @@ jatsXmlToLaTeX d = do add heads add bodies -convertNode - :: MonadTex m - => HXT.XmlTree -> m (LaTeXT Identity ()) +convertNode :: MonadTex m => HXT.XmlTree -> m (LaTeXT Identity ()) convertNode fullNode@(HXT.NTree node _) = case node of HXT.XTag _ _ -> do @@ -163,21 +164,17 @@ convertNode fullNode@(HXT.NTree node _) = HXT.XEntityRef _i -> return mempty addHead :: MonadState TexState m => LaTeXT Identity () -> m () -addHead m = modify (\ts -> ts { tsHeadRev = m:tsHeadRev ts - }) +addHead m = modify (\ts -> ts {tsHeadRev = m : tsHeadRev ts}) add :: MonadState TexState m => LaTeXT Identity () -> m () -add m = modify (\ts -> ts { tsBodyRev = m:tsBodyRev ts - }) +add m = modify (\ts -> ts {tsBodyRev = m : tsBodyRev ts}) addComment :: MonadState TexState m => Text -> m () addComment c = do isDebug <- tsDebug <$> get when isDebug (add (comment c)) -convertElem - :: MonadTex m - => HXT.XmlTree -> m (LaTeXT Identity ()) +convertElem :: MonadTex m => HXT.XmlTree -> m (LaTeXT Identity ()) convertElem el@(HXT.NTree (HXT.XTag name attrs) children) = do TexState {tsTemplate} <- get commentEl @@ -189,7 +186,7 @@ convertElem el@(HXT.NTree (HXT.XTag name attrs) children) = do Just (sub, _, t) -> do templateContext <- getTemplateContext -- liftIO $ print ("findTemplate", elementName el, "found subtree", sub) - rs <- forM sub $ \x -> templateApply t templateContext { tcElement = x } + rs <- forM sub $ \x -> templateApply t templateContext {tcElement = x} let h = mapM_ fst rs b = mapM_ snd rs addHead h @@ -208,19 +205,15 @@ convertElem el@(HXT.NTree (HXT.XTag name attrs) children) = do getTemplateContext = do st <- get l <- liftIO Lua.newstate - return - TemplateContext - { tcLuaState = l - , tcState = st - , tcElement = el - } + return TemplateContext {tcLuaState = l, tcState = st, tcElement = el} run = case children of [] -> return (textell mempty) _ -> do logWarning ("Ignoring tag " <> HXT.qualifiedName name) convertChildren el -convertElem e = fail $ "convertElem needs XML elements but got (" <> show e <> ")" +convertElem e = + fail $ "convertElem needs XML elements but got (" <> show e <> ")" removeSpecial :: String -> String removeSpecial = @@ -230,80 +223,86 @@ removeSpecial = then '-' else c) -convertInlineNode - :: MonadTex m - => HXT.XmlTree -> m ([LaTeXT Identity ()], [LaTeXT Identity ()]) +convertInlineNode :: + MonadTex m => HXT.XmlTree -> m ([LaTeXT Identity ()], [LaTeXT Identity ()]) convertInlineNode c = do st <- get (newState, _, _) <- runTexWriter (st {tsHeadRev = mempty, tsBodyRev = mempty}) (convertNode c) return (tsHead newState, tsBody newState) -convertInlineChildren :: MonadTex m => HXT.XmlTree -> m ([LaTeXT Identity ()], [LaTeXT Identity ()]) +convertInlineChildren :: + MonadTex m => HXT.XmlTree -> m ([LaTeXT Identity ()], [LaTeXT Identity ()]) convertInlineChildren el = do st <- get (newState, _, _) <- - runTexWriter (st {tsHeadRev = mempty, tsBodyRev = mempty}) (convertChildren el) + runTexWriter + (st {tsHeadRev = mempty, tsBodyRev = mempty}) + (convertChildren el) return (tsHead newState, tsBody newState) -convertInlineElem :: MonadTex m => HXT.XmlTree -> m ([LaTeXT Identity ()], [LaTeXT Identity ()]) +convertInlineElem :: + MonadTex m => HXT.XmlTree -> m ([LaTeXT Identity ()], [LaTeXT Identity ()]) convertInlineElem el = do st <- get - (newState, _, _) <- runTexWriter (st {tsHeadRev = mempty, tsBodyRev = mempty}) (void (convertElem el)) + (newState, _, _) <- + runTexWriter + (st {tsHeadRev = mempty, tsBodyRev = mempty}) + (void (convertElem el)) return (tsHead newState, tsBody newState) convertChildren :: MonadTex m => HXT.XmlTree -> m (LaTeXT Identity ()) convertChildren (HXT.NTree _ elContent) = mconcat <$> mapM convertNode elContent -comm2 - :: LaTeXC l - => String -> l -> l -> l +comm2 :: LaTeXC l => String -> l -> l -> l comm2 str = liftL2 $ \l1 l2 -> TeXComm str [FixArg l1, FixArg l2] -begin - :: Monad m - => Text -> LaTeXT m () -> LaTeXT m () -begin n c = between c (raw ("\\begin{" <> n <> "}")) (raw ("\\end{" <> n <> "}")) +begin :: Monad m => Text -> LaTeXT m () -> LaTeXT m () +begin n c = + between c (raw ("\\begin{" <> n <> "}")) (raw ("\\end{" <> n <> "}")) -- Template Execution - elementName (HXT.NTree (HXT.XTag n _) _) = HXT.qualifiedName n -elementName _ = "" +elementName _ = "" -templateApply - :: MonadTex m +templateApply :: + MonadTex m => TemplateNode (StateT TexState IO) -> TemplateContext -> m (LaTeXT Identity (), LaTeXT Identity ()) templateApply TemplateNode {templateLaTeX, templateLaTeXHead} tc = do - (heads, bodies) <- convertInlineChildren (tcElement tc) - hresult <- applyTemplateToEl templateLaTeXHead tc (heads, bodies) - bresult <- applyTemplateToEl templateLaTeX tc (heads, bodies) - return (hresult, bresult) + (heads, bodies) <- convertInlineChildren (tcElement tc) + hresult <- applyTemplateToEl templateLaTeXHead tc (heads, bodies) + bresult <- applyTemplateToEl templateLaTeX tc (heads, bodies) + return (hresult, bresult) runPredicate :: NodeSelector -> NodeSelector -> Bool runPredicate s t = t == s - -findTemplate :: Template -> HXT.XmlTree -> Maybe ([HXT.XmlTree], ConcreteTemplateNode, TemplateNode (StateT TexState IO)) +findTemplate :: + Template + -> HXT.XmlTree + -> Maybe ( [HXT.XmlTree] + , ConcreteTemplateNode + , TemplateNode (StateT TexState IO)) findTemplate ts e = run ts where run (Template []) = Nothing run (Template ((ct, t@TemplateNode {templatePredicate}):ps)) = let xpathR = HXT.getXPathSubTrees templatePredicate e in case xpathR of - [] -> run (Template ps) + [] -> run (Template ps) sub -> Just (sub, ct, t) elChildren :: HXT.XmlTree -> [HXT.XmlTree] elChildren (HXT.NTree _ c) = filter isElem c where isElem (HXT.NTree (HXT.XTag _ _) _) = True - isElem _ = False + isElem _ = False elAttribs :: HXT.XmlTree -> [HXT.XmlTree] elAttribs (HXT.NTree (HXT.XTag _ attrs) _) = attrs -elAttribs _ = [] +elAttribs _ = [] lookupAttr :: String -> [HXT.XmlTree] -> Maybe String lookupAttr n (a:as) = @@ -313,12 +312,12 @@ lookupAttr n (a:as) = _ -> lookupAttr n as lookupAttr _ [] = Nothing -applyTemplateToEl - :: (Monad m, MonadIO m1) => - [PreparedTemplateNode (StateT TexState IO)] - -> TemplateContext - -> ([LaTeXT Identity ()], [LaTeXT Identity ()]) - -> m1 (LaTeXT m ()) +applyTemplateToEl :: + (Monad m, MonadIO m1) + => [PreparedTemplateNode (StateT TexState IO)] + -> TemplateContext + -> ([LaTeXT Identity ()], [LaTeXT Identity ()]) + -> m1 (LaTeXT m ()) applyTemplateToEl l e (heads, bodies) = do rs <- mapM (\i -> evalNode e i (heads, bodies)) l return $ textell $ TeXRaw $ Text.concat rs @@ -330,28 +329,30 @@ evalNode e ptn (heads, bodies) = do let children = heads <> bodies case ptn of (PreparedTemplatePlain t) -> return t - (PreparedTemplateVar "heads") -> return $ render . runLaTeX . sequence_ $ heads - (PreparedTemplateVar "bodies") -> return $ render . runLaTeX . sequence_ $ bodies - (PreparedTemplateVar "children") -> return $ render . runLaTeX . sequence_ $ children - (PreparedTemplateVar "requirements") -> return $ render (runLaTeX requirements) + (PreparedTemplateVar "heads") -> + return $ render . runLaTeX . sequence_ $ heads + (PreparedTemplateVar "bodies") -> + return $ render . runLaTeX . sequence_ $ bodies + (PreparedTemplateVar "children") -> + return $ render . runLaTeX . sequence_ $ children + (PreparedTemplateVar "requirements") -> + return $ render (runLaTeX requirements) (PreparedTemplateVar _) -> return "" (PreparedTemplateLua run) -> do - (_, _, result) <- liftIO $ runTexWriter (tcState e) (run e (heads, bodies)) - return (render (runLaTeX result)) + (_, _, result) <- + liftIO $ runTexWriter (tcState e) (run e (heads, bodies)) + return (render (runLaTeX result)) (PreparedTemplateExpr runner) -> do - let runFind = mkFindChildren e - wtr = runner e children runFind - (_, _, result) <- liftIO $ runTexWriter (tcState e) wtr - return (render (runLaTeX result)) + let runFind = mkFindChildren e + wtr = runner e children runFind + (_, _, result) <- liftIO $ runTexWriter (tcState e) wtr + return (render (runLaTeX result)) where - mkFindChildren - :: MonadTex m - => TemplateContext -> Text -> m (LaTeXT Identity ()) + mkFindChildren :: + MonadTex m => TemplateContext -> Text -> m (LaTeXT Identity ()) mkFindChildren TemplateContext {tcElement} name = do inlines <- - mapM - convertInlineElem - (findChildren (Text.unpack name) tcElement) + mapM convertInlineElem (findChildren (Text.unpack name) tcElement) let heads = sequence_ (concatMap fst inlines) :: LaTeXT Identity () bodies = sequence_ (concatMap snd inlines) :: LaTeXT Identity () return (heads <> bodies) @@ -362,11 +363,11 @@ findChildren n e = HXT.getXPath n e prepareInterp :: Text -> IO (PreparedTemplate (StateT TexState IO)) prepareInterp i = case Megaparsec.parseMaybe interpParser i of - Nothing -> return [] + Nothing -> return [] Just interp -> mapM doPrepare interp where - doPrepare :: TemplateInterpNode - -> IO (PreparedTemplateNode (StateT TexState IO)) + doPrepare :: + TemplateInterpNode -> IO (PreparedTemplateNode (StateT TexState IO)) doPrepare (TemplateVar t) = return $ PreparedTemplateVar t doPrepare (TemplatePlain t) = return $ PreparedTemplatePlain t doPrepare (TemplateLua t) = return $ PreparedTemplateLua luaRunner @@ -395,14 +396,20 @@ prepareInterp i = return (raw (Text.decodeUtf8 result)) where luaChildren :: IO ByteString - luaChildren = do + luaChildren -- c <- execTexWriter tcState (sequence (heads <> bodies)) - return $ Text.encodeUtf8 $ render . runLaTeX . sequence_ $ (heads <> bodies) + = do + return $ + Text.encodeUtf8 $ + render . runLaTeX . sequence_ $ (heads <> bodies) luaAttr :: ByteString -> IO ByteString - luaAttr name = do + luaAttr name -- print name -- print (elAttribs tcElement) - return $ ByteString.pack $ fromMaybe "" $ lookupAttr sname (elAttribs tcElement) + = do + return $ + ByteString.pack $ + fromMaybe "" $ lookupAttr sname (elAttribs tcElement) where sname = Text.unpack (Text.decodeUtf8 name) luaElements :: IO [ByteString] @@ -425,7 +432,9 @@ prepareInterp i = (findChildren (ByteString.unpack name) tcElement) let heads = concatMap fst inlines bodies = concatMap snd inlines - return $ filter (/= mempty) $ map (Text.encodeUtf8 . render . runLaTeX) (heads <> bodies) + return $ + filter (/= mempty) $ + map (Text.encodeUtf8 . render . runLaTeX) (heads <> bodies) luaFindChildren :: ByteString -> IO ByteString luaFindChildren name = do inlines <- @@ -485,7 +494,9 @@ prepareInterp i = Right runner -> return runner return $ PreparedTemplateExpr runner -parseTemplateNode :: ConcreteTemplateNode -> IO (Either Text (TemplateNode (StateT TexState IO))) +parseTemplateNode :: + ConcreteTemplateNode + -> IO (Either Text (TemplateNode (StateT TexState IO))) parseTemplateNode ConcreteTemplateNode {..} = do preparedH <- liftIO $ prepareInterp templateHead preparedL <- liftIO $ prepareInterp templateContent @@ -503,15 +514,15 @@ mergeEithers (Left e:es) = Left (e : lefts es) mergeEithers (Right e:es) = case mergeEithers es of lfs@(Left _) -> lfs - (Right rs) -> Right (e : rs) + (Right rs) -> Right (e : rs) isTruthy :: Value -> Bool -isTruthy (Bool b) = b +isTruthy (Bool b) = b isTruthy (Number n) = n /= 0 isTruthy (Object o) = o /= mempty isTruthy (String s) = s /= mempty -isTruthy Null = False -isTruthy (Array _) = True +isTruthy Null = False +isTruthy (Array _) = True parseCTemplateFromJson :: Value -> Either [Text] [ConcreteTemplateNode] parseCTemplateFromJson (Object o) = @@ -520,9 +531,10 @@ parseCTemplateFromJson (Object o) = parsePair k v m = let mctn = fromJSON v :: Result ConcreteTemplateNode in case mctn of - Error e -> Left (Text.pack e) : m + Error e -> Left (Text.pack e) : m Success ctn -> Right ctn {templateSelector = k} : m -parseCTemplateFromJson _ = Left ["Template inválido, o formato esperado é `seletor: 'template'`"] +parseCTemplateFromJson _ = + Left ["Template inválido, o formato esperado é `seletor: 'template'`"] parseTemplateFile :: FilePath -> IO Template parseTemplateFile fp = parseTemplate fp =<< ByteStringS.readFile fp @@ -533,7 +545,7 @@ parseTemplate fp s = do v' <- case v of Left err -> error $ "Couldn't parse " <> (show err) - Right i -> return i + Right i -> return i case parseCTemplateFromJson v' of Left errs -> do forM_ errs $ \err -> Text.hPutStrLn stderr err @@ -550,9 +562,11 @@ defaultTemplateContents :: ByteString defaultTemplateContents = $(bsToExp =<< qReadFileBS "./default.yaml") defaultTemplate :: (Template, FilePath) -defaultTemplate = unsafePerformIO $ do +defaultTemplate = + unsafePerformIO $ do let s = defaultTemplateContents fp = "default.yaml" t <- parseTemplate fp s return (t, fp) + {-# NOINLINE defaultTemplate #-} From 82114f519a2979703e8c5b4171d6ffb7b7ac7bb9 Mon Sep 17 00:00:00 2001 From: tkachenko Date: Fri, 27 Oct 2017 22:56:10 +0300 Subject: [PATCH 4/6] Fix a test --- test/Text/JaTexSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Text/JaTexSpec.hs b/test/Text/JaTexSpec.hs index 0eefa6f..4b02f48 100644 --- a/test/Text/JaTexSpec.hs +++ b/test/Text/JaTexSpec.hs @@ -36,7 +36,7 @@ spec = do "" [here| sec: | - @@lua(return find("/p"))@@ + @@lua(return find("*/p"))@@ |] output <- jatsXmlToLaTeXText From 1617cbdb255a47d8d5479cac9ef360f2eefc81df Mon Sep 17 00:00:00 2001 From: yamadapc Date: Mon, 30 Oct 2017 09:17:12 -0200 Subject: [PATCH 5/6] Fix nested XPath handling --- src/Text/JaTex/TexWriter.hs | 46 ++++++++++++++++++++----------------- test/Text/JaTexSpec.hs | 6 +++-- 2 files changed, 29 insertions(+), 23 deletions(-) diff --git a/src/Text/JaTex/TexWriter.hs b/src/Text/JaTex/TexWriter.hs index 32c90ba..8214a8b 100644 --- a/src/Text/JaTex/TexWriter.hs +++ b/src/Text/JaTex/TexWriter.hs @@ -56,7 +56,6 @@ import qualified Text.Megaparsec as Megaparsec import qualified Text.XML.HXT.Core as HXT import qualified Text.XML.HXT.XPath as HXT --- import Text.XML.Light import TH.RelativePaths emptyState :: TexState @@ -262,6 +261,7 @@ begin n c = between c (raw ("\\begin{" <> n <> "}")) (raw ("\\end{" <> n <> "}")) -- Template Execution +elementName :: HXT.NTree HXT.XNode -> String elementName (HXT.NTree (HXT.XTag n _) _) = HXT.qualifiedName n elementName _ = "" @@ -322,9 +322,12 @@ applyTemplateToEl l e (heads, bodies) = do rs <- mapM (\i -> evalNode e i (heads, bodies)) l return $ textell $ TeXRaw $ Text.concat rs --- evalNode --- :: MonadTex m --- => TemplateContext -> PreparedTemplateNode (StateT TexState IO) -> m Text +evalNode + :: MonadIO m => + TemplateContext + -> PreparedTemplateNode (StateT TexState IO) + -> ([LaTeXT Identity ()], [LaTeXT Identity ()]) + -> m Text evalNode e ptn (heads, bodies) = do let children = heads <> bodies case ptn of @@ -353,12 +356,13 @@ evalNode e ptn (heads, bodies) = do mkFindChildren TemplateContext {tcElement} name = do inlines <- mapM convertInlineElem (findChildren (Text.unpack name) tcElement) - let heads = sequence_ (concatMap fst inlines) :: LaTeXT Identity () - bodies = sequence_ (concatMap snd inlines) :: LaTeXT Identity () - return (heads <> bodies) + let cHeads = sequence_ (concatMap fst inlines) :: LaTeXT Identity () + cBodies = sequence_ (concatMap snd inlines) :: LaTeXT Identity () + return (cHeads <> cBodies) --- findChildren :: HXT.QName -> HXT.XmlTree -> [HXT.XmlTree] -findChildren n e = HXT.getXPath n e +findChildren :: String -> HXT.XmlTree -> [HXT.XmlTree] +findChildren n (HXT.NTree _ children) = + flip concatMap children $ \e -> HXT.getXPath n e prepareInterp :: Text -> IO (PreparedTemplate (StateT TexState IO)) prepareInterp i = @@ -372,7 +376,7 @@ prepareInterp i = doPrepare (TemplatePlain t) = return $ PreparedTemplatePlain t doPrepare (TemplateLua t) = return $ PreparedTemplateLua luaRunner where - luaRunner context@TemplateContext {..} (heads, bodies) = + luaRunner TemplateContext {..} (heads, bodies) = liftIO $ -- putStrLn ("Running lua interpolation (" <> show t <> ")") do @@ -416,9 +420,9 @@ prepareInterp i = luaElements = execTexWriter tcState $ do r <- mapM convertInlineElem (elChildren tcElement) - let heads = concatMap fst r :: [LaTeXT Identity ()] - bodies = concatMap snd r - let ts = heads <> bodies + let cHeads = concatMap fst r :: [LaTeXT Identity ()] + cBodies = concatMap snd r + let ts = cHeads <> cBodies latexs = map (render . snd . runIdentity . runLaTeXT) ts els = filter ((/= mempty) . Text.strip . fst) (zip latexs ts) @@ -429,12 +433,12 @@ prepareInterp i = execTexWriter tcState $ mapM convertInlineElem - (findChildren (ByteString.unpack name) tcElement) - let heads = concatMap fst inlines - bodies = concatMap snd inlines + (findChildren (ByteString.unpack name) (tcElement)) + let cHeads = concatMap fst inlines + cBodies = concatMap snd inlines return $ filter (/= mempty) $ - map (Text.encodeUtf8 . render . runLaTeX) (heads <> bodies) + map (Text.encodeUtf8 . render . runLaTeX) (cHeads <> cBodies) luaFindChildren :: ByteString -> IO ByteString luaFindChildren name = do inlines <- @@ -442,11 +446,11 @@ prepareInterp i = mapM convertInlineElem (findChildren (ByteString.unpack name) tcElement) - let heads = + let cHeads = sequence_ (concatMap fst inlines) :: LaTeXT Identity () - bodies = + cBodies = sequence_ (concatMap snd inlines) :: LaTeXT Identity () - return (Text.encodeUtf8 (render (runLaTeX (heads <> bodies)))) + return (Text.encodeUtf8 (render (runLaTeX (cHeads <> cBodies)))) doPrepare (TemplateExpr e) = do runner <- do erunner <- @@ -540,7 +544,7 @@ parseTemplateFile :: FilePath -> IO Template parseTemplateFile fp = parseTemplate fp =<< ByteStringS.readFile fp parseTemplate :: FilePath -> Data.ByteString.ByteString -> IO Template -parseTemplate fp s = do +parseTemplate _ s = do let v = Yaml.decodeEither s v' <- case v of diff --git a/test/Text/JaTexSpec.hs b/test/Text/JaTexSpec.hs index 4b02f48..8510d53 100644 --- a/test/Text/JaTexSpec.hs +++ b/test/Text/JaTexSpec.hs @@ -22,6 +22,7 @@ spec = do jatsXmlToLaTeXText def {joInputDocument = doc, joTemplate = (templ, "")} output `shouldBe` "% Generated by jats2tex@0.11.1.0\n\\textbf{Hello}\n" + it "handles nested XPaths" $ do doc <- parseJATS @@ -36,12 +37,13 @@ spec = do "" [here| sec: | - @@lua(return find("*/p"))@@ + @@lua(return find("/p"))@@ |] output <- jatsXmlToLaTeXText def {joInputDocument = doc, joTemplate = (templ, "")} output `shouldBe` "% Generated by jats2tex@0.11.1.0\nSomething\n" + it "should find template" $ do templ <- parseTemplate "" [here|sec: "@@children"|] trees <- @@ -55,7 +57,7 @@ spec = do findTemplateResult = findTemplate templ doc case findTemplateResult of Nothing -> expectationFailure "got nothing" - Just (sub, ct, t) -> do + Just (_, ct, t) -> do templatePredicate t `shouldBe` "sec" templateSelector ct `shouldBe` "sec" templateContent ct `shouldBe` "@@children" From 5e91d05907a4d4e3797c1c9b0c3f767c3192584d Mon Sep 17 00:00:00 2001 From: yamadapc Date: Mon, 30 Oct 2017 09:17:35 -0200 Subject: [PATCH 6/6] Start adding more tests to define behavior --- jats2tex.cabal | 15 ++++- package.yaml | 5 +- src/Text/JaTex/TexWriter.hs | 28 ++++---- test/Text/JaTexSpec.hs | 128 +++++++++++++++++++++++++++--------- 4 files changed, 126 insertions(+), 50 deletions(-) diff --git a/jats2tex.cabal b/jats2tex.cabal index 2f643d4..96d5d0b 100644 --- a/jats2tex.cabal +++ b/jats2tex.cabal @@ -258,6 +258,7 @@ test-suite hspec main-is: Spec.hs hs-source-dirs: test + src build-depends: base >=4 && <5 , xml @@ -301,7 +302,6 @@ test-suite hspec , base , hspec , QuickCheck - , jats2tex , here if os(windows) build-depends: @@ -309,4 +309,17 @@ test-suite hspec other-modules: SanitySpec Text.JaTexSpec + JATSXML.HTMLEntities + Text.JaTex + Text.JaTex.CleanUp + Text.JaTex.Cmd.Main + Text.JaTex.Parser + Text.JaTex.Template + Text.JaTex.Template.Requirements + Text.JaTex.Template.TemplateInterp + Text.JaTex.Template.TemplateInterp.Helpers + Text.JaTex.Template.Types + Text.JaTex.TexWriter + Text.JaTex.Upgrade + Text.JaTex.Util default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index c971f9f..b9b5079 100644 --- a/package.yaml +++ b/package.yaml @@ -99,10 +99,11 @@ executables: tests: hspec: main: Spec.hs - source-dirs: test + source-dirs: + - test + - src dependencies: - base - hspec - QuickCheck - - jats2tex - here diff --git a/src/Text/JaTex/TexWriter.hs b/src/Text/JaTex/TexWriter.hs index 8214a8b..126a3cd 100644 --- a/src/Text/JaTex/TexWriter.hs +++ b/src/Text/JaTex/TexWriter.hs @@ -138,9 +138,9 @@ convertNode :: MonadTex m => HXT.XmlTree -> m (LaTeXT Identity ()) convertNode fullNode@(HXT.NTree node _) = case node of HXT.XTag _ _ -> do - addComment "tag" + addComment (Text.pack $ "startElem " <> (elementName fullNode)) ownAdded <- convertElem fullNode - addComment "endelem" + addComment (Text.pack $ "endElem " <> (elementName fullNode)) return ownAdded HXT.XText str -> if HXT.stringTrim str == mempty @@ -177,20 +177,19 @@ convertElem :: MonadTex m => HXT.XmlTree -> m (LaTeXT Identity ()) convertElem el@(HXT.NTree (HXT.XTag name attrs) children) = do TexState {tsTemplate} <- get commentEl - -- liftIO $ hPutStrLn stderr (show $ ("convertElem", HXT.qualifiedName name)) - case findTemplate (fst tsTemplate) el of - Nothing -> do + rets <- case findTemplate (fst tsTemplate) el of + [] -> do _ <- run return mempty - Just (sub, _, t) -> do + subList -> forM subList $ \(sub, _, t) -> do templateContext <- getTemplateContext - -- liftIO $ print ("findTemplate", elementName el, "found subtree", sub) rs <- forM sub $ \x -> templateApply t templateContext {tcElement = x} let h = mapM_ fst rs b = mapM_ snd rs addHead h add b return (h <> b) + return $ mconcat rets where commentEl = addComment @@ -282,17 +281,16 @@ runPredicate s t = t == s findTemplate :: Template -> HXT.XmlTree - -> Maybe ( [HXT.XmlTree] - , ConcreteTemplateNode - , TemplateNode (StateT TexState IO)) -findTemplate ts e = run ts + -> [( [HXT.XmlTree] + , ConcreteTemplateNode + , TemplateNode (StateT TexState IO))] +findTemplate (Template ts) e = concatMap run ts where - run (Template []) = Nothing - run (Template ((ct, t@TemplateNode {templatePredicate}):ps)) = + run (ct, t@TemplateNode {templatePredicate}) = let xpathR = HXT.getXPathSubTrees templatePredicate e in case xpathR of - [] -> run (Template ps) - sub -> Just (sub, ct, t) + [] -> [] + sub -> [(sub, ct, t)] elChildren :: HXT.XmlTree -> [HXT.XmlTree] elChildren (HXT.NTree _ c) = filter isElem c diff --git a/test/Text/JaTexSpec.hs b/test/Text/JaTexSpec.hs index 8510d53..ff62436 100644 --- a/test/Text/JaTexSpec.hs +++ b/test/Text/JaTexSpec.hs @@ -3,6 +3,8 @@ module Text.JaTexSpec where +import Data.ByteString (ByteString) +import Data.Monoid import Data.String.Here import qualified Data.Text as Text @@ -12,52 +14,114 @@ import Text.JaTex import Text.JaTex.Template.Types import Text.JaTex.TexWriter +testInputOutput + :: String + -> ByteString -> Text.Text -> IO () +testInputOutput inputXml inputTemplate expectedOutput = do + doc <- parseJATS inputXml + templ <- parseTemplate "" inputTemplate + output <- + jatsXmlToLaTeXText + def {joInputDocument = doc, joTemplate = (templ, "")} + output `shouldBe` expectedOutput + spec :: Spec spec = do describe "readJats" $ do it "works" $ do - doc <- parseJATS [here|Hello|] - templ <- parseTemplate "" [here|strong: "\\textbf{@@children}"|] - output <- - jatsXmlToLaTeXText - def {joInputDocument = doc, joTemplate = (templ, "")} - output `shouldBe` "% Generated by jats2tex@0.11.1.0\n\\textbf{Hello}\n" + let inputXml = [here| +Hello +|] + inputTemplate = [here| +strong: "\\textbf{@@children}" +|] + expectedOutput = "% Generated by jats2tex@0.11.1.0\n\\textbf{Hello}\n" + testInputOutput inputXml inputTemplate expectedOutput it "handles nested XPaths" $ do - doc <- - parseJATS - [here| - -

Something

-

Hidden

 - + let inputXml = [here| + +

Something

+

Hidden

 + + |] + inputTemplate = [here| +sec: | + @@lua(return find("/p"))@@ + |] + expectedOutput = "% Generated by jats2tex@0.11.1.0\nSomething\n" + testInputOutput inputXml inputTemplate expectedOutput + + it "applies templates recursively" $ do + let inputXml = [here| + +

Bold not bold

+

Hidden

 + + |] + inputTemplate = [here| +sec: | + @@lua(return find("/p"))@@ +p: | + \paragraph{@@children} +b: | + \textbf{@@children} |] - templ <- - parseTemplate - "" - [here| - sec: | - @@lua(return find("/p"))@@ + expectedOutput = "% Generated by jats2tex@0.11.1.0\n\\paragraph{\\textbf{Bold} not bold}\n" + testInputOutput inputXml inputTemplate expectedOutput + + it "respects XML XPaths" $ do + let inputXml = [here| +
+ +

Bold not bold

+

Other paragraph

 + +

Top-level paragraph

+
+ |] + inputTemplate = [here| +article: "@@children" +sec: | + @@lua(return find("/p"))@@ + % Stuff + @@lua(return find("/other"))@@ +p: "" +sec/p: | + \secParagraph{@@children} +sec/other/p: | + \otherParagraph{@@children} +article/p: | + \paragraph{@@children} +b: | + \textbf{@@children} |] - output <- - jatsXmlToLaTeXText - def {joInputDocument = doc, joTemplate = (templ, "")} - output `shouldBe` "% Generated by jats2tex@0.11.1.0\nSomething\n" + expectedOutput = [here| +% Generated by jats2tex@0.11.1.0 +\secParagraph{\textbf{Bold} not bold} + +% Stuff + +\otherParagraph{Other paragraph} +\paragraph{Top-level paragraph} + |] <> "\n" + testInputOutput inputXml inputTemplate expectedOutput it "should find template" $ do - templ <- parseTemplate "" [here|sec: "@@children"|] + templ <- parseTemplate "" [here| +sec: "@@children" +|] trees <- - parseJATS - [here| - -

Something

- - |] + parseJATS [here| + +

Something

+ +|] let doc = trees !! 0 findTemplateResult = findTemplate templ doc case findTemplateResult of - Nothing -> expectationFailure "got nothing" - Just (_, ct, t) -> do + [] -> expectationFailure "got nothing" + [(_, ct, t)] -> do templatePredicate t `shouldBe` "sec" templateSelector ct `shouldBe` "sec" templateContent ct `shouldBe` "@@children"