diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# pandoc-crossref filter ![](https://travis-ci.org/lierdakil/pandoc-crossref.svg) +# pandoc-crossref filter ![](https://travis-ci.org/lierdakil/pandoc-crossref.svg?branch=master) pandoc-crossref is a pandoc filter for numbering figures, equations, tables and cross-references to them. diff --git a/pandoc-crossref.cabal b/pandoc-crossref.cabal --- a/pandoc-crossref.cabal +++ b/pandoc-crossref.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: pandoc-crossref -version: 0.1.0.0 +version: 0.1.0.1 synopsis: Pandoc filter for cross-references description: pandoc-crossref is a pandoc filter for numbering figures, equations, tables and cross-references to them. license: GPL-2 @@ -33,8 +33,7 @@ , References.List , References.Refs , References.Types - , Util.Default.Default - , Util.Default.Settings + , Util.Settings , Util.Accessor , Util.Meta , Util.Options @@ -55,6 +54,19 @@ Test-Suite test-pandoc-crossref Type: exitcode-stdio-1.0 Main-Is: test-pandoc-crossref.hs + other-modules: References + , References.Accessors + , References.Blocks + , References.List + , References.Refs + , References.Types + , Util.Settings + , Util.Accessor + , Util.Meta + , Util.Options + , Util.Template + , Util.Util + hs-source-dirs: ., src Build-Depends: base >=4.2 && <5 , pandoc >= 1.13 && <1.14 , mtl >= 1.1 && <2.3 diff --git a/pandoc-crossref.hs b/pandoc-crossref.hs --- a/pandoc-crossref.hs +++ b/pandoc-crossref.hs @@ -4,7 +4,7 @@ import Control.Monad.State import References -import Util.Default.Settings +import Util.Settings import Util.Options main :: IO () @@ -12,12 +12,11 @@ go :: Maybe Format -> Pandoc -> IO Pandoc go fmt (Pandoc meta bs) = do - dtv <- getDefaultSettings meta + dtv <- getSettings meta let - st = defaultReferences{stMeta=meta, stDTV=dtv} doWalk = walkM (replaceBlocks opts) bs >>= bottomUpM (replaceRefs opts) >>= bottomUpM (listOf opts) - opts = getOptions meta dtv fmt - return $ Pandoc meta $ evalState doWalk st + opts = getOptions dtv fmt + return $ Pandoc meta $ evalState doWalk def diff --git a/src/References/Accessors.hs b/src/References/Accessors.hs --- a/src/References/Accessors.hs +++ b/src/References/Accessors.hs @@ -2,8 +2,6 @@ import References.Types import Util.Accessor -import Text.Pandoc.Definition (nullMeta) -import Data.Map (empty) imgRefs' :: Accessor References RefMap imgRefs' new r@References{imgRefs=old} = (old, r{imgRefs=new}) @@ -13,6 +11,3 @@ tblRefs' :: Accessor References RefMap tblRefs' new r@References{tblRefs=old} = (old, r{tblRefs=new}) - -defaultReferences :: References -defaultReferences = References empty empty empty 0 nullMeta (const Nothing) nullMeta diff --git a/src/References/Blocks.hs b/src/References/Blocks.hs --- a/src/References/Blocks.hs +++ b/src/References/Blocks.hs @@ -1,7 +1,7 @@ module References.Blocks (replaceBlocks) where import Text.Pandoc.Definition -import Text.Pandoc.Shared (stringify) +import Text.Pandoc.Shared (stringify, normalizeSpaces) import Control.Monad.State import Data.List import qualified Data.Map as M @@ -23,10 +23,10 @@ | Just label <- getRefLabel "fig" c = do idxStr <- replaceAttr opts label alt imgRefs' - alt' <- case outFormat opts of - Just f | isFormat "latex" f -> return $ + let alt' = case outFormat opts of + Just f | isFormat "latex" f -> RawInline (Format "tex") ("\\label{"++label++"}") : alt - _ -> figureTemplate opts >>= applyTemplate idxStr alt + _ -> applyTemplate idxStr alt $ figureTemplate opts return $ Para [Image alt' (fst img,"fig:")] replaceBlocks opts (Para (Math DisplayMath eq:c)) | Just label <- getRefLabel "eq" c @@ -43,11 +43,11 @@ , Just label <- getRefLabel "tbl" [last title] = do idxStr <- replaceAttr opts label (init title) tblRefs' - title' <- + let title' = case outFormat opts of - Just f | isFormat "latex" f -> return $ + Just f | isFormat "latex" f -> RawInline (Format "tex") ("\\label{"++label++"}") : init title - _ -> tableTemplate opts >>= applyTemplate idxStr (init title) + _ -> applyTemplate idxStr (init title) $ tableTemplate opts return $ Table title' align widths header cells replaceBlocks _ x = return x @@ -68,7 +68,7 @@ index <- (1+) `fmap` gets (M.size . getProp prop) modify $ modifyProp prop $ M.insert label RefRec { refIndex=(chap,index) - , refTitle=title + , refTitle=normalizeSpaces title } if sepChapters o then return $ Str (show chap) : chapDelim o ++ [Str (show index)] diff --git a/src/References/Refs.hs b/src/References/Refs.hs --- a/src/References/Refs.hs +++ b/src/References/Refs.hs @@ -43,7 +43,7 @@ getRefPrefix :: Options -> String -> [Inline] getRefPrefix opts prefix | null refprefix = [] - | otherwise = refprefix ++ [Space] + | otherwise = refprefix ++ [Str "\160"] where refprefix = lookupUnsafe prefix prefMap opts lookupUnsafe :: Ord k => k -> M.Map k v -> v @@ -85,7 +85,7 @@ indices <- mapM (getRefIndex prefix) cits let indices' = groupBy ((==) `on` fmap fst) (sort indices) - return $ getRefPrefix opts prefix ++ normalizeInlines (concatMap (makeIndices opts) indices') + return $ normalizeInlines $ getRefPrefix opts prefix ++ concatMap (makeIndices opts) indices' getRefIndex :: String -> Citation -> WS (Maybe (Int, Int)) getRefIndex prefix Citation{citationId=cid} diff --git a/src/References/Types.hs b/src/References/Types.hs --- a/src/References/Types.hs +++ b/src/References/Types.hs @@ -2,15 +2,17 @@ , WS , RefRec(..) , RefMap + , def ) where import qualified Data.Map as M import Text.Pandoc.Definition import Control.Monad.State +import Data.Default data RefRec = RefRec { refIndex :: (Int, Int) , refTitle :: [Inline] - } + } deriving (Show, Eq) type RefMap = M.Map String RefRec @@ -19,10 +21,11 @@ , eqnRefs :: RefMap , tblRefs :: RefMap , curChap :: Int - , stMeta :: Meta - , stTmplV :: String -> Maybe MetaValue - , stDTV :: Meta - } + } deriving (Show, Eq) --state monad type WS a = State References a + +instance Default References where + def = References n n n 0 + where n = M.empty diff --git a/src/Util/Default/Default.hs b/src/Util/Default/Default.hs deleted file mode 100644 --- a/src/Util/Default/Default.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Util.Default.Default where - -import Text.Pandoc.Definition -import qualified Data.Map as M - -defaultMeta :: Meta -defaultMeta = Meta $ M.fromList - [ ("figureTitle" , MetaInlines [Str "Figure"]) - , ("tableTitle" , MetaInlines [Str "Table"]) - , ("titleDelim" , MetaInlines [Str ":"]) - , ("chapDelim" , MetaInlines [Str "."]) - , ("rangeDelim" , MetaInlines [Str "-"]) - , ("figPrefix" , MetaInlines [Str "fig."]) - , ("eqnPrefix" , MetaInlines [Str "eq."]) - , ("tblPrefix" , MetaInlines [Str "tbl."]) - , ("lofTitle" , MetaBlocks [Header 1 nullAttr [Str "List of Figures"]]) - , ("lotTitle" , MetaBlocks [Header 1 nullAttr [Str "List of Tables"]]) - , ("figureTemplate" , MetaInlines [var "figureTitle",Space,var "i",var "titleDelim",Space,var "t"]) - , ("tableTemplate" , MetaInlines [var "tableTitle",Space,var "i",var "titleDelim",Space,var "t"]) - , ("crossrefYaml" , MetaString "pandoc-crossref.yaml") - ] - where var = Math DisplayMath diff --git a/src/Util/Default/Settings.hs b/src/Util/Default/Settings.hs deleted file mode 100644 --- a/src/Util/Default/Settings.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Util.Default.Settings where - -import Text.Pandoc -import Control.Exception (handle,IOException) - -import Util.Meta (getMetaString) - -getDefaultSettings :: Meta -> IO Meta -getDefaultSettings meta = do - let handler :: IOException -> IO String - handler _ = return [] - yaml <- handle handler $ readFile (getMetaString "crossrefYaml" meta nullMeta) - let Pandoc dtve _ = readMarkdown def ("---\n" ++ yaml ++ "\n---") - return dtve diff --git a/src/Util/Meta.hs b/src/Util/Meta.hs --- a/src/Util/Meta.hs +++ b/src/Util/Meta.hs @@ -4,19 +4,18 @@ import Text.Pandoc.Shared (stringify) import Text.Pandoc.Definition import Data.Maybe (fromMaybe) -import Util.Util (lookupDefault) -getMetaBool :: String -> Meta -> Meta -> Bool -getMetaBool name meta defaults = fromMaybe False $ lookupDefault name meta defaults >>= toBool +getMetaBool :: String -> Meta -> Bool +getMetaBool name meta = fromMaybe False $ lookupMeta name meta >>= toBool -getMetaInlines :: String -> Meta -> Meta -> [Inline] -getMetaInlines name meta defaults = fromMaybe [] $ lookupDefault name meta defaults >>= toInlines +getMetaInlines :: String -> Meta -> [Inline] +getMetaInlines name meta = fromMaybe [] $ lookupMeta name meta >>= toInlines -getMetaBlock :: String -> Meta -> Meta -> [Block] -getMetaBlock name meta defaults = fromMaybe [] $ lookupDefault name meta defaults >>= toBlocks +getMetaBlock :: String -> Meta -> [Block] +getMetaBlock name meta = fromMaybe [] $ lookupMeta name meta >>= toBlocks -getMetaString :: String -> Meta -> Meta -> String -getMetaString name meta defaults = fromMaybe [] $ lookupDefault name meta defaults >>= toString +getMetaString :: String -> Meta -> String +getMetaString name meta = fromMaybe [] $ lookupMeta name meta >>= toString toInlines :: MetaValue -> Maybe [Inline] toInlines (MetaString s) = return $ getInlines $ readMarkdown def s diff --git a/src/Util/Options.hs b/src/Util/Options.hs --- a/src/Util/Options.hs +++ b/src/Util/Options.hs @@ -1,7 +1,6 @@ module Util.Options where import Text.Pandoc.Definition -import References.Types import Util.Meta import Util.Template @@ -15,23 +14,23 @@ , lofTitle :: [Block] , lotTitle :: [Block] , outFormat :: Maybe Format - , figureTemplate :: WS [Inline] - , tableTemplate :: WS [Inline] + , figureTemplate :: Template + , tableTemplate :: Template } -getOptions :: Meta -> Meta -> Maybe Format -> Options -getOptions meta dtv fmt = +getOptions :: Meta -> Maybe Format -> Options +getOptions dtv fmt = Options { - useCleveref = getMetaBool "cref" meta dtv - , sepChapters = getMetaBool "chapters" meta dtv - , figPrefix = getMetaInlines "figPrefix" meta dtv - , eqnPrefix = getMetaInlines "eqnPrefix" meta dtv - , tblPrefix = getMetaInlines "tblPrefix" meta dtv - , chapDelim = getMetaInlines "chapDelim" meta dtv - , rangeDelim = getMetaInlines "rangeDelim" meta dtv - , lofTitle = getMetaBlock "lofTitle" meta dtv - , lotTitle = getMetaBlock "lotTitle" meta dtv + useCleveref = getMetaBool "cref" dtv + , sepChapters = getMetaBool "chapters" dtv + , figPrefix = getMetaInlines "figPrefix" dtv + , eqnPrefix = getMetaInlines "eqnPrefix" dtv + , tblPrefix = getMetaInlines "tblPrefix" dtv + , chapDelim = getMetaInlines "chapDelim" dtv + , rangeDelim = getMetaInlines "rangeDelim" dtv + , lofTitle = getMetaBlock "lofTitle" dtv + , lotTitle = getMetaBlock "lotTitle" dtv , outFormat = fmt - , figureTemplate = replaceTemplate $ getMetaInlines "figureTemplate" meta dtv - , tableTemplate = replaceTemplate $ getMetaInlines "tableTemplate" meta dtv + , figureTemplate = makeTemplate dtv $ getMetaInlines "figureTemplate" dtv + , tableTemplate = makeTemplate dtv $ getMetaInlines "tableTemplate" dtv } diff --git a/src/Util/Settings.hs b/src/Util/Settings.hs new file mode 100644 --- /dev/null +++ b/src/Util/Settings.hs @@ -0,0 +1,34 @@ +module Util.Settings (getSettings, defaultMeta) where + +import Text.Pandoc +import Control.Exception (handle,IOException) +import qualified Data.Map as M +import Data.Monoid + +import Util.Meta (getMetaString) + +getSettings :: Meta -> IO Meta +getSettings meta = do + let handler :: IOException -> IO String + handler _ = return [] + yaml <- handle handler $ readFile (getMetaString "crossrefYaml" (meta <> defaultMeta)) + let Pandoc dtve _ = readMarkdown def ("---\n" ++ yaml ++ "\n---") + return $ meta <> dtve <> defaultMeta + +defaultMeta :: Meta +defaultMeta = Meta $ M.fromList + [ ("figureTitle" , MetaInlines [Str "Figure"]) + , ("tableTitle" , MetaInlines [Str "Table"]) + , ("titleDelim" , MetaInlines [Str ":"]) + , ("chapDelim" , MetaInlines [Str "."]) + , ("rangeDelim" , MetaInlines [Str "-"]) + , ("figPrefix" , MetaInlines [Str "fig."]) + , ("eqnPrefix" , MetaInlines [Str "eq."]) + , ("tblPrefix" , MetaInlines [Str "tbl."]) + , ("lofTitle" , MetaBlocks [Header 1 nullAttr [Str "List",Space,Str "of",Space,Str "Figures"]]) + , ("lotTitle" , MetaBlocks [Header 1 nullAttr [Str "List",Space,Str "of",Space,Str "Tables"]]) + , ("figureTemplate" , MetaInlines [var "figureTitle",Space,var "i",var "titleDelim",Space,var "t"]) + , ("tableTemplate" , MetaInlines [var "tableTitle",Space,var "i",var "titleDelim",Space,var "t"]) + , ("crossrefYaml" , MetaString "pandoc-crossref.yaml") + ] + where var = Math DisplayMath diff --git a/src/Util/Template.hs b/src/Util/Template.hs --- a/src/Util/Template.hs +++ b/src/Util/Template.hs @@ -1,38 +1,26 @@ -module Util.Template where +module Util.Template (Template,makeTemplate,applyTemplate) where import Text.Pandoc.Definition import Text.Pandoc.Generic -import References.Types - -import Control.Monad.State +import Text.Pandoc.Shared (normalizeInlines) import Data.Maybe -import Util.Util import Util.Meta -replaceTemplate :: [Inline] -> WS [Inline] -replaceTemplate = bottomUpM replace - where - replace (x@(Math DisplayMath var):xs) = (++xs) `fmap` getTemplateMetaVar var [x] - replace x = return x +type VarFunc = String -> Maybe MetaValue +newtype Template = Template (VarFunc -> [Inline]) -getTemplateMetaVar :: String -> [Inline] -> WS [Inline] -getTemplateMetaVar var def' = do - meta <- gets stMeta - tmplv <- gets stTmplV - dtv <- gets stDTV - return - $ fromMaybe def' - $ (tmplv var `mplus` lookupDefault var meta dtv) >>= toInlines +makeTemplate :: Meta -> [Inline] -> Template +makeTemplate dtv = Template . flip scan . scan (`lookupMeta` dtv) + where + scan = bottomUp . go + go vf (x@(Math DisplayMath var):xs) = replaceVar (vf var) [x] ++ xs + go _ x = x + replaceVar val def' = fromMaybe def' $ val >>= toInlines -applyTemplate :: [Inline] -> [Inline] -> [Inline] -> WS [Inline] -applyTemplate i t tmpl = withTmplV internalVars $ replaceTemplate tmpl +applyTemplate :: [Inline] -> [Inline] -> Template -> [Inline] +applyTemplate i t (Template g) = + normalizeInlines $ g internalVars where - withTmplV :: (String -> Maybe MetaValue) -> WS [Inline] -> WS [Inline] - withTmplV f g = do - modify $ \s -> s{stTmplV=f} - res <- g - modify $ \s -> s{stTmplV=const Nothing} - return res - internalVars "i" = Just $ MetaInlines i - internalVars "t" = Just $ MetaInlines t - internalVars _ = Nothing + internalVars "i" = Just $ MetaInlines i + internalVars "t" = Just $ MetaInlines t + internalVars _ = Nothing diff --git a/src/Util/Util.hs b/src/Util/Util.hs --- a/src/Util/Util.hs +++ b/src/Util/Util.hs @@ -1,13 +1,6 @@ module Util.Util where import Text.Pandoc.Definition -import Control.Monad (mplus) -import Util.Default.Default -import Data.Monoid - -lookupDefault :: String -> Meta -> Meta -> Maybe MetaValue -lookupDefault name meta defMap = - lookupMeta name meta `mplus` lookupMeta name (defMap `mappend` defaultMeta) isFormat :: String -> Format -> Bool isFormat fmt (Format f) = takeWhile (`notElem` "+-") f == fmt diff --git a/test-pandoc-crossref.hs b/test-pandoc-crossref.hs --- a/test-pandoc-crossref.hs +++ b/test-pandoc-crossref.hs @@ -1,18 +1,126 @@ import Test.Hspec -import Text.Pandoc -import System.Process --- import Control.Exception (evaluate) +import Text.Pandoc.Definition +import Text.Pandoc.Builder +import Text.Pandoc.Walk +import Text.Pandoc.Generic +import Text.Pandoc.Shared (normalizeInlines) +import Util.Options +import Control.Monad.State +import References.Types +import Util.Settings +import Util.Accessor +import References.Accessors +import qualified References.Blocks +import qualified References.Refs +import qualified References.List +import qualified Util.Template +import qualified Data.Map as M +import Data.Monoid +import Data.List (intersperse) main :: IO () -main = do - native <- read `fmap` readFile "demo.native" :: IO [Block] - parsed <- read `fmap` readProcess "cabal" [ - "exec", "--", "pandoc" - , "-F", "pandoc-crossref.hs" - , "-i", "demo.md" - , "-t", "native"] - "" - hspec $ - describe "pandoc-crossref.hs" $ - it "formats demo.md as demo.native" $ - parsed `shouldBe` native +main = hspec $ do + describe "References.Blocks.replaceBlocks" $ do + it "Labels images" $ + testBlocks (figure "test.jpg" [] "Test figure" "figure") + (figure "test.jpg" "fig:" "Figure 1: Test figure" [], + def{imgRefs=M.fromList $ refRec' "fig:figure" 1 "Test figure"}) + it "Labels equations" $ + testBlocks (equation "a^2+b^2=c^2" "equation") + (equation "a^2+b^2=c^2\\qquad(1)" [], + def{eqnRefs=M.fromList $ refRec'' "eq:equation" 1}) + it "Labels tables" $ + testBlocks (table' "Test table" "table") + (table' "Table 1: Test table" [], + def{tblRefs=M.fromList $ refRec' "tbl:table" 1 "Test table"}) + + describe "References.Refs.replaceRefs" $ do + it "References one image" $ + testRefs' "fig:" [1] [4] imgRefs' "fig. 4" + it "References multiple images" $ + testRefs' "fig:" [1..3] [4..6] imgRefs' "fig. 4-6" + it "References one equation" $ + testRefs' "eq:" [1] [4] eqnRefs' "eq. 4" + it "References multiple equations" $ + testRefs' "eq:" [1..3] [4..6] eqnRefs' "eq. 4-6" + it "References one table" $ + testRefs' "tbl:" [1] [4] tblRefs' "tbl. 4" + it "References multiple tables" $ + testRefs' "tbl:" [1..3] [4..6] tblRefs' "tbl. 4-6" + + describe "References.List.listOf" $ do + it "Generates list of tables" $ + testList (para $ rawInline "tex" "\\listoftables") + def{tblRefs=M.fromList $ refRec' "tbl:1" 4 "4" <> refRec' "tbl:2" 5 "5" <> refRec' "tbl:3" 6 "6"} + (header 1 (str' "List of Tables") <> orderedList ((plain . str . show) `map` [4..6 :: Int])) + it "Generates list of figures" $ + testList (para $ rawInline "tex" "\\listoffigures") + def{imgRefs=M.fromList $ refRec' "fig:1" 4 "4" <> refRec' "fig:2" 5 "5" <> refRec' "fig:3" 6 "6"} + (header 1 (str' "List of Figures") <> orderedList ((plain . str . show) `map` [4..6 :: Int])) + + describe "Util.Template" $ + it "Applies templates" $ + let template=Util.Template.makeTemplate defaultMeta (toList $ displayMath "figureTitle" <> displayMath "i" <> displayMath "t") + in Util.Template.applyTemplate [Str "1"] [Str "title"] template `shouldBe` + toList (str "Figure" <> str "1" <> str "title") + +citeGen :: String -> [Int] -> Inlines +citeGen p l = cite (mconcat $ map (cit . (p++) . show) l) mempty + +refGen :: String -> [Int] -> [Int] -> M.Map String RefRec +refGen p l1 l2 = M.fromList $ mconcat $ zipWith refRec'' (((p++) . show) `map` l1) l2 + +refRec' :: String -> Int -> String -> [(String, RefRec)] +refRec' ref i tit = [(ref, RefRec{refIndex=(0,i),refTitle=toList $ str' tit})] + +refRec'' :: String -> Int -> [(String, RefRec)] +refRec'' ref i = refRec' ref i [] + +testRefs' :: String -> [Int] -> [Int] -> Accessor References (M.Map String RefRec) -> String -> Expectation +testRefs' p l1 l2 prop res = testRefs (para $ citeGen p l1) (setProp prop (refGen p l1 l2) def) (para $ str'' res) + +testBlocks :: Blocks -> (Blocks, References) -> Expectation +testBlocks arg res = runState (walkM (f defaultOptions) arg) def `shouldBe` res + where f = References.Blocks.replaceBlocks + +testRefs :: Blocks -> References -> Blocks -> Expectation +testRefs bs st res = runState (bottomUpM (References.Refs.replaceRefs defaultOptions) (toList bs)) st `shouldBe` (toList res,st) + +testList :: Blocks -> References -> Blocks -> Expectation +testList bs st res = runState (bottomUpM (References.List.listOf defaultOptions) (toList bs)) st `shouldBe` (toList res,st) + +figure :: String -> String -> String -> String -> Blocks +figure src title alt ref = para (image src title (str' alt) <> ref' "fig" ref) + +equation :: String -> String -> Blocks +equation eq ref = para (displayMath eq <> ref' "eq" ref) + +table' :: String -> String -> Blocks +table' title ref = table (str' title <> ref' "tbl" ref) [] + [para $ str "H1", para $ str "H2"] + [[para $ str "C1", para $ str "C2"]] + +ref' :: String -> String -> Inlines +ref' p n | null n = mempty + | otherwise = space <> str ("{#"++p++":"++n++"}") + +str' :: String -> Inlines +str' s = fromList $ intersperse Space $ Str `map` words s + +str'' :: String -> Inlines +str'' s = fromList $ normalizeInlines $ intersperse (Str "\160") $ Str `map` words s + +defaultOptions :: Options +defaultOptions = getOptions defaultMeta Nothing + +defCit :: Citation +defCit = Citation{citationId = "" + ,citationPrefix = [] + ,citationSuffix = [] + ,citationHash = 0 + ,citationNoteNum = 0 + ,citationMode = NormalCitation + } + +cit :: String -> [Citation] +cit r = [defCit{citationId=r}]