Skip to content

Instantly share code, notes, and snippets.

@jkr
Created August 23, 2014 12:56
Show Gist options
  • Save jkr/bcfacbfdcf4cc4bafcf6 to your computer and use it in GitHub Desktop.
Save jkr/bcfacbfdcf4cc4bafcf6 to your computer and use it in GitHub Desktop.
Numerical references to sections in pandoc. To be used with `--number-sections`
{-# LANGUAGE PatternGuards #-}
{- This filter allows for numerical section references. It should be
used with "--number-sections", since it uses a similar numbering
scheme. It works by using the link notation: given a header with a
given id, we can refer to that number by using a link with `#` in it:
My Header {#my-header-id}
=========
This refers back the [Section #](#my-header-id)
It takes two metadata options, which can either be specified
in YAML or on the command-line:
* `ref-num-sign`: This is the sign that will be used to indicate
numerical reference. It defaults to `#`.
* `ref-num-unlink`: Whether to make the the link a plain string, or
keep it a link. The default is false.
-}
import Text.Pandoc
import Text.Pandoc.JSON
import Text.Pandoc.Walk
import Text.Pandoc.Shared
import Control.Monad.State
import Control.Monad.Reader
import qualified Data.Map as M
import Data.Maybe
import Data.List
import Control.Monad.Reader
import Control.Monad.State
import Control.Applicative ((<$>))
data ScriptConfig = ScriptConfig { confNumSign :: String
, confUnlinkNum :: Bool
}
getConfig :: Meta -> ScriptConfig
getConfig meta = ScriptConfig { confNumSign = num
, confUnlinkNum = bool}
where num = case lookupMeta "ref-num-sign" meta of
Just (MetaString s) -> s
Just (MetaInlines ils) -> concatMap stringify ils
_ -> "#" -- default to number sign
bool = case lookupMeta "ref-num-unlink" meta of
Just (MetaBool b) -> b
_ -> False
data ScriptState = ScriptState { stCounter :: Counter
, stNumMap :: M.Map String Counter
}
defaultState :: ScriptState
defaultState = ScriptState [] M.empty
type MyMonad = ReaderT ScriptConfig (State ScriptState)
type Counter = [Int]
incCounter :: Int -> Counter -> Counter
incCounter lvl cntr
| lvl < 1 = cntr
| otherwise =
let xs = take (lvl - 1) $ cntr ++ (repeat 0)
(y:ys) = case drop (lvl - 1) cntr of
[] -> [0]
l -> l
in
xs ++ ((y + 1) : ys)
getSecNumber :: Block -> MyMonad Block
getSecNumber b@(Header n (ident, classes, _) _)
| notElem "unnumbered" classes = do
cntr <- gets stCounter
mp <- gets stNumMap
let cntr' = incCounter n cntr
put $ ScriptState { stCounter = cntr'
, stNumMap = M.insert ident cntr' mp}
return b
getSecNumber b = return b
printCntr :: Counter -> String
printCntr cntr = concat $ intersperse "." $ map show cntr
convertInlines :: String -> String -> [Inline] -> [Inline]
convertInlines orig repl ils =
let f (Str s) | s == orig = (Str repl)
f i = i
in
map f ils
insertNumbers :: Inline -> MyMonad [Inline]
insertNumbers il@(Link ils target)
| ('#':anchor, _) <- target = do
numSign <- asks confNumSign
unLink <- asks confUnlinkNum
mp <- gets stNumMap
return $ case filter ((Str numSign) ==) ils of
[] -> [il]
_ -> case M.lookup anchor mp of
Just cntr | unLink -> convertInlines numSign (printCntr cntr) ils
| otherwise ->
[Link (convertInlines numSign (printCntr cntr) ils) target]
Nothing -> [il]
insertNumbers il = return [il]
-- | The 'concatMapM' function generalizes 'concatMap' to arbitrary monads.
concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
concatMapM f xs = liftM concat (mapM f xs)
run' :: [Block] -> MyMonad [Block]
run' blks = do
blks' <- mapM getSecNumber blks
bottomUpM (concatMapM insertNumbers) blks'
run :: Pandoc -> Pandoc
run (Pandoc meta blks) = Pandoc meta blks'
where blks' = evalState (runReaderT (run' blks) config) defaultState
config = getConfig meta
main = toJSONFilter run
@elotariodelguille
Copy link

Hi jkr, I'd like to use this filter in a project, do you give any license to it?

@kvaleev
Copy link

kvaleev commented Jul 27, 2018

Hello,

Jrk, could you please advice on how to use the filter? I've tried just to pass it to pandoc as --filter numerical-reference.hs but get an error:

./filters/numerical-reference.hs: line 14: syntax error near unexpected token `('
./filters/numerical-reference.hs: line 14: `import Control.Applicative ((<$>))'
Error running filter filters/numerical-reference.hs:
fd:13: hPutBuf: resource vanished (Broken pipe)

Maybe I need to precompile it before somehow? Sorry for that question, but I'm not familiar with Haskell at all.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment