0758402 · typeable/pandoc

30module Text.Pandoc.Biblio ( processBiblio ) where

31

32import Control.Monad ( when )

33+import Data.Char ( toUpper, isPunctuation )

33import Data.List

34import Data.List

34import Data.Unique

35import Data.Unique

35import Text.CSL hiding ( Cite(..), Citation(..) )

36import Text.CSL hiding ( Cite(..), Citation(..) )

44 else do

45 else do

45 when (null cf) $ error "Missing the needed citation style file"

46 when (null cf) $ error "Missing the needed citation style file"

46 csl <- readCSLFile cf

47 csl <- readCSLFile cf

47− p' <- if styleClass csl == "note"

48− then processNote p

49− else processWithM setHash p

48+ p' <- processWithM setHash p

50− let groups = if styleClass csl /= "note"

49+ let (nts,grps) = if styleClass csl /= "note"

51− then queryWith getCitation p'

50+ then (,) [] $ queryWith getCitation p'

51+ else let cits = queryWith getCite p'

52+ ncits = map (queryWith getCite) $ queryWith getNote p'

53+ needNt = cits \\ concat ncits

52− else getNoteCitations p'

54+ in (,) needNt $ getNoteCitations needNt p'

53− result = citeproc' csl r (setNearNote csl $ map (map toCslCite) groups)

55+ result = citeproc' csl r (setNearNote csl $ map (map toCslCite) grps)

54− cits_map = zip groups (citations result)

56+ cits_map = zip grps (citations result)

55 biblioList = map (read . renderPandoc' csl) (bibliography result)

57 biblioList = map (read . renderPandoc' csl) (bibliography result)

56 Pandoc m b = processWith (processCite csl cits_map) p'

58 Pandoc m b = processWith (processCite csl cits_map) p'

57− return $ Pandoc m $ b ++ biblioList

59+ return . generateNotes nts . Pandoc m $ b ++ biblioList

58

60

59-- | Substitute 'Cite' elements with formatted citations.

61-- | Substitute 'Cite' elements with formatted citations.

60processCite :: Style -> [([Citation],[FormattedOutput])] -> Inline -> Inline

62processCite :: Style -> [([Citation],[FormattedOutput])] -> Inline -> Inline

70-- 'queryWith'.

72-- 'queryWith'.

71getCitation :: Inline -> [[Citation]]

73getCitation :: Inline -> [[Citation]]

72getCitation i | Cite t _ <- i = [t]

74getCitation i | Cite t _ <- i = [t]

73− | otherwise = []

75+ | otherwise = []

74

76

75getNote :: Inline -> [Inline]

77getNote :: Inline -> [Inline]

76getNote i | Note _ <- i = [i]

78getNote i | Note _ <- i = [i]

80getCite i | Cite _ _ <- i = [i]

82getCite i | Cite _ _ <- i = [i]

81 | otherwise = []

83 | otherwise = []

82

84

83−getNoteCitations :: Pandoc -> [[Citation]]

85+getNoteCitations :: [Inline] -> Pandoc -> [[Citation]]

84−getNoteCitations

86+getNoteCitations needNote

87+ = let mvCite i = if i `elem` needNote then Note [Para [i]] else i

88+ setNote = processWith mvCite

85− = let cits = concat . flip (zipWith $ setCiteNoteNum) [1..] .

89+ getCits = concat . flip (zipWith $ setCiteNoteNum) [1..] .

86− map (queryWith getCite) . queryWith getNote

90+ map (queryWith getCite) . queryWith getNote . setNote

87− in queryWith getCitation . cits

91+ in queryWith getCitation . getCits

88

92

89setHash :: Citation -> IO Citation

93setHash :: Citation -> IO Citation

90setHash (Citation i p l nn ao na _)

94setHash (Citation i p l nn ao na _)

91 = hashUnique `fmap` newUnique >>= return . Citation i p l nn ao na

95 = hashUnique `fmap` newUnique >>= return . Citation i p l nn ao na

92

96

93−processNote :: Pandoc -> IO Pandoc

97+generateNotes :: [Inline] -> Pandoc -> Pandoc

94−processNote p = do

95− p' <- processWithM setHash p

96− let cits = queryWith getCite p'

97− ncits = map (queryWith getCite) $ queryWith getNote p'

98− needNote = cits \\ concat ncits

99− return $ processWith (mvCiteInNote needNote) p'

98+generateNotes needNote = processWith (mvCiteInNote needNote)

100

99

101−mvCiteInNote :: [Inline] -> Inline -> Inline

100+procInlines :: ([Inline] -> [Inline]) -> Block -> Block

102−mvCiteInNote is i = if i `elem` is then Note [Para [i]] else i

101+procInlines f b

102+ | Plain inls <- b = Plain $ f inls

103+ | Para inls <- b = Para $ f inls

104+ | Header i inls <- b = Header i $ f inls

105+ | otherwise = b

106+

107+mvCiteInNote :: [Inline] -> Block -> Block

108+mvCiteInNote is = procInlines mvCite

109+ where

110+ elem_ x xs = case x of Cite cs _ -> (Cite cs []) `elem` xs; _ -> False

111+ mvCite :: [Inline] -> [Inline]

112+ mvCite inls

113+ | x:i:xs <- inls

114+ , x == Space, i `elem_` is = mvInNote i : mvCite xs

115+ | i:xs <- inls, i `elem_` is = mvInNote i : mvCite xs

116+ | i:xs <- inls, Note _ <- i = checkNt i : mvCite xs

117+ | i:xs <- inls = i : mvCite xs

118+ | otherwise = []

119+ mvInNote i

120+ | Cite t o <- i = Note [Para [Cite t $ toCapital o]]

121+ | otherwise = Note [Para [i ]]

122+ checkPt i

123+ | Cite c o : xs <- i

124+ , headInline xs == lastInline o

125+ , isPunct o = Cite c (initInline o) : checkPt xs

126+ | x:xs <- i = x : checkPt xs

127+ | otherwise = []

128+ isPunct = and . map isPunctuation . lastInline

129+ checkNt = processWith $ procInlines checkPt

130+

131+headInline :: [Inline] -> String

132+headInline [] = []

133+headInline (i:_)

134+ | Str s <- i = head' s

135+ | Space <- i = " "

136+ | otherwise = headInline $ getInline i

137+ where

138+ head' s = if s /= [] then [head s] else []

139+

140+lastInline :: [Inline] -> String

141+lastInline [] = []

142+lastInline (i:[])

143+ | Str s <- i = last' s

144+ | Space <- i = " "

145+ | otherwise = lastInline $ getInline i

146+ where

147+ last' s = if s /= [] then [last s] else []

148+lastInline (_:xs) = lastInline xs

149+

150+initInline :: [Inline] -> [Inline]

151+initInline [] = []

152+initInline (i:[])

153+ | Str s <- i = return $ Str (init' s)

154+ | Emph is <- i = return $ Emph (initInline is)

155+ | Strong is <- i = return $ Strong (initInline is)

156+ | Strikeout is <- i = return $ Strikeout (initInline is)

157+ | Superscript is <- i = return $ Superscript (initInline is)

158+ | Subscript is <- i = return $ Subscript (initInline is)

159+ | Quoted q is <- i = return $ Quoted q (initInline is)

160+ | SmallCaps is <- i = return $ SmallCaps (initInline is)

161+ | Link is t <- i = return $ Link (initInline is) t

162+ | otherwise = []

163+ where

164+ init' s = if s /= [] then init s else []

165+initInline (i:xs) = i : initInline xs

166+

167+toCapital :: [Inline] -> [Inline]

168+toCapital = mapHeadInline toCap

169+ where

170+ toCap s = if s /= [] then toUpper (head s) : tail s else []

171+

172+mapHeadInline :: (String -> String) -> [Inline] -> [Inline]

173+mapHeadInline _ [] = []

174+mapHeadInline f (i:xs)

175+ | Str s <- i = Str (f s) : xs

176+ | Emph is <- i = Emph (mapHeadInline f is) : xs

177+ | Strong is <- i = Strong (mapHeadInline f is) : xs

178+ | Strikeout is <- i = Strikeout (mapHeadInline f is) : xs

179+ | Superscript is <- i = Superscript (mapHeadInline f is) : xs

180+ | Subscript is <- i = Subscript (mapHeadInline f is) : xs

181+ | Quoted q is <- i = Quoted q (mapHeadInline f is) : xs

182+ | SmallCaps is <- i = SmallCaps (mapHeadInline f is) : xs

183+ | Link is t <- i = Link (mapHeadInline f is) t : xs

184+ | otherwise = []

185+

186+getInline :: Inline -> [Inline]

187+getInline i

188+ | Emph is <- i = is

189+ | Strong is <- i = is

190+ | Strikeout is <- i = is

191+ | Superscript is <- i = is

192+ | Subscript is <- i = is

193+ | Quoted _ is <- i = is

194+ | SmallCaps is <- i = is

195+ | Link is _ <- i = is

196+ | otherwise = []

103

197

104setCiteNoteNum :: [Inline] -> Int -> [Inline]

198setCiteNoteNum :: [Inline] -> Int -> [Inline]

105setCiteNoteNum ((Cite cs o):xs) n = Cite (setCitationNoteNum n cs) o : setCiteNoteNum xs n

199setCiteNoteNum ((Cite cs o):xs) n = Cite (setCitationNoteNum n cs) o : setCiteNoteNum xs n