pandoc-crossref 0.1.0.0 → 0.1.0.1
raw patch · 15 files changed
+235/−141 lines, 15 files
Files
- README.md +1/−1
- pandoc-crossref.cabal +15/−3
- pandoc-crossref.hs +4/−5
- src/References/Accessors.hs +0/−5
- src/References/Blocks.hs +8/−8
- src/References/Refs.hs +2/−2
- src/References/Types.hs +8/−5
- src/Util/Default/Default.hs +0/−22
- src/Util/Default/Settings.hs +0/−14
- src/Util/Meta.hs +8/−9
- src/Util/Options.hs +15/−16
- src/Util/Settings.hs +34/−0
- src/Util/Template.hs +17/−29
- src/Util/Util.hs +0/−7
- test-pandoc-crossref.hs +123/−15
README.md view
@@ -1,4 +1,4 @@-# pandoc-crossref filter +# pandoc-crossref filter  pandoc-crossref is a pandoc filter for numbering figures, equations, tables and cross-references to them.
pandoc-crossref.cabal view
@@ -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
pandoc-crossref.hs view
@@ -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
src/References/Accessors.hs view
@@ -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
src/References/Blocks.hs view
@@ -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)]
src/References/Refs.hs view
@@ -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}
src/References/Types.hs view
@@ -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
− src/Util/Default/Default.hs
@@ -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
− src/Util/Default/Settings.hs
@@ -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
src/Util/Meta.hs view
@@ -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
src/Util/Options.hs view
@@ -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 }
+ src/Util/Settings.hs view
@@ -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
src/Util/Template.hs view
@@ -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
src/Util/Util.hs view
@@ -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
test-pandoc-crossref.hs view
@@ -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}]