@@ -30,6 +30,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
3030module Text.Pandoc.Biblio ( processBiblio ) where
3131
3232import Control.Monad ( when )
33+import Data.Char ( toUpper, isPunctuation )
3334import Data.List
3435import Data.Unique
3536import Text.CSL hiding ( Cite(..), Citation(..) )
@@ -44,17 +45,18 @@ processBiblio cf r p
4445 else do
4546 when (null cf) $ error "Missing the needed citation style file"
4647 csl <- readCSLFile cf
47− p' <- if styleClass csl == "note"
48− then processNote p
49− else processWithM setHash p
50− let groups = if styleClass csl /= "note"
51− then queryWith getCitation p'
52− else getNoteCitations p'
53− result = citeproc' csl r (setNearNote csl $ map (map toCslCite) groups)
54− cits_map = zip groups (citations result)
48+ p' <- processWithM setHash p
49+ let (nts,grps) = if styleClass csl /= "note"
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
54+ in (,) needNt $ getNoteCitations needNt p'
55+ result = citeproc' csl r (setNearNote csl $ map (map toCslCite) grps)
56+ cits_map = zip grps (citations result)
5557 biblioList = map (read . renderPandoc' csl) (bibliography result)
5658 Pandoc m b = processWith (processCite csl cits_map) p'
57− return $ Pandoc m $ b ++ biblioList
59+ return . generateNotes nts . Pandoc m $ b ++ biblioList
5860
5961-- | Substitute 'Cite' elements with formatted citations.
6062processCite :: Style -> [([Citation],[FormattedOutput])] -> Inline -> Inline
@@ -70,7 +72,7 @@ processCite s cs il
7072-- 'queryWith'.
7173getCitation :: Inline -> [[Citation]]
7274getCitation i | Cite t _ <- i = [t]
73− | otherwise = []
75+ | otherwise = []
7476
7577getNote :: Inline -> [Inline]
7678getNote i | Note _ <- i = [i]
@@ -80,26 +82,118 @@ getCite :: Inline -> [Inline]
8082getCite i | Cite _ _ <- i = [i]
8183 | otherwise = []
8284
83−getNoteCitations :: Pandoc -> [[Citation]]
84−getNoteCitations
85− = let cits = concat . flip (zipWith $ setCiteNoteNum) [1..] .
86− map (queryWith getCite) . queryWith getNote
87− in queryWith getCitation . cits
85+getNoteCitations :: [Inline] -> Pandoc -> [[Citation]]
86+getNoteCitations needNote
87+ = let mvCite i = if i `elem` needNote then Note [Para [i]] else i
88+ setNote = processWith mvCite
89+ getCits = concat . flip (zipWith $ setCiteNoteNum) [1..] .
90+ map (queryWith getCite) . queryWith getNote . setNote
91+ in queryWith getCitation . getCits
8892
8993setHash :: Citation -> IO Citation
9094setHash (Citation i p l nn ao na _)
9195 = hashUnique `fmap` newUnique >>= return . Citation i p l nn ao na
9296
93−processNote :: Pandoc -> IO 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'
97+generateNotes :: [Inline] -> Pandoc -> Pandoc
98+generateNotes needNote = processWith (mvCiteInNote needNote)
10099
101−mvCiteInNote :: [Inline] -> Inline -> Inline
102−mvCiteInNote is i = if i `elem` is then Note [Para [i]] else i
100+procInlines :: ([Inline] -> [Inline]) -> Block -> Block
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 = []
103197
104198setCiteNoteNum :: [Inline] -> Int -> [Inline]
105199setCiteNoteNum ((Cite cs o):xs) n = Cite (setCitationNoteNum n cs) o : setCiteNoteNum xs n