pandoc-citeproc 0.16.4.1 → 0.17
raw patch · 28 files changed
+1061/−936 lines, 28 filesdep ~rfc5051
Dependency ranges changed: rfc5051
Files
- changelog +9/−0
- compat/Text/CSL/Compat/Pandoc.hs +17/−17
- pandoc-citeproc.cabal +1/−1
- pandoc-citeproc.hs +6/−5
- src/Text/CSL/Data.hs +27/−20
- src/Text/CSL/Eval.hs +111/−101
- src/Text/CSL/Eval/Common.hs +37/−34
- src/Text/CSL/Eval/Date.hs +47/−43
- src/Text/CSL/Eval/Names.hs +50/−48
- src/Text/CSL/Eval/Output.hs +33/−31
- src/Text/CSL/Input/Bibtex.hs +153/−144
- src/Text/CSL/Input/Bibutils.hs +19/−15
- src/Text/CSL/Output/Pandoc.hs +16/−15
- src/Text/CSL/Output/Plain.hs +2/−1
- src/Text/CSL/Pandoc.hs +95/−79
- src/Text/CSL/Parser.hs +42/−46
- src/Text/CSL/Proc.hs +33/−32
- src/Text/CSL/Proc/Collapse.hs +20/−17
- src/Text/CSL/Proc/Disamb.hs +23/−20
- src/Text/CSL/Reference.hs +39/−38
- src/Text/CSL/Style.hs +149/−142
- src/Text/CSL/Util.hs +63/−53
- stack.yaml +6/−5
- tests/issue437.csl +26/−0
- tests/issue437.expected.native +3/−0
- tests/issue437.in.native +3/−0
- tests/test-citeproc.hs +20/−18
- tests/test-pandoc-citeproc.hs +11/−11
changelog view
@@ -1,3 +1,12 @@+pandoc-citeproc (0.17)++ * Only print labels if selected variable is non-empty (#437).+ * Make reference-section-title work even when doc ends with header (#431).+ Previously, setting `reference-section-title` wouldn't do anything+ when the document ended with a header -- contrary to what the+ documentation suggests.+ * Use Text instead of String (#430, Albert Krewinkel).+ pandoc-citeproc (0.16.4.1) * Allow pandoc 2.9.
compat/Text/CSL/Compat/Pandoc.hs view
@@ -18,9 +18,9 @@ import System.Exit (ExitCode) import Data.ByteString.Lazy as BL import Data.ByteString as B-import Text.Pandoc (Pandoc, ReaderOptions(..), def, WrapOption(..),- WriterOptions(..))-import Text.Pandoc (Extension(..), pandocExtensions)+import Data.Text (Text)+import Text.Pandoc (Extension (..), Pandoc, ReaderOptions(..), WrapOption(..),+ WriterOptions(..), def, pandocExtensions) import qualified Text.Pandoc as Pandoc import qualified Text.Pandoc.Process import qualified Data.Text as T@@ -31,36 +31,36 @@ import Control.Monad.Except (runExceptT, lift) import Text.Pandoc.Extensions (extensionsFromList, disableExtension) -readHtml, readLaTeX, readMarkdown, readNative :: String -> Pandoc-writeMarkdown, writePlain, writeNative, writeHtmlString :: Pandoc -> String-+readHtml :: Text -> Pandoc readHtml = either mempty id . runPure . Pandoc.readHtml def{ readerExtensions = extensionsFromList [Ext_native_divs,- Ext_native_spans, Ext_raw_html, Ext_smart] } .- T.pack+ Ext_native_spans, Ext_raw_html, Ext_smart] } +readMarkdown :: Text -> Pandoc readMarkdown = either mempty id . runPure . Pandoc.readMarkdown- def{ readerExtensions = pandocExtensions, readerStandalone = True } .- T.pack+ def{ readerExtensions = pandocExtensions, readerStandalone = True } +readLaTeX :: Text -> Pandoc readLaTeX = either mempty id . runPure . Pandoc.readLaTeX- def{ readerExtensions = extensionsFromList [Ext_raw_tex, Ext_smart] } .- T.pack+ def{ readerExtensions = extensionsFromList [Ext_raw_tex, Ext_smart] } -readNative = either mempty id . runPure . Pandoc.readNative def . T.pack+readNative :: Text -> Pandoc+readNative = either mempty id . runPure . Pandoc.readNative def -writeMarkdown = either mempty T.unpack . runPure . Pandoc.writeMarkdown+writeMarkdown, writePlain, writeNative, writeHtmlString :: Pandoc -> Text++writeMarkdown = either mempty id . runPure . Pandoc.writeMarkdown def{ writerExtensions = disableExtension Ext_smart $ disableExtension Ext_bracketed_spans $ disableExtension Ext_raw_attribute $ pandocExtensions, writerWrapText = WrapNone } -writePlain = either mempty T.unpack . runPure . Pandoc.writePlain def+writePlain = either mempty id . runPure . Pandoc.writePlain def -writeNative = either mempty T.unpack . runPure . Pandoc.writeNative def{ writerTemplate = Just mempty }+writeNative = either mempty id . runPure . Pandoc.writeNative def{ writerTemplate = Just mempty } -writeHtmlString = either mempty T.unpack . runPure . Pandoc.writeHtml4String+writeHtmlString = either mempty id . runPure . Pandoc.writeHtml4String def{ writerExtensions = extensionsFromList [Ext_native_divs, Ext_native_spans, Ext_raw_html], writerWrapText = WrapPreserve }
pandoc-citeproc.cabal view
@@ -1,5 +1,5 @@ name: pandoc-citeproc-version: 0.16.4.1+version: 0.17 cabal-version: 1.12 synopsis: Supports using pandoc with citeproc
pandoc-citeproc.hs view
@@ -17,7 +17,7 @@ import Data.Char (chr, toLower) import Data.List (group, sort) import qualified Data.Text as T-import Data.Text.Encoding (encodeUtf8)+import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Data.Version (showVersion) import Data.Yaml.Builder (toByteStringWith, setWidth) import Text.Libyaml (defaultFormatOptions)@@ -87,9 +87,9 @@ ("Unknown format\n" ++ header) options exitWith $ ExitFailure 4 bibstring <- case args of- [] -> UTF8.getContents- xs -> mconcat <$> mapM UTF8.readFile xs- readBiblioString (const True) bibformat bibstring >>=+ [] -> B.getContents+ xs -> mconcat <$> mapM B.readFile xs+ readBiblioString (const True) bibformat (decodeUtf8 bibstring) >>= (if Quiet `elem` flags then return else warnDuplicateKeys) >>= if Bib2YAML `elem` flags then outputYamlBlock .@@ -169,7 +169,8 @@ warnDuplicateKeys :: [Reference] -> IO [Reference] warnDuplicateKeys refs = mapM_ warnDup dupKeys >> return refs- where warnDup k = UTF8.hPutStrLn stderr $ "biblio2yaml: duplicate key " ++ k+ where warnDup k = UTF8.hPutStrLn stderr $+ "biblio2yaml: duplicate key " ++ T.unpack k allKeys = map (unLiteral . refId) refs dupKeys = [x | (x:_:_) <- group (sort allKeys)]
src/Text/CSL/Data.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Data@@ -25,6 +26,8 @@ import Prelude import qualified Control.Exception as E import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T+import Data.Text (Text) import Data.Typeable import System.FilePath () import Data.Maybe (fromMaybe)@@ -37,47 +40,51 @@ #endif data CSLLocaleException =- CSLLocaleNotFound String+ CSLLocaleNotFound Text | CSLLocaleReadError E.IOException deriving Typeable instance Show CSLLocaleException where- show (CSLLocaleNotFound s) = "Could not find locale data for " ++ s+ show (CSLLocaleNotFound s) = "Could not find locale data for " ++ T.unpack s show (CSLLocaleReadError e) = show e instance E.Exception CSLLocaleException -- | Raises 'CSLLocaleException' on error.-getLocale :: String -> IO L.ByteString+getLocale :: Text -> IO L.ByteString getLocale s = do- let baseLocale = takeWhile (/='.') s+ let baseLocale = T.takeWhile (/='.') s #ifdef EMBED_DATA_FILES let toLazy x = L.fromChunks [x] let returnDefaultLocale = maybe (E.throwIO $ CSLLocaleNotFound "en-US") (return . toLazy) $ lookup "locales-en-US.xml" localeFiles- case length baseLocale of+ case T.length baseLocale of 0 -> returnDefaultLocale 1 | baseLocale == "C" -> returnDefaultLocale- _ -> case lookup ("locales-" ++ baseLocale ++ ".xml") localeFiles of+ _ -> let localeFile = T.unpack ("locales-" <>+ baseLocale <> ".xml")+ in case lookup localeFile localeFiles of Just x' -> return $ toLazy x' Nothing -> -- try again with 2-letter locale (lang only)- let shortLocale = takeWhile (/='-') baseLocale in- case lookup ("locales-" ++ fromMaybe shortLocale- (lookup shortLocale langBase) ++ ".xml")- localeFiles of- Just x'' -> return $ toLazy x''- _ -> E.throwIO $ CSLLocaleNotFound s+ let shortLocale = T.takeWhile (/='-') baseLocale+ lang = fromMaybe shortLocale $+ lookup shortLocale langBase+ slFile = T.unpack $ T.concat ["locales-",lang,".xml"]+ in+ case lookup slFile localeFiles of+ Just x'' -> return $ toLazy x''+ _ -> E.throwIO $ CSLLocaleNotFound s #else- f <- getDataFileName $- case length baseLocale of+ f <- getDataFileName . T.unpack $+ case T.length baseLocale of 0 -> "locales/locales-en-US.xml" 1 | baseLocale == "C" -> "locales/locales-en-US.xml"- 2 -> "locales/locales-" ++- fromMaybe s (lookup s langBase) ++ ".xml"- _ -> "locales/locales-" ++ take 5 s ++ ".xml"+ 2 -> "locales/locales-" <>+ fromMaybe s (lookup s langBase) <> ".xml"+ _ -> "locales/locales-" <> T.take 5 s <> ".xml" exists <- doesFileExist f- if not exists && length baseLocale > 2- then getLocale $ dropWhile (/='-') baseLocale+ if not exists && T.compareLength baseLocale 2 == GT+ then getLocale $ T.dropWhile (/='-') baseLocale -- try again with lang only else E.handle (E.throwIO . CSLLocaleReadError) $ L.readFile f #endif@@ -106,7 +113,7 @@ getDataFileName "LICENSE" >>= L.readFile #endif -langBase :: [(String, String)]+langBase :: [(Text, Text)] langBase = [("af", "af-ZA") ,("bg", "bg-BG")
src/Text/CSL/Eval.hs view
@@ -29,10 +29,11 @@ import Control.Arrow import qualified Control.Exception as E import Control.Monad.State-import Data.Char (isDigit, isLetter, toLower)+import Data.Char (isDigit, isLetter) import Data.Maybe import Data.Monoid (Any (..)) import Data.String (fromString)+import Data.Text (Text) import qualified Data.Text as T import Text.Pandoc.Definition (Inline (Link, Span, Str), nullAttr) import Text.Pandoc.Shared (stringify, escapeURI)@@ -46,7 +47,7 @@ import Text.CSL.Output.Plain import Text.CSL.Reference import Text.CSL.Style hiding (Any)-import Text.CSL.Util (orIfNull, isRange, last', proc,+import Text.CSL.Util (isRange, proc, proc', query, readNum, safeRead) -- | Produce the output with a 'Layout', the 'EvalMode', a 'Bool'@@ -64,7 +65,7 @@ | otherwise -> suppTC x locale = case l of [x] -> x- _ -> Locale [] [] [] [] []+ _ -> Locale "" "" [] [] [] job = evalElements es cit = case em of EvalCite c -> c@@ -72,7 +73,7 @@ EvalBiblio c -> c initSt = EvalState (mkRefMap mbr) (Env cit (localeTerms locale) m (localeDate locale) o [] a) [] em b False [] [] False [] [] []- suppTC = let getLang = take 2 . map toLower in+ suppTC = let getLang = T.take 2 . T.toLower in case (getLang $ localeLang locale, getLang . unLiteral . language <$> mbr) of (_, Just "en") -> id@@ -93,23 +94,23 @@ -- last name and the first. OSpace is used for the latter. removeDelimAndLabel OSpace{} = OStr "," emptyFormatting removeDelimAndLabel x = x- format (s,e) = applaySort s . render $ uncurry eval e- eval o e = evalLayout (Layout emptyFormatting [] [e]) m False l ms o as mbr- applaySort c s+ format (s,e) = applySort s . render $ uncurry eval e+ eval o e = evalLayout (Layout emptyFormatting "" [e]) m False l ms o as mbr+ applySort c s | Ascending {} <- c = Ascending s | otherwise = Descending s - unsetOpts :: (String, String) -> (String, String)+ unsetOpts :: (Text, Text) -> (Text, Text) unsetOpts ("et-al-min" ,_) = ("et-al-min" ,"") unsetOpts ("et-al-use-first" ,_) = ("et-al-use-first" ,"") unsetOpts ("et-al-subsequent-min" ,_) = ("et-al-subsequent-min","") unsetOpts ("et-al-subsequent-use-first",_) = ("et-al-subsequent-use-first","") unsetOpts x = x- setOpts s i = if i /= 0 then (s, show i) else ([],[])+ setOpts s i = if i /= 0 then (s, T.pack $ show i) else ("","") sorting s = case s of SortVariable str s' -> (s', ( ("name-as-sort-order","all") : opts- , Variable [str] Long emptyFormatting []))+ , Variable [str] Long emptyFormatting "")) SortMacro str s' a b c -> (s', ( setOpts "et-al-min" a : ("et-al-use-last",c) : setOpts "et-al-use-first" b : proc unsetOpts opts , Macro str emptyFormatting))@@ -161,15 +162,17 @@ else return [Output res fm] | otherwise = return [] where- addSpaces strng = (if take 1 strng == " " then (OSpace:) else id) .- (if last' strng == " " then (++[OSpace]) else id)+ addSpaces strng = (if T.take 1 strng == " " then (OSpace:) else id) .+ (if (== Just ' ') (snd <$> T.unsnoc strng)+ then (++[OSpace])+ else id) substituteWith e = gets (names . env) >>= \case (Names _ ns fm d _ : _) -> evalElement $ proc replaceNames e where- replaceNames (Names rs [Name NotSet fm'' [] [] []] fm' d' []) =+ replaceNames (Names rs [Name NotSet fm'' [] "" []] fm' d' []) = let nfm = mergeFM fm'' $ mergeFM fm' fm in- Names rs ns nfm (d' `orIfNull` d) []+ Names rs ns nfm (if T.null d' then d else d') [] replaceNames x = x _ -> return [] @@ -225,13 +228,13 @@ | isTitleVar s || isTitleShortVar s = consumeVariable s >> formatTitle s f fm | otherwise =- case map toLower s of+ case T.toLower s of "first-reference-note-number" -> do refid <- getStringVar "ref-id"- return [Output [OPan [Span ("",["first-reference-note-number"],[("refid",T.pack refid)]) [Str "0"]]] fm]+ return [Output [OPan [Span ("",["first-reference-note-number"],[("refid",refid)]) [Str "0"]]] fm] "year-suffix" -> getStringVar "ref-id" >>= \k ->- return . return $ OYearSuf [] k [] fm+ return . return $ OYearSuf "" k [] fm "status" -> do (opts, as) <- gets (env >>> options &&& abbrevs) r <- getVar mempty (getFormattedValue opts as f fm s)@@ -241,28 +244,30 @@ "page" -> getStringVar "page" >>= formatRange fm "locator" -> getLocVar >>= formatRange fm . snd "url" -> getStringVar "url" >>= \k ->- if null k then return [] else return [Output [OPan [Link nullAttr [Str $ T.pack k] (escapeURI $ T.pack k,"")]] fm]+ if T.null k+ then return []+ else return [Output [OPan [Link nullAttr [Str k] (escapeURI k,"")]] fm] "doi" -> do d <- getStringVar "doi"- let (prefixPart, linkPart) = T.breakOn (T.pack "http") (T.pack (prefix fm))+ let (prefixPart, linkPart) = T.breakOn (T.pack "http") (prefix fm) let u = if T.null linkPart- then "https://doi.org/" ++ d- else T.unpack linkPart ++ d- if null d+ then "https://doi.org/" <> d+ else linkPart <> d+ if T.null d then return []- else return [Output [OPan [Link nullAttr [Str (linkPart <> T.pack d)] (escapeURI $ T.pack u, "")]]- fm{ prefix = T.unpack prefixPart, suffix = suffix fm }]+ else return [Output [OPan [Link nullAttr [Str (linkPart <> d)] (escapeURI u, "")]]+ fm{ prefix = prefixPart, suffix = suffix fm }] "isbn" -> getStringVar "isbn" >>= \d ->- if null d+ if T.null d then return []- else return [Output [OPan [Link nullAttr [Str $ T.pack d] ("https://worldcat.org/isbn/" <> escapeURI (T.pack d), "")]] fm]+ else return [Output [OPan [Link nullAttr [Str d] ("https://worldcat.org/isbn/" <> escapeURI d, "")]] fm] "pmid" -> getStringVar "pmid" >>= \d ->- if null d+ if T.null d then return []- else return [Output [OPan [Link nullAttr [Str $ T.pack d] ("https://www.ncbi.nlm.nih.gov/pubmed/" <> escapeURI (T.pack d), "")]] fm]+ else return [Output [OPan [Link nullAttr [Str d] ("https://www.ncbi.nlm.nih.gov/pubmed/" <> escapeURI d, "")]] fm] "pmcid" -> getStringVar "pmcid" >>= \d ->- if null d+ if T.null d then return []- else return [Output [OPan [Link nullAttr [Str $ T.pack d] ("https://www.ncbi.nlm.nih.gov/pmc/articles/" <> escapeURI (T.pack d), "")]] fm]+ else return [Output [OPan [Link nullAttr [Str d] ("https://www.ncbi.nlm.nih.gov/pmc/articles/" <> escapeURI d, "")]] fm] _ -> do (opts, as) <- gets (env >>> options &&& abbrevs) r <- getVar [] (getFormattedValue opts as f fm s) s@@ -290,11 +295,12 @@ _ -> return [False] xs -> mapM a xs - chkType t = let chk = (==) (formatVariable t) . show . fromMaybe NoType . fromValue+ chkType t = let chk = (==) (formatVariable t) . T.pack . show+ . fromMaybe NoType . fromValue in getVar False chk "ref-type" chkNumeric v = do val <- getStringVar v as <- gets (abbrevs . env)- let val' = if null (getAbbreviation as v val)+ let val' = if T.null (getAbbreviation as v val) then val else getAbbreviation as v val return (isNumericString val')@@ -302,7 +308,8 @@ chkPosition s = if s == "near-note" then gets (nearNote . cite . env) else compPosition s <$> gets (citePosition . cite . env)- chkDisambiguate s = (==) (formatVariable s) . map toLower . show <$> gets disamb+ chkDisambiguate s = (==) (formatVariable s) . T.toLower . T.pack . show+ <$> gets disamb chkLocator v = (==) v . fst <$> getLocVar isIbid s = not (s == "first" || s == "subsequent") compPosition a b@@ -312,42 +319,43 @@ b == "ibid-with-locator-c" | otherwise = isIbid b -getFormattedValue :: [Option] -> Abbreviations -> Form -> Formatting -> String -> Value -> [Output]+getFormattedValue :: [Option] -> Abbreviations -> Form -> Formatting -> Text -> Value -> [Output] getFormattedValue o as f fm s val | Just (Formatted v) <- fromValue val :: Maybe Formatted = case v of [] -> []- _ -> case maybe v (unFormatted . fromString) $ getAbbr (T.unpack $ stringify v) of+ _ -> case maybe v (unFormatted . fromString . T.unpack) $+ getAbbr (stringify v) of [] -> [] ys -> [Output [(if s == "status" then OStatus else OPan) $ walk value' ys] fm]- | Just v <- fromValue val :: Maybe String =+ | Just v <- fromValue val :: Maybe Text = case value v of- [] -> []+ "" -> [] xs -> case getAbbr xs of Nothing -> [OStr xs fm] Just ys -> [OStr ys fm] | Just (Literal v) <- fromValue val :: Maybe Literal = case value v of- [] -> []+ "" -> [] xs -> case getAbbr xs of Nothing -> [OStr xs fm] Just ys -> [OStr ys fm]- | Just v <- fromValue val :: Maybe Int = output fm (if v == 0 then [] else show v)+ | Just v <- fromValue val :: Maybe Int = output fm (if v == 0 then "" else T.pack $ show v) | Just v <- fromValue val :: Maybe CNum = if v == 0 then [] else [OCitNum (unCNum v) fm] | Just v <- fromValue val :: Maybe CLabel = if v == mempty then [] else [OCitLabel (unCLabel v) fm]- | Just v <- fromValue val :: Maybe [RefDate] = formatDate (EvalSorting emptyCite) [] [] sortDate v+ | Just v <- fromValue val :: Maybe [RefDate] = formatDate (EvalSorting emptyCite) "" [] sortDate v | Just v <- fromValue val :: Maybe [Agent] = concatMap (formatName (EvalSorting emptyCite) True f fm nameOpts []) v | otherwise = [] where- value = if stripPeriods fm then filter (/= '.') else id- value' (Str x) = Str $ T.pack $ value $ T.unpack x+ value = if stripPeriods fm then T.filter (/= '.') else id+ value' (Str x) = Str $ value x value' x = x getAbbr v = if f == Short then case getAbbreviation as s v of- [] -> Nothing+ "" -> Nothing y -> Just y else Nothing nameOpts = ("name-as-sort-order","all") : o@@ -355,10 +363,10 @@ , DatePart "month" "numeric-leading-zeros" "" emptyFormatting , DatePart "day" "numeric-leading-zeros" "" emptyFormatting] -formatTitle :: String -> Form -> Formatting -> State EvalState [Output]+formatTitle :: Text -> Form -> Formatting -> State EvalState [Output] formatTitle s f fm | Short <- f- , isTitleVar s = try (getIt $ s ++ "-short") $ getIt s+ , isTitleVar s = try (getIt $ s <> "-short") $ getIt s | isTitleShortVar s = try (getIt s) $ (:[]) . flip OStr fm <$> getTitleShort s | otherwise = getIt s where@@ -368,32 +376,33 @@ a <- gets (abbrevs . env) getVar [] (getFormattedValue o a f fm x) x -formatNumber :: NumericForm -> Formatting -> String -> String -> State EvalState [Output]+formatNumber :: NumericForm -> Formatting -> Text -> Text -> State EvalState [Output] formatNumber f fm v n = gets (abbrevs . env) >>= \as -> if isNumericString (getAbbr as n) then output fm . flip process (getAbbr as n) <$> gets (terms . env) else return . output fm . getAbbr as $ n where- getAbbr as = if null (getAbbreviation as v n)+ getAbbr as = if T.null (getAbbreviation as v n) then id else getAbbreviation as v checkRange' ts = if v == "page" then checkRange ts else id process ts = checkRange' ts . printNumStr . map (renderNumber ts) .- breakNumericString . words- renderNumber ts x = if isTransNumber x then format ts (T.pack x) else x+ breakNumericString . T.words+ renderNumber ts x = if isTransNumber x then format ts x else x format tm = case f of Ordinal -> maybe "" (ordinal tm v) . safeRead LongOrdinal -> maybe "" (longOrdinal tm v) . safeRead Roman -> maybe ""- (\x -> if x < 6000 then roman x else show x) .+ (\x -> if x < 6000 then roman x else T.pack $ show x) . safeRead- _ -> maybe "" show . (safeRead :: T.Text -> Maybe Int)+ _ -> maybe "" (T.pack . show) .+ (safeRead :: T.Text -> Maybe Int) - roman :: Int -> String- roman = concat . reverse . zipWith (!!) romanList .- map (readNum . return) . take 4 .+ roman :: Int -> Text+ roman = T.concat . reverse . zipWith (!!) romanList .+ map (readNum . T.singleton) . take 4 . reverse . show romanList = [[ "", "i", "ii", "iii", "iv", "v", "vi", "vii", "viii", "ix" ] ,[ "", "x", "xx", "xxx", "xl", "l", "lx", "lxx", "lxxx", "xc" ]@@ -402,64 +411,67 @@ ] -checkRange :: [CslTerm] -> String -> String-checkRange _ [] = []-checkRange ts (x:xs) = if x == '-' || x == '\x2013'- then pageRange ts ++ checkRange ts xs- else x : checkRange ts xs+checkRange :: [CslTerm] -> Text -> Text+checkRange ts txt = case T.uncons txt of+ Just (x,xs) -> if x == '-' || x == '\x2013'+ then pageRange ts <> checkRange ts xs+ else T.cons x $ checkRange ts xs+ Nothing -> "" -printNumStr :: [String] -> String-printNumStr [] = []+printNumStr :: [Text] -> Text+printNumStr [] = "" printNumStr [x] = x-printNumStr (x:"-":y:xs) = x ++ "-" ++ y ++ printNumStr xs-printNumStr (x:",":y:xs) = x ++ ", " ++ y ++ printNumStr xs+printNumStr (x:"-":y:xs) = T.concat [x, "-" , y, printNumStr xs]+printNumStr (x:",":y:xs) = T.concat [x, ", ", y, printNumStr xs] printNumStr (x:xs)- | x == "-" = x ++ printNumStr xs- | otherwise = x ++ " " ++ printNumStr xs+ | x == "-" = x <> printNumStr xs+ | otherwise = x <> " " <> printNumStr xs -pageRange :: [CslTerm] -> String+pageRange :: [CslTerm] -> Text pageRange = maybe "\x2013" termPlural . findTerm "page-range-delimiter" Long -isNumericString :: String -> Bool-isNumericString [] = False-isNumericString s = all (\c -> isNumber c || isSpecialChar c) $ words s+isNumericString :: Text -> Bool+isNumericString "" = False+isNumericString s = all (\c -> isNumber c || isSpecialChar c) $ T.words s -isTransNumber, isSpecialChar,isNumber :: String -> Bool-isTransNumber = all isDigit-isSpecialChar = all (`elem` ("&-,.\x2013" :: String))-isNumber cs = case [c | c <- cs+isTransNumber, isSpecialChar,isNumber :: Text -> Bool+isTransNumber = T.all isDigit+isSpecialChar = T.all (`elem` ("&-,.\x2013" :: String))+isNumber cs = case [c | c <- T.unpack cs , not (isLetter c) , c `notElem` ("&-.,\x2013" :: String)] of [] -> False xs -> all isDigit xs -breakNumericString :: [String] -> [String]+breakNumericString :: [Text] -> [Text] breakNumericString [] = [] breakNumericString (x:xs) | isTransNumber x = x : breakNumericString xs- | otherwise = let (a,b) = break (`elem` ("&-\x2013," :: String)) x- (c,d) = if null b+ | otherwise = let (a,b) = T.break (`elem` ("&-\x2013," :: String)) x+ (c,d) = if T.null b then ("","")- else span (`elem` ("&-\x2013," :: String)) b- in filter (/= []) $ a : c : breakNumericString (d : xs)+ else T.span (`elem` ("&-\x2013," :: String)) b+ in filter (not . T.null) $+ a : c : breakNumericString (d : xs) -formatRange :: Formatting -> String -> State EvalState [Output]-formatRange _ [] = return []+formatRange :: Formatting -> Text -> State EvalState [Output]+formatRange _ "" = return [] formatRange fm p = do ops <- gets (options . env) ts <- gets (terms . env) let opt = getOptionVal "page-range-format" ops- pages = tupleRange . breakNumericString . words $ p+ pages = tupleRange . breakNumericString . T.words $ p + tupleRange :: [Text] -> [(Text, Text)] tupleRange [] = [] tupleRange [x, cs]- | cs `elem` ["-", "--", "\x2013"] = return (x,[])+ | cs `elem` ["-", "--", "\x2013"] = return (x,"") tupleRange (x:cs:y:xs) | cs `elem` ["-", "--", "\x2013"] = (x, y) : tupleRange xs- tupleRange (x: xs) = (x,[]) : tupleRange xs+ tupleRange (x: xs) = (x,"") : tupleRange xs - joinRange (a, []) = a- joinRange (a, b) = a ++ "-" ++ b+ joinRange (a, "") = a+ joinRange (a, b) = a <> "-" <> b process = checkRange ts . printNumStr . case opt of "expanded" -> map (joinRange . expandedRange)@@ -471,14 +483,14 @@ -- Abbreviated page ranges are expanded to their non-abbreviated form: -- 42–45, 321–328, 2787–2816-expandedRange :: (String, String) -> (String, String)-expandedRange (sa, []) = (sa,[])+expandedRange :: (Text, Text) -> (Text, Text)+expandedRange (sa, "") = (sa,"") expandedRange (sa, sb)- | length sb < length sa =- case (safeRead (T.pack sa), safeRead (T.pack sb)) of+ | T.length sb < T.length sa =+ case (safeRead sa, safeRead sb) of -- check to make sure we have regular numbers (Just (_ :: Int), Just (_ :: Int)) ->- (sa, take (length sa - length sb) sa ++ sb)+ (sa, T.take (T.length sa - T.length sb) sa <> sb) _ -> (sa, sb) | otherwise = (sa, sb) @@ -486,14 +498,12 @@ -- 42–5, 321–8, 2787–816. The minDigits parameter indicates -- a minimum number of digits for the second number; thus, with -- minDigits = 2, we have 328-28.-minimalRange :: Int -> (String, String) -> (String, String)-minimalRange minDigits (a:as, b:bs)- | a == b- , length as == length bs- , length bs >= minDigits =- let (_, bs') = minimalRange minDigits (as, bs)- in (a:as, bs')-minimalRange _ (as, bs) = (as, bs)+minimalRange :: Int -> (Text, Text) -> (Text, Text)+minimalRange minDigits (a,b) =+ case T.commonPrefixes a b of+ Just (_, a', b') | T.length a' == T.length b' ->+ (a, T.takeEnd (max minDigits (T.length b')) b)+ _ -> (a, b) -- Page ranges are abbreviated according to the Chicago Manual of Style-rules: -- First number Second number Examples@@ -503,13 +513,13 @@ -- 110 through 199 Use 2 digits or more 321-25, 415-532 -- if numbers are 4 digits long or more and 3 digits change, use all digits -- 1496-1504-chicagoRange :: (String, String) -> (String, String)+chicagoRange :: (Text, Text) -> (Text, Text) chicagoRange (sa, sb)- = case (safeRead (T.pack sa) :: Maybe Int) of+ = case (safeRead sa :: Maybe Int) of Just n | n < 100 -> expandedRange (sa, sb) | n `mod` 100 == 0 -> expandedRange (sa, sb) | n >= 1000 -> let (sa', sb') = minimalRange 1 (sa, sb)- in if length sb' >= 3+ in if T.length sb' >= 3 then expandedRange (sa, sb) else (sa', sb') | n > 100 -> if n `mod` 100 < 10
src/Text/CSL/Eval/Common.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} #if MIN_VERSION_base(4,9,0) {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}@@ -26,6 +27,7 @@ import Data.List (elemIndex) import qualified Data.Map as M import Data.Maybe+import Data.Text (Text) import qualified Data.Text as T import Text.CSL.Reference@@ -38,12 +40,12 @@ = EvalState { ref :: ReferenceMap , env :: Environment- , debug :: [String]+ , debug :: [Text] , mode :: EvalMode , disamb :: Bool , consume :: Bool- , authSub :: [String]- , consumed :: [String]+ , authSub :: [Text]+ , consumed :: [Text] , edtrans :: Bool , etal :: [[Output]] , contNum :: [Agent]@@ -72,35 +74,35 @@ -- | With the variable name and the variable value search for an -- abbreviation or return an empty string.-getAbbreviation :: Abbreviations -> String -> String -> String+getAbbreviation :: Abbreviations -> Text -> Text -> Text getAbbreviation (Abbreviations as) s v- = maybe [] id $ M.lookup "default" as >>=- M.lookup (if s `elem` numericVars then "number" else s) >>=- M.lookup v+ = fromMaybe "" $ M.lookup "default" as >>=+ M.lookup (if s `elem` numericVars then "number" else s) >>=+ M.lookup v -- | If the first parameter is 'True' the plural form will be retrieved.-getTerm :: Bool -> Form -> String -> State EvalState String-getTerm b f s = maybe [] g . findTerm s f' <$> gets (terms . env) -- FIXME: vedere i fallback+getTerm :: Bool -> Form -> Text -> State EvalState Text+getTerm b f s = maybe "" g . findTerm s f' <$> gets (terms . env) -- FIXME: vedere i fallback where g = if b then termPlural else termSingular f' = case f of NotSet -> Long; _ -> f -getStringVar :: String -> State EvalState String+getStringVar :: Text -> State EvalState Text getStringVar- = getVar [] getStringValue+ = getVar "" getStringValue -getDateVar :: String -> State EvalState [RefDate]+getDateVar :: Text -> State EvalState [RefDate] getDateVar = getVar [] getDateValue where getDateValue = maybe [] id . fromValue -getLocVar :: State EvalState (String,String)+getLocVar :: State EvalState (Text,Text) getLocVar = gets (env >>> cite >>> citeLabel &&& citeLocator) -getVar :: a -> (Value -> a) -> String -> State EvalState a+getVar :: a -> (Value -> a) -> Text -> State EvalState a getVar a f s = withRefMap $ maybe a f . lookup (formatVariable s) -getAgents :: String -> State EvalState [Agent]+getAgents :: Text -> State EvalState [Agent] getAgents s = do mv <- withRefMap (lookup s)@@ -110,7 +112,7 @@ _ -> return [] _ -> return [] -getAgents' :: String -> State EvalState [Agent]+getAgents' :: Text -> State EvalState [Agent] getAgents' s = do mv <- withRefMap (lookup s)@@ -120,42 +122,43 @@ _ -> return [] _ -> return [] -getStringValue :: Value -> String+getStringValue :: Value -> Text getStringValue val = -- The second clause handles the case where we have a Formatted -- but need a String. This is currently needed for "page". It's a bit -- hackish; we should probably change the type in Reference for -- page to String.- case fromValue val `mplus` ((T.unpack . stringify . unFormatted) `fmap` fromValue val)+ case fromValue val `mplus` ((stringify . unFormatted) `fmap` fromValue val) `mplus` (unLiteral `fmap` fromValue val) of Just v -> v Nothing -> Debug.Trace.trace ("Expecting string value, got " ++- show val) []+ show val) T.empty -getOptionVal :: String -> [Option] -> String-getOptionVal s = fromMaybe [] . lookup s+getOptionVal :: Text -> [Option] -> Text+getOptionVal s = fromMaybe "" . lookup s -getOptionValWithDefault :: String -> String -> [Option] -> String+getOptionValWithDefault :: Text -> Text -> [Option] -> Text getOptionValWithDefault s defvalue = fromMaybe defvalue . lookup s -isOptionSet :: String -> [Option] -> Bool-isOptionSet s = maybe False (not . null) . lookup s+isOptionSet :: Text -> [Option] -> Bool+isOptionSet s = maybe False (not . T.null) . lookup s -isTitleVar, isTitleShortVar :: String -> Bool+isTitleVar, isTitleShortVar :: Text -> Bool isTitleVar = flip elem ["title", "container-title", "collection-title"] isTitleShortVar = flip elem ["title-short", "container-title-short"] -getTitleShort :: String -> State EvalState String-getTitleShort s = do let s' = take (length s - 6) s -- drop '-short'+getTitleShort :: Text -> State EvalState Text+getTitleShort s = do let s' = T.dropEnd 6 s -- drop '-short' v <- getStringVar s' abbrs <- gets (abbrevs . env) return $ getAbbreviation abbrs s' v -isVarSet :: String -> State EvalState Bool+isVarSet :: Text -> State EvalState Bool isVarSet s | isTitleShortVar s = do r <- getVar False isValueSet s- if r then return r- else return . not . null =<< getTitleShort s+ if r+ then return r+ else fmap (not . T.null) (getTitleShort s) | otherwise = if s /= "locator" then getVar False isValueSet s else getLocVar >>= return . (/=) "" . snd@@ -164,11 +167,11 @@ withRefMap f = return . f =<< gets ref -- | Convert variable to lower case, translating underscores ("_") to dashes ("-")-formatVariable :: String -> String-formatVariable = foldr f []- where f x xs = if x == '_' then '-' : xs else toLower x : xs+formatVariable :: Text -> Text+formatVariable = T.foldr f T.empty+ where f x xs = if x == '_' then '-' `T.cons` xs else toLower x `T.cons` xs -consumeVariable :: String -> State EvalState ()+consumeVariable :: Text -> State EvalState () consumeVariable s = do b <- gets consume when b $ modify $ \st -> st { consumed = s : consumed st }
src/Text/CSL/Eval/Date.hs view
@@ -21,9 +21,9 @@ import qualified Control.Exception as E import Control.Monad.State -import Data.List import Data.List.Split import Data.Maybe (fromMaybe, isNothing)+import Data.Text (Text) import qualified Data.Text as T import Text.CSL.Exception@@ -52,14 +52,14 @@ (updateS aj bj) (if bk /= ak then bk else ak) al am an ahl- updateS a b = if b /= a && b /= [] then b else a+ updateS a b = if b /= a && b /= "" then b else a case f of NoFormDate -> outputList fm dl . concatMap (formatDate em k tm dp) <$> mapM getDateVar s _ -> do res <- getDate f case res of Date _ _ lfm ldl ldp _ -> do- let go dps = return . outputList (updateFM fm lfm) (if ldl /= [] then ldl else dl) .+ let go dps = return . outputList (updateFM fm lfm) (if ldl /= "" then ldl else dl) . concatMap (formatDate em k tm dps) update l x@(DatePart a b c d) = case filter ((==) a . dpName) l of@@ -81,9 +81,9 @@ x <- filter (\(Date _ df _ _ _ _) -> df == f) <$> gets (dates . env) case x of [x'] -> return x'- _ -> return $ Date [] NoFormDate emptyFormatting [] [] []+ _ -> return $ Date [] NoFormDate emptyFormatting "" [] "" -formatDate :: EvalMode -> String -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]+formatDate :: EvalMode -> Text -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output] formatDate em k tm dp date | [d] <- date = concatMap (formatDatePart d) dp | (a:b:_) <- date = addODate . concat $ doRange a b@@ -126,9 +126,9 @@ | otherwise -> ["year","month","day"] term f t = let f' = if f `elem` ["verb", "short", "verb-short", "symbol"]- then read $ toRead f+ then read . T.unpack $ toRead f else Long- in maybe [] termPlural $ findTerm t f' tm+ in maybe "" termPlural $ findTerm t f' tm formatDatePart (RefDate y m e d o _) (DatePart n f _ fm) | "year" <- n, Just y' <- y = return $ OYear (formatYear f y') k fm@@ -136,8 +136,8 @@ | "month" <- n, Just e' <- e = case e' of RawSeason s -> [OStr s fm]- _ -> output fm $ term f (printf "season-%02d"- $ fromMaybe 0 $ seasonToInt e')+ _ -> output fm . term f . T.pack $+ (printf "season-%02d" $ fromMaybe 0 $ seasonToInt e') | "day" <- n, Just d' <- d = output fm (formatDay f m d') | "year" <- n, o /= mempty = output fm (unLiteral o) | otherwise = []@@ -146,65 +146,70 @@ | null (concat o1 ++ concat o2) = [] | otherwise = o1 ++ (case dpRangeDelim <$> last' xs of ["-"] -> [[OPan [Str "\x2013"]]]- [s] -> [[OPan [Str $ T.pack s]]]+ [s] -> [[OPan [Str s]]] _ -> []) ++ o2 formatYear f y- | "short" <- f = printf "%02d" y+ | "short" <- f = T.pack $ printf "%02d" y | isSorting em- , y < 0 = printf "-%04d" (abs y)- | isSorting em = printf "%04d" y- | y < 0 = printf "%d" (abs y) ++ term [] "bc"+ , y < 0 = T.pack $ printf "-%04d" (abs y)+ | isSorting em = T.pack $ printf "%04d" y+ | y < 0 = (T.pack $ printf "%d" (abs y)) <> term "" "bc" | y < 1000- , y > 0 = printf "%d" y ++ term [] "ad"+ , y > 0 = (T.pack $ printf "%d" y) <> term "" "ad" | y == 0 = ""- | otherwise = printf "%d" y+ | otherwise = T.pack $ printf "%d" y formatMonth f fm m | "short" <- f = getMonth $ period . termPlural | "long" <- f = getMonth termPlural- | "numeric" <- f = printf "%d" m- | otherwise = printf "%02d" m+ | "numeric" <- f = T.pack $ printf "%d" m+ | otherwise = T.pack $ printf "%02d" m where- period = if stripPeriods fm then filter (/= '.') else id- getMonth g = maybe (show m) g $ findTerm ("month-" ++ printf "%02d" m) (read $ toRead f) tm+ period = if stripPeriods fm then T.filter (/= '.') else id+ getMonth g = case findTerm ("month-" <> T.pack (printf "%02d" m))+ (read . T.unpack $ toRead f) tm of+ Nothing -> T.pack (show m)+ Just x -> g x formatDay f m d- | "numeric-leading-zeros" <- f = printf "%02d" d- | "ordinal" <- f = ordinal tm ("month-" ++ maybe "0" (printf "%02d") m) d- | otherwise = printf "%d" d+ | "numeric-leading-zeros" <- f = T.pack $ printf "%02d" d+ | "ordinal" <- f = ordinal tm ("month-" <> maybe "0" (T.pack . printf "%02d") m) d+ | otherwise = T.pack $ printf "%d" d -ordinal :: [CslTerm] -> String -> Int -> String+ordinal :: [CslTerm] -> Text -> Int -> Text ordinal ts v s | s < 10 = let a = termPlural (getWith1 (show s)) in- if null a then setOrd (term []) else show s ++ a+ if T.null a+ then setOrd (term "")+ else T.pack (show s) <> a | s < 100 = let a = termPlural (getWith2 (show s)) b = getWith1 [last (show s)] in- if not (null a)- then show s ++ a- else if null (termPlural b) ||- (not (null (termMatch b)) &&+ if not (T.null a)+ then T.pack (show s) <> a+ else if T.null (termPlural b) ||+ (not (T.null (termMatch b)) && termMatch b /= "last-digit")- then setOrd (term [])+ then setOrd (term "") else setOrd b | otherwise = let a = getWith2 last2 b = getWith1 [last (show s)] in- if not (null (termPlural a)) &&+ if not (T.null (termPlural a)) && termMatch a /= "whole-number" then setOrd a- else if null (termPlural b) ||- (not (null (termMatch b)) &&+ else if T.null (termPlural b) ||+ (not (T.null (termMatch b)) && termMatch b /= "last-digit")- then setOrd (term [])+ then setOrd (term "") else setOrd b where- setOrd = (++) (show s) . termPlural- getWith1 = term . (++) "-0"- getWith2 = term . (++) "-"+ setOrd = T.append (T.pack $ show s) . termPlural+ getWith1 = term . T.append "-0" . T.pack+ getWith2 = term . T.append "-" . T.pack last2 = reverse . take 2 . reverse $ show s- term t = getOrdinal v ("ordinal" ++ t) ts+ term t = getOrdinal v ("ordinal" <> t) ts -longOrdinal :: [CslTerm] -> String -> Int -> String+longOrdinal :: [CslTerm] -> Text -> Int -> Text longOrdinal ts v s | s > 10 || s == 0 = ordinal ts v s@@ -220,14 +225,13 @@ 9 -> term "09" _ -> term "10" where- term t = termPlural $ getOrdinal v ("long-ordinal-" ++ t) ts+ term t = termPlural $ getOrdinal v ("long-ordinal-" <> t) ts -getOrdinal :: String -> String -> [CslTerm] -> CslTerm+getOrdinal :: Text -> Text -> [CslTerm] -> CslTerm getOrdinal v s ts = fromMaybe newTerm $ findTerm' s Long gender ts `mplus` findTerm' s Long Neuter ts where- gender = if v `elem` numericVars || "month" `isPrefixOf` v+ gender = if v `elem` numericVars || "month" `T.isPrefixOf` v then maybe Neuter termGender $ findTerm v Long ts else Neuter-
src/Text/CSL/Eval/Names.hs view
@@ -25,6 +25,7 @@ import Data.List (intersperse, nub) import Data.List.Split (wordsBy) import Data.Maybe (isJust)+import Data.Text (Text) import qualified Data.Text as T import Text.CSL.Eval.Common@@ -36,7 +37,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Shared (stringify) -evalNames :: Bool -> [String] -> [Name] -> String -> State EvalState [Output]+evalNames :: Bool -> [Text] -> [Name] -> Text -> State EvalState [Output] evalNames skipEdTrans ns nl d | [sa,sb] <- ns, not skipEdTrans , (sa == "editor" && sb == "translator") ||@@ -70,10 +71,10 @@ | otherwise = return [] where agents p s a = concatMapM (formatNames (hasEtAl nl) d p s a) nl- delim ops = if null d then getOptionVal "names-delimiter" ops else d+ delim ops = if T.null d then getOptionVal "names-delimiter" ops else d resetEtal = modify (\s -> s { etal = [] }) count num x = if hasCount nl && num /= [] -- FIXME!! le zero!!- then [OContrib [] [] [ONum (length num) emptyFormatting] [] []]+ then [OContrib "" "" [ONum (length num) emptyFormatting] [] []] else x hasCount = or . query hasCount' hasCount' n@@ -81,9 +82,9 @@ | otherwise = [False] -- | The 'Bool' is 'True' when formatting a name with a final "et-al".--- The first 'String' represents the position and the second the role+-- The first 'Text' represents the position and the second the role -- (e.i. editor, translator, etc.).-formatNames :: Bool -> Delimiter -> String -> String -> [Agent] -> Name -> State EvalState [Output]+formatNames :: Bool -> Delimiter -> Text -> Text -> [Agent] -> Name -> State EvalState [Output] formatNames ea del p s as n | Name f _ ns _ _ <- n, Count <- f = do b <- isBib <$> gets mode@@ -95,16 +96,16 @@ b <- isBib <$> gets mode o <- mergeOptions ns <$> gets (options . env) m <- gets mode- let odel = if del /= [] then del else getOptionVal "name-delimiter" o+ let odel = if del /= "" then del else getOptionVal "name-delimiter" o del'- | d /= [] = d- | null odel = ", "+ | d /= "" = d+ | T.null odel = ", " | otherwise = odel (_,i) = isEtAl b o p as form = case f of NotSet -> case getOptionVal "name-form" o of- [] -> Long- x -> read $ toRead x+ "" -> Long+ x -> read . T.unpack $ toRead x _ -> f genName x = do etal' <- formatEtAl o ea "et-al" fm del' x if null etal'@@ -133,7 +134,7 @@ o <- gets (options . env) et <- gets etal let i = length as - length et- t' = if null t then "et-al" else t+ t' = if T.null t then "et-al" else t r <- mapM (et_al o False t' fm del) [i .. length as] let (r',r'') = case r of (x:xs) -> (x, xs)@@ -175,10 +176,10 @@ | length x > 2 = addDelim d (init x) ++ ODel (d <^> andStr t os) : [last x] | otherwise = addDelim d x andStr t os- | "text" <- getOptionVal "and" os = " " ++ t ++ " "+ | "text" <- getOptionVal "and" os = " " <> t <> " " | "symbol" <- getOptionVal "and" os = " & "- | otherwise = []- andStr' t d os = if null (andStr t os) then d else andStr t os+ | otherwise = ""+ andStr' t d os = if T.null (andStr t os) then d else andStr t os formatEtAl o b t fm d i = do ln <- gets lastName@@ -193,18 +194,18 @@ if b || length as <= i then return [] else do x <- getTerm False Long t- when' (return $ x /= []) $+ when' (return $ x /= "") $ case getOptionVal "delimiter-precedes-et-al" o of "never" -> return . (++) [OSpace] $ output fm x "always" -> return . (++) [ODel d] $ output fm x- _ -> if i > 1 && not (null d)+ _ -> if i > 1 && not (T.null d) then return . (++) [ODel d] $ output fm x else return . (++) [OSpace] $ output fm x -- | The first 'Bool' is 'True' if we are evaluating the bibliography.--- The 'String' is the cite position. The function also returns the+-- The 'Text' is the cite position. The function also returns the -- number of contributors to be displayed.-isEtAl :: Bool -> [Option] -> String -> [Agent] -> (Bool, Int)+isEtAl :: Bool -> [Option] -> Text -> [Agent] -> (Bool, Int) isEtAl b os p as | p /= "first" , isOptionSet "et-al-subsequent-min" os@@ -225,18 +226,18 @@ , length as > 1 = (,) True getUseFirst | otherwise = (,) False $ length as where- etAlMin x = read $ getOptionVal x os- etAlMin' x y = if b then etAlMin x else read $ getOptionVal' x y+ etAlMin x = read . T.unpack $ getOptionVal x os+ etAlMin' x y = if b then etAlMin x else read . T.unpack $ getOptionVal' x y isOptionSet' s1 s2 = if b then isOptionSet s1 os else or $ isOptionSet s1 os : [isOptionSet s2 os]- getOptionVal' s1 s2 = if null (getOptionVal s1 os)+ getOptionVal' s1 s2 = if T.null (getOptionVal s1 os) then getOptionVal s2 os else getOptionVal s1 os getUseFirst = let u = if b then getOptionVal "et-al-use-first" os else getOptionVal' "et-al-use-first" "et-al-subsequent-min"- in if null u then 1 else read u+ in if T.null u then 1 else read (T.unpack u) -- | Generate the 'Agent's names applying et-al options, with all -- possible permutations to disambiguate colliding citations. The@@ -270,19 +271,19 @@ case lookup "initialize-with" ops of Just iw | getOptionVal "initialize" ops == "false"- , isInit x -> addIn x $ B.toList $ B.text $ T.pack iw+ , isInit x -> addIn x $ B.toList $ B.text iw | getOptionVal "initialize" ops /= "false"- , not (all isLower $ query (:[]) x) -> addIn x $ B.toList $ B.text $ T.pack iw+ , not (all isLower $ query (:[]) x) -> addIn x $ B.toList $ B.text iw Nothing | isInit x -> addIn x [Space] -- default _ -> Space : x ++ [Space]- addIn x i = foldr (hyphenate . (\z -> Str (T.pack $ headInline z) : i)) []+ addIn x i = foldr (hyphenate . (\z -> Str (maybe "" T.singleton $ headInline z) : i)) [] $ wordsBy (== Str "-") $ splitStrWhen (=='-') x sortSep g s = when_ g $ separator ++ addAffixes (g <+> s) "given" mempty separator = if isByzantineFamily- then [OPan (B.toList (B.text $ T.pack+ then [OPan (B.toList (B.text (getOptionValWithDefault "sort-separator" ", " ops)))] else [] suff = if commaSuffix n && nameSuffix n /= mempty@@ -347,7 +348,7 @@ initialize = isJust (lookup "initialize-with" ops) && not onlyGiven isLong = f /= Short && initialize givenRule = let gr = getOptionVal "givenname-disambiguation-rule" ops- in if null gr then "by-cite" else gr+ in if T.null gr then "by-cite" else gr disambdata = case () of _ | "all-names-with-initials" <- givenRule , disWithGiven, Short <- f, initialize -> [longName given]@@ -362,7 +363,7 @@ | disWithGiven, isLong -> [longName givenLong] | otherwise -> [] -formatTerm :: Form -> Formatting -> Bool -> String -> String+formatTerm :: Form -> Formatting -> Bool -> Text -> Text -> State EvalState [Output] formatTerm f fm p refid s = do plural <- if s `elem` ["page", "volume", "issue"]@@ -378,23 +379,24 @@ then [OYear t refid fm] else oStr' t fm -formatLabel :: Form -> Formatting -> Bool -> String -> State EvalState [Output]-formatLabel f fm p s- | "locator" <- s = when' ( (/=) [] <$> gets (citeLocator . cite . env)) $ do- (l,v) <- getLocVar- form (\fm' -> return . flip OLoc emptyFormatting . output fm') id l (isRange v)- | "page" <- s = checkPlural- | "volume" <- s = checkPlural- | "issue" <- s = checkPlural- | "ibid" <- s = format s p- | isRole s = do a <- getAgents' (if s == "editortranslator"- then "editor"- else s)- if null a- then return []- else form (\fm' x -> [OLabel x fm']) id s p- | otherwise = format s p+formatLabel :: Form -> Formatting -> Bool -> Text -> State EvalState [Output]+formatLabel f fm p s = when' (isVarSet s) go where+ go+ | "locator" <- s = when' ( (/=) "" <$> gets (citeLocator . cite . env)) $ do+ (l,v) <- getLocVar+ form (\fm' -> return . flip OLoc emptyFormatting . output fm') id l (isRange v)+ | "page" <- s = checkPlural+ | "volume" <- s = checkPlural+ | "issue" <- s = checkPlural+ | "ibid" <- s = format s p+ | isRole s = do a <- getAgents' (if s == "editortranslator"+ then "editor"+ else s)+ if null a+ then return []+ else form (\fm' x -> [OLabel x fm']) id s p+ | otherwise = format s p isRole = flip elem ["author", "collection-editor", "composer", "container-author" ,"director", "editor", "editorial-director", "editortranslator" ,"illustrator", "interviewer", "original-author", "recipient"@@ -404,16 +406,16 @@ format s (isRange v) format = form output id form o g t b = o fm . g . period <$> getTerm (b && p) f t- period = if stripPeriods fm then filter (/= '.') else id+ period = if stripPeriods fm then T.filter (/= '.') else id (<+>) :: Formatted -> Formatted -> Formatted Formatted [] <+> ss = ss s <+> Formatted [] = s Formatted xs <+> Formatted ys = case lastInline xs of- "’" -> Formatted (xs ++ ys)- "-" -> Formatted (xs ++ ys)- _ -> Formatted (xs ++ [Space] ++ ys)+ Just '’' -> Formatted (xs ++ ys)+ Just '-' -> Formatted (xs ++ ys)+ _ -> Formatted (xs ++ [Space] ++ ys) (<++>) :: [Output] -> [Output] -> [Output] [] <++> o = o
src/Text/CSL/Eval/Output.hs view
@@ -20,6 +20,7 @@ import Prelude import Data.Maybe (mapMaybe) import Data.String (fromString)+import Data.Text (Text) import qualified Data.Text as T import Text.CSL.Output.Pandoc (lastInline) import Text.CSL.Style@@ -28,19 +29,20 @@ import Text.Pandoc.Definition import Text.Pandoc.Walk (walk) import Text.Parsec+import Text.Parsec.Text (Parser) -- Parse affix or delimiter into Formatted, splitting out -- raw components in @{{format}}...{{/format}}@.-formatString :: String -> Formatted+formatString :: Text -> Formatted formatString s =- case parse pAffix s s of- Left _ -> fromString s+ case parse pAffix (T.unpack s) s of+ Left _ -> fromString (T.unpack s) Right ils -> Formatted ils -pAffix :: Parsec String () [Inline]+pAffix :: Parser [Inline] pAffix = many (pRaw <|> pString <|> pSpace) -pRaw :: Parsec String () Inline+pRaw :: Parser Inline pRaw = try $ do _ <- string "{{" format <- many1 letter@@ -48,17 +50,17 @@ contents <- manyTill anyChar (try (string ("{{/" ++ format ++ "}}"))) return $ RawInline (Format $ T.pack format) $ T.pack contents -pString :: Parsec String () Inline+pString :: Parser Inline pString = Str . T.pack <$> (many1 (noneOf " \t\n\r{}") <|> count 1 (oneOf "{}")) -pSpace :: Parsec String () Inline+pSpace :: Parser Inline pSpace = Space <$ many1 (oneOf " \t\n\r") -output :: Formatting -> String -> [Output]-output fm s- | ' ':xs <- s = OSpace : output fm xs- | [] <- s = []- | otherwise = [OStr s fm]+output :: Formatting -> Text -> [Output]+output fm s = case T.uncons s of+ Nothing -> []+ Just (' ', xs) -> OSpace : output fm xs+ _ -> [OStr s fm] appendOutput :: Formatting -> [Output] -> [Output] appendOutput fm xs = [Output xs fm | xs /= []]@@ -86,13 +88,13 @@ rmEmptyOutput :: Output -> Maybe Output rmEmptyOutput o | Output [] _ <- o = Nothing- | OStr [] _ <- o = Nothing+ | OStr "" _ <- o = Nothing | OPan [] <- o = Nothing | OStatus [] <- o = Nothing- | ODel [] <- o = Nothing+ | ODel "" <- o = Nothing | otherwise = Just o -addDelim :: String -> [Output] -> [Output]+addDelim :: Text -> [Output] -> [Output] addDelim "" = id addDelim d = foldr check [] where@@ -108,11 +110,11 @@ noBibDataError :: Cite -> Output noBibDataError c = OErr $ ReferenceNotFound (citeId c) -oStr :: String -> [Output]+oStr :: Text -> [Output] oStr s = oStr' s emptyFormatting -oStr' :: String -> Formatting -> [Output]-oStr' [] _ = []+oStr' :: Text -> Formatting -> [Output]+oStr' "" _ = [] oStr' s f = [OStr s f] oPan :: [Inline] -> [Output]@@ -134,27 +136,27 @@ OSpace -> Formatted [Space] OPan i -> Formatted i OStatus i -> Formatted i- ODel [] -> Formatted []+ ODel "" -> Formatted [] ODel " " -> Formatted [Space] ODel "\n" -> Formatted [SoftBreak] ODel s -> formatString s- OStr [] _ -> Formatted []+ OStr "" _ -> Formatted [] OStr s f -> addFormatting f $ formatString s OErr NoOutput -> Formatted [Span ("",["citeproc-no-output"],[]) [Strong [Str "???"]]] OErr (ReferenceNotFound r) -> Formatted [Span ("",["citeproc-not-found"],- [("data-reference-id",T.pack r)])+ [("data-reference-id",r)]) [Strong [Str "???"]]]- OLabel [] _ -> Formatted []+ OLabel "" _ -> Formatted [] OLabel s f -> addFormatting f $ formatString s ODate os -> formatOutputList os OYear s _ f -> addFormatting f $ formatString s OYearSuf s _ _ f -> addFormatting f $ formatString s- ONum i f -> formatOutput (OStr (show i) f)+ ONum i f -> formatOutput (OStr (T.pack (show i)) f) OCitNum i f -> if i == 0 then Formatted [Strong [Str "???"]]- else formatOutput (OStr (show i) f)+ else formatOutput (OStr (T.pack $ show i) f) OCitLabel s f -> if s == "" then Formatted [Strong [Str "???"]] else formatOutput (OStr s f)@@ -170,15 +172,15 @@ addDisplay . addLink . addSuffix . pref . quote . font . text_case . strip_periods where addLink i = case hyperlink f of "" -> i- url -> Formatted [Link nullAttr (unFormatted i) (T.pack url, "")]+ url -> Formatted [Link nullAttr (unFormatted i) (url, "")] pref i = case prefix f of "" -> i x -> formatString x <> i addSuffix i- | null (suffix f) = i- | case suffix f of {(c:_) | isPunct c -> True; _ -> False}- , case lastInline (unFormatted i) of {(c:_) | isPunct c -> True; _ -> False}- = i <> formatString (tail $ suffix f)+ | T.null (suffix f) = i+ | maybe False (isPunct . fst) (T.uncons (suffix f))+ , case lastInline (unFormatted i) of {Just c | isPunct c -> True; _ -> False}+ = i <> formatString (T.tail $ suffix f) | otherwise = i <> formatString (suffix f) strip_periods (Formatted ils) = Formatted (walk removePeriod ils)@@ -228,7 +230,7 @@ "title" -> titlecase ils "capitalize-first" -> case i of- Str cs -> Str (T.pack $ capitalize $ T.unpack cs) : is'+ Str cs -> Str (capitalize cs) : is' _ -> unTitlecase [i] ++ is' "sentence" -> unTitlecase ils _ -> ils@@ -237,7 +239,7 @@ lowercaseStr x = x uppercaseStr (Str xs) = Str $ T.toUpper xs uppercaseStr x = x- capitalizeStr (Str xs) = Str $ T.pack $ capitalize $ T.unpack xs+ capitalizeStr (Str xs) = Str $ capitalize xs capitalizeStr x = x valign [] = []
src/Text/CSL/Input/Bibtex.hs view
@@ -29,13 +29,16 @@ import qualified Control.Exception as E import Control.Monad import Control.Monad.RWS hiding ((<>))+import qualified Data.ByteString as B import Data.Char (isAlphaNum, isDigit, isUpper, toLower, toUpper) import Data.List (foldl', intercalate) import Data.List.Split (splitOn, splitWhen, wordsBy) import qualified Data.Map as Map import Data.Maybe+import Data.Text (Text) import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8) import System.Environment (getEnvironment) import Text.CSL.Compat.Pandoc (readLaTeX) import Text.CSL.Exception (CiteprocException (ErrorReadingBib, ErrorReadingBibFile))@@ -44,10 +47,9 @@ import Text.CSL.Style (Agent (..), emptyAgent, CslTerm (..), Formatted (..), Locale (..)) import Text.CSL.Util (onBlocks, protectCase, safeRead,- splitStrWhen, trim, unTitlecase,- addSpaceAfterPeriod)+ splitWhen, splitStrWhen, trim,+ unTitlecase, addSpaceAfterPeriod) import Text.Pandoc.Definition-import qualified Text.Pandoc.UTF8 as UTF8 import qualified Text.Pandoc.Walk as Walk import Text.Parsec hiding (State, many, (<|>)) @@ -63,18 +65,18 @@ adjustSpans lang (RawInline (Format "latex") s) | s == "\\hyphen" || s == "\\hyphen " = [Str "-"] | otherwise = Walk.walk (concatMap (adjustSpans lang))- $ parseRawLaTeX lang (T.unpack s)+ $ parseRawLaTeX lang s adjustSpans _ x = [x] -parseRawLaTeX :: Lang -> String -> [Inline]-parseRawLaTeX lang ('\\':xs) =+parseRawLaTeX :: Lang -> Text -> [Inline]+parseRawLaTeX lang (T.stripPrefix "\\" -> Just xs) = case latex' contents of [Para ys] -> f command ys [Plain ys] -> f command ys _ -> []- where (command', contents') = break (=='{') xs+ where (command', contents') = T.break (=='{') xs command = trim command'- contents = drop 1 $ reverse $ drop 1 $ reverse contents'+ contents = T.drop 1 $ T.dropEnd 1 contents' f "mkbibquote" ils = [Quoted DoubleQuote ils] f "mkbibemph" ils = [Emph ils] f "mkbibitalic" ils = [Emph ils] -- TODO: italic/=emph@@ -84,7 +86,7 @@ -- ... both should be nestable & should work in year fields f "autocap" ils = ils -- TODO: should work in year fields f "textnormal" ils = [Span ("",["nodecor"],[]) ils]- f "bibstring" [Str s] = [Str $ T.pack $ resolveKey' lang $ T.unpack s]+ f "bibstring" [Str s] = [Str $ resolveKey' lang s] f _ ils = [Span nullAttr ils] parseRawLaTeX _ _ = [] @@ -93,9 +95,9 @@ lang <- gets localeLanguage return $ Formatted $ Walk.walk (concatMap (adjustSpans lang)) ils -data Item = Item{ identifier :: String- , entryType :: String- , fields :: Map.Map String String+data Item = Item{ identifier :: Text+ , entryType :: Text+ , fields :: Map.Map Text Text } -- | Get 'Lang' from the environment variable LANG, defaulting to en-US.@@ -103,33 +105,33 @@ getLangFromEnv = do env <- getEnvironment return $ case lookup "LANG" env of- Just x -> case splitWhen (\c -> c == '_' || c == '-')- (takeWhile (/='.') x) of- (w:z:_) -> Lang w z- [w] | not (null w) -> Lang w mempty- _ -> Lang "en" "US"- Nothing -> Lang "en" "US"+ Just x -> case Text.CSL.Util.splitWhen (\c -> c == '_' || c == '-')+ (T.takeWhile (/='.') (T.pack x)) of+ (w:z:_) -> Lang w z+ [w] | not (T.null w) -> Lang w mempty+ _ -> Lang "en" "US"+ Nothing -> Lang "en" "US" -- | Parse a BibTeX or BibLaTeX file into a list of 'Reference's. -- The first parameter is a predicate to filter identifiers. -- If the second parameter is true, the file will be treated as -- BibTeX; otherwise as BibLaTeX. If the third parameter is -- true, an "untitlecase" transformation will be performed.-readBibtex :: (String -> Bool) -> Bool -> Bool -> FilePath -> IO [Reference]+readBibtex :: (Text -> Bool) -> Bool -> Bool -> FilePath -> IO [Reference] readBibtex idpred isBibtex caseTransform f = do- contents <- UTF8.readFile f+ contents <- decodeUtf8 <$> B.readFile f E.catch (readBibtexString idpred isBibtex caseTransform contents) (\e -> case e of ErrorReadingBib es -> E.throwIO $ ErrorReadingBibFile f es _ -> E.throwIO e) --- | Like 'readBibtex' but operates on a String rather than a file.-readBibtexString :: (String -> Bool) -> Bool -> Bool -> String+-- | Like 'readBibtex' but operates on Text rather than a file.+readBibtexString :: (Text -> Bool) -> Bool -> Bool -> Text -> IO [Reference] readBibtexString idpred isBibtex caseTransform contents = do lang <- getLangFromEnv locale <- parseLocale (langToLocale lang)- case runParser (bibEntries <* eof) (Map.empty) "stdin" contents of+ case runParser (bibEntries <* eof) Map.empty "stdin" contents of -- drop 8 to remove "stdin" + space Left err -> E.throwIO $ ErrorReadingBib $ drop 8 $ show err Right xs -> return $ mapMaybe@@ -138,7 +140,7 @@ (resolveCrossRefs isBibtex xs)) -type BibParser = Parsec String (Map.Map String String)+type BibParser = Parsec Text (Map.Map Text Text) bibEntries :: BibParser [Item] bibEntries = do@@ -174,32 +176,32 @@ updateState (Map.insert k v) return () -inBraces :: BibParser String+inBraces :: BibParser Text inBraces = try $ do char '{' res <- manyTill- ( many1 (noneOf "{}\\")+ ( (T.pack <$> many1 (noneOf "{}\\")) <|> (char '\\' >> ( (char '{' >> return "\\{") <|> (char '}' >> return "\\}") <|> return "\\")) <|> (braced <$> inBraces) ) (char '}')- return $ concat res+ return $ T.concat res -braced :: String -> String-braced s = "{" ++ s ++ "}"+braced :: Text -> Text+braced = T.cons '{' . flip T.snoc '}' -inQuotes :: BibParser String+inQuotes :: BibParser Text inQuotes = do char '"'- concat <$> manyTill ( many1 (noneOf "\"\\{")- <|> (char '\\' >> (\c -> ['\\',c]) <$> anyChar)- <|> braced <$> inBraces- ) (char '"')+ T.concat <$> manyTill ( (T.pack <$> many1 (noneOf "\"\\{"))+ <|> (char '\\' >> T.cons '\\' . T.singleton <$> anyChar)+ <|> braced <$> inBraces+ ) (char '"') -fieldName :: BibParser String-fieldName =- resolveAlias . map toLower <$> many1 (letter <|> digit <|> oneOf "-_:+")+fieldName :: BibParser Text+fieldName = resolveAlias . T.toLower . T.pack+ <$> many1 (letter <|> digit <|> oneOf "-_:+") isBibtexKeyChar :: Char -> Bool isBibtexKeyChar c = isAlphaNum c || c `elem` (".:;?!`'()/*@_+=-[]*&" :: String)@@ -218,9 +220,9 @@ entfields <- entField `sepEndBy` (char ',' >> spaces) spaces char '}'- return $ Item entid enttype (Map.fromList entfields)+ return $ Item (T.pack entid) (T.pack enttype) (Map.fromList entfields) -entField :: BibParser (String, String)+entField :: BibParser (Text, Text) entField = do k <- fieldName spaces@@ -229,17 +231,17 @@ vs <- (expandString <|> inQuotes <|> inBraces <|> rawWord) `sepBy` try (spaces >> char '#' >> spaces) spaces- return (k, concat vs)+ return (k, T.concat vs) -resolveAlias :: String -> String+resolveAlias :: Text -> Text resolveAlias "archiveprefix" = "eprinttype" resolveAlias "primaryclass" = "eprintclass" resolveAlias s = s -rawWord :: BibParser String-rawWord = many1 alphaNum+rawWord :: BibParser Text+rawWord = T.pack <$> many1 alphaNum -expandString :: BibParser String+expandString :: BibParser Text expandString = do k <- fieldName strs <- getState@@ -247,22 +249,23 @@ Just v -> return v Nothing -> return k -- return raw key if not found -cistring :: String -> BibParser String+cistring :: Text -> BibParser Text cistring s = try (go s)- where go [] = return []- go (c:cs) = do- x <- char (toLower c) <|> char (toUpper c)- xs <- go cs- return (x:xs)+ where go t = case T.uncons t of+ Nothing -> return ""+ Just (c,cs) -> do+ x <- char (toLower c) <|> char (toUpper c)+ xs <- go cs+ return (T.cons x xs) resolveCrossRefs :: Bool -> [Item] -> [Item] resolveCrossRefs isBibtex entries = map (resolveCrossRef isBibtex entries) entries -splitKeys :: String -> [String]-splitKeys = wordsBy (\c -> c == ' ' || c == ',')+splitKeys :: Text -> [Text]+splitKeys = filter (not . T.null) . T.split (\c -> c == ' ' || c == ',') -getXrefFields :: Bool -> Item -> [Item] -> String -> [(String, String)]+getXrefFields :: Bool -> Item -> [Item] -> Text -> [(Text, Text)] getXrefFields isBibtex baseEntry entries keys = do let keys' = splitKeys keys xrefEntry <- [e | e <- entries, identifier e `elem` keys']@@ -293,7 +296,7 @@ -- transformKey source target key -- derived from Appendix C of bibtex manual-transformKey :: String -> String -> String -> [String]+transformKey :: Text -> Text -> Text -> [Text] transformKey _ _ "ids" = [] transformKey _ _ "crossref" = [] transformKey _ _ "xref" = []@@ -343,7 +346,7 @@ _ -> [z] transformKey _ _ x = [x] -standardTrans :: String -> [String]+standardTrans :: Text -> [Text] standardTrans z = case z of "title" -> ["maintitle"]@@ -355,7 +358,7 @@ "indexsorttitle" -> [] _ -> [z] -bookTrans :: String -> [String]+bookTrans :: Text -> [Text] bookTrans z = case z of "title" -> ["booktitle"]@@ -368,11 +371,11 @@ _ -> [z] -- | A representation of a language and localization.-data Lang = Lang String String -- e.g. "en" "US"+data Lang = Lang Text Text -- e.g. "en" "US" -- | Prints a 'Lang' in BCP 47 format.-langToLocale :: Lang -> String-langToLocale (Lang x y) = x ++ (if null y then [] else '-':y)+langToLocale :: Lang -> Text+langToLocale (Lang x y) = x <> (if T.null y then "" else T.cons '-' y) -- Biblatex Localization Keys (see Biblatex manual) -- Currently we only map a subset likely to be used in Biblatex *databases*@@ -380,16 +383,16 @@ resolveKey :: Lang -> Formatted -> Formatted resolveKey lang (Formatted ils) = Formatted (Walk.walk go ils)- where go (Str s) = Str $ T.pack $ resolveKey' lang $ T.unpack s+ where go (Str s) = Str $ resolveKey' lang s go x = x -- biblatex localization keys, from files at -- http://github.com/plk/biblatex/tree/master/tex/latex/biblatex/lbx -- Some keys missing in these were added from csl locale files at -- http://github.com/citation-style-language/locales -- labeled "csl"-resolveKey' :: Lang -> String -> String+resolveKey' :: Lang -> Text -> Text resolveKey' (Lang "ca" "AD") k =- case map toLower k of+ case T.toLower k of "inpreparation" -> "en preparació" "submitted" -> "enviat" "forthcoming" -> "disponible en breu"@@ -425,7 +428,7 @@ "oldseries" -> "sèrie antiga" _ -> k resolveKey' (Lang "da" "DK") k =- case map toLower k of+ case T.toLower k of -- "inpreparation" -> "" -- missing -- "submitted" -> "" -- missing "forthcoming" -> "kommende" -- csl@@ -461,7 +464,7 @@ "oldseries" -> "gammel serie" _ -> k resolveKey' (Lang "de" "DE") k =- case map toLower k of+ case T.toLower k of "inpreparation" -> "in Vorbereitung" "submitted" -> "eingereicht" "forthcoming" -> "im Erscheinen"@@ -497,7 +500,7 @@ "oldseries" -> "alte Folge" _ -> k resolveKey' (Lang "en" "US") k =- case map toLower k of+ case T.toLower k of "audiocd" -> "audio CD" "by" -> "by" "candthesis" -> "Candidate thesis"@@ -545,7 +548,7 @@ "volume" -> "vol." _ -> k resolveKey' (Lang "es" "ES") k =- case map toLower k of+ case T.toLower k of -- "inpreparation" -> "" -- missing -- "submitted" -> "" -- missing "forthcoming" -> "previsto" -- csl@@ -581,7 +584,7 @@ "oldseries" -> "antigua época" _ -> k resolveKey' (Lang "fi" "FI") k =- case map toLower k of+ case T.toLower k of -- "inpreparation" -> "" -- missing -- "submitted" -> "" -- missing "forthcoming" -> "tulossa" -- csl@@ -618,7 +621,7 @@ _ -> k resolveKey' (Lang "fr" "FR") k =- case map toLower k of+ case T.toLower k of "inpreparation" -> "en préparation" "submitted" -> "soumis" "forthcoming" -> "à paraître"@@ -654,7 +657,7 @@ "oldseries" -> "ancienne série" _ -> k resolveKey' (Lang "it" "IT") k =- case map toLower k of+ case T.toLower k of -- "inpreparation" -> "" -- missing -- "submitted" -> "" -- missing "forthcoming" -> "futuro" -- csl@@ -690,7 +693,7 @@ "oldseries" -> "vecchia serie" _ -> k resolveKey' (Lang "nl" "NL") k =- case map toLower k of+ case T.toLower k of "inpreparation" -> "in voorbereiding" "submitted" -> "ingediend" "forthcoming" -> "onderweg"@@ -726,7 +729,7 @@ "oldseries" -> "oude reeks" _ -> k resolveKey' (Lang "pl" "PL") k =- case map toLower k of+ case T.toLower k of "inpreparation" -> "przygotowanie" "submitted" -> "prezentacja" "forthcoming" -> "przygotowanie"@@ -758,7 +761,7 @@ "oldseries" -> "stara serja" _ -> k resolveKey' (Lang "pt" "PT") k =- case map toLower k of+ case T.toLower k of -- "candthesis" -> "" -- missing "techreport" -> "relatório técnico" "resreport" -> "relatório de pesquisa"@@ -793,7 +796,7 @@ "audiocd" -> "CD áudio" _ -> k resolveKey' (Lang "pt" "BR") k =- case map toLower k of+ case T.toLower k of -- "candthesis" -> "" -- missing "techreport" -> "relatório técnico" "resreport" -> "relatório de pesquisa"@@ -828,7 +831,7 @@ "audiocd" -> "CD de áudio" _ -> k resolveKey' (Lang "sv" "SE") k =- case map toLower k of+ case T.toLower k of -- "inpreparation" -> "" -- missing -- "submitted" -> "" -- missing "forthcoming" -> "kommande" -- csl@@ -865,9 +868,9 @@ _ -> k resolveKey' _ k = resolveKey' (Lang "en" "US") k -parseMonth :: String -> Maybe Int+parseMonth :: Text -> Maybe Int parseMonth s =- case map toLower s of+ case T.toLower s of "jan" -> Just 1 "feb" -> Just 2 "mar" -> Just 3@@ -880,7 +883,7 @@ "oct" -> Just 10 "nov" -> Just 11 "dec" -> Just 12- _ -> safeRead $ T.pack s+ _ -> safeRead s data BibState = BibState{ untitlecase :: Bool@@ -889,31 +892,31 @@ type Bib = RWST Item () BibState Maybe -notFound :: String -> Bib a-notFound f = Prelude.fail $ f ++ " not found"+notFound :: Text -> Bib a+notFound f = Prelude.fail $ T.unpack f ++ " not found" -getField :: String -> Bib Formatted+getField :: Text -> Bib Formatted getField f = do fs <- asks fields case Map.lookup f fs of Just x -> latex x Nothing -> notFound f -getPeriodicalTitle :: String -> Bib Formatted+getPeriodicalTitle :: Text -> Bib Formatted getPeriodicalTitle f = do fs <- asks fields case Map.lookup f fs of Just x -> blocksToFormatted $ onBlocks protectCase $ latex' $ trim x Nothing -> notFound f -getTitle :: String -> Bib Formatted+getTitle :: Text -> Bib Formatted getTitle f = do fs <- asks fields case Map.lookup f fs of Just x -> latexTitle x Nothing -> notFound f -getShortTitle :: Bool -> String -> Bib Formatted+getShortTitle :: Bool -> Text -> Bib Formatted getShortTitle requireColon f = do fs <- asks fields utc <- gets untitlecase@@ -935,39 +938,44 @@ upToColon [Plain xs] = upToColon [Para xs] upToColon bs = bs -getDates :: String -> Bib [RefDate]+getDates :: Text -> Bib [RefDate] getDates f = parseEDTFDate <$> getRawField f -isNumber :: String -> Bool-isNumber ('-':d:ds) = all isDigit (d:ds)-isNumber (d:ds) = all isDigit (d:ds)-isNumber _ = False+isNumber :: Text -> Bool+isNumber t = case T.uncons t of+ Just ('-', ds) -> T.all isDigit ds+ Just _ -> T.all isDigit t+ Nothing -> False -- A negative (BC) year might be written with -- or --- in bibtex:-fixLeadingDash :: String -> String-fixLeadingDash (c:d:ds)- | (c == '–' || c == '—') && isDigit d = '-':d:ds-fixLeadingDash xs = xs+fixLeadingDash :: Text -> Text+fixLeadingDash t = case T.uncons t of+ Just (c, ds) | (c == '–' || c == '—') && firstIsDigit ds -> T.cons '–' ds+ _ -> t+ where firstIsDigit = maybe False (isDigit . fst) . T.uncons -getOldDates :: String -> Bib [RefDate]+getOldDates :: Text -> Bib [RefDate] getOldDates prefix = do- year' <- fixLeadingDash <$> getRawField (prefix ++ "year") <|> return ""- month' <- (parseMonth- <$> getRawField (prefix ++ "month")) <|> return Nothing- day' <- (safeRead . T.pack <$> getRawField (prefix ++ "day")) <|> return Nothing- endyear' <- (fixLeadingDash <$> getRawField (prefix ++ "endyear"))+ year' <- fixLeadingDash <$> getRawField (prefix <> "year")+ <|> return ""+ month' <- (parseMonth <$> getRawField (prefix <> "month"))+ <|> return Nothing+ day' <- (safeRead <$> getRawField (prefix <> "day"))+ <|> return Nothing+ endyear' <- (fixLeadingDash <$> getRawField (prefix <> "endyear")) <|> return ""- endmonth' <- (parseMonth <$> getRawField (prefix ++ "endmonth"))+ endmonth' <- (parseMonth <$> getRawField (prefix <> "endmonth")) <|> return Nothing- endday' <- (safeRead . T.pack <$> getRawField (prefix ++ "endday")) <|> return Nothing- let start' = RefDate { year = safeRead $ T.pack year'+ endday' <- (safeRead <$> getRawField (prefix <> "endday"))+ <|> return Nothing+ let start' = RefDate { year = safeRead year' , month = month' , season = Nothing , day = day' , other = Literal $ if isNumber year' then "" else year' , circa = False }- let end' = RefDate { year = safeRead $ T.pack endyear'+ let end' = RefDate { year = safeRead endyear' , month = endmonth' , day = endday' , season = Nothing@@ -977,21 +985,21 @@ let hasyear r = isJust (year r) return $ filter hasyear [start', end'] -getRawField :: String -> Bib String+getRawField :: Text -> Bib Text getRawField f = do fs <- asks fields case Map.lookup f fs of Just x -> return x Nothing -> notFound f -getAuthorList :: Options -> String -> Bib [Agent]+getAuthorList :: Options -> Text -> Bib [Agent] getAuthorList opts f = do fs <- asks fields case Map.lookup f fs of Just x -> latexAuthors opts x Nothing -> notFound f -getLiteralList :: String -> Bib [Formatted]+getLiteralList :: Text -> Bib [Formatted] getLiteralList f = do fs <- asks fields case Map.lookup f fs of@@ -999,8 +1007,8 @@ Nothing -> notFound f -- separates items with semicolons-getLiteralList' :: String -> Bib Formatted-getLiteralList' f = (Formatted . intercalate [Str ";", Space] . map unFormatted)+getLiteralList' :: Text -> Bib Formatted+getLiteralList' f = Formatted . intercalate [Str ";", Space] . map unFormatted <$> getLiteralList f splitByAnd :: [Inline] -> [[Inline]]@@ -1044,8 +1052,8 @@ } -- extended BibLaTeX name format - see #266 toAuthor _ ils@(Str ys:_) | T.any (== '=') ys = do- let commaParts = splitWhen (== Str ",")- $ splitStrWhen (\c -> c == ',' || c == '=' || c == '\160')+ let commaParts = Data.List.Split.splitWhen (== Str ",")+ . splitStrWhen (\c -> c == ',' || c == '=' || c == '\160') $ ils let addPart ag (Str "given" : Str "=" : xs) = ag{ givenName = givenName ag ++ [Formatted xs] }@@ -1075,7 +1083,7 @@ let usecomma = optionSet "juniorcomma" opts let bibtex = optionSet "bibtex" opts let words' = wordsBy (\x -> x == Space || x == Str "\160")- let commaParts = map words' $ splitWhen (== Str ",")+ let commaParts = map words' $ Data.List.Split.splitWhen (== Str ",") $ splitStrWhen (\c -> c == ',' || c == '\160') ils let (first, vonlast, jr) = case commaParts of@@ -1124,13 +1132,13 @@ isCapitalized (_:rest) = isCapitalized rest isCapitalized [] = True -optionSet :: String -> Options -> Bool+optionSet :: Text -> Options -> Bool optionSet key opts = case lookup key opts of Just "true" -> True Just s -> s == mempty _ -> False -latex' :: String -> [Block]+latex' :: Text -> [Block] latex' s = Walk.walk removeSoftBreak bs where Pandoc _ bs = readLaTeX s @@ -1138,22 +1146,22 @@ removeSoftBreak SoftBreak = Space removeSoftBreak x = x -latex :: String -> Bib Formatted+latex :: Text -> Bib Formatted latex s = blocksToFormatted $ latex' $ trim s -latexTitle :: String -> Bib Formatted+latexTitle :: Text -> Bib Formatted latexTitle s = do utc <- gets untitlecase let processTitle = if utc then onBlocks unTitlecase else id blocksToFormatted $ processTitle $ latex' s -latexAuthors :: Options -> String -> Bib [Agent]+latexAuthors :: Options -> Text -> Bib [Agent] latexAuthors opts = toAuthorList opts . latex' . trim bib :: Bib Reference -> Item -> Maybe Reference bib m entry = fst Control.Applicative.<$> evalRWST m entry (BibState True (Lang "en" "US")) -toLocale :: String -> String+toLocale :: Text -> Text toLocale "english" = "en-US" -- "en-EN" unavailable in CSL toLocale "usenglish" = "en-US" toLocale "american" = "en-US"@@ -1227,22 +1235,23 @@ -> accum ++ (Space : s) _ -> accum ++ (Str (T.singleton sep) : Space : s) -type Options = [(String, String)]+type Options = [(Text, Text)] -parseOptions :: String -> Options-parseOptions = map breakOpt . splitWhen (==',')- where breakOpt x = case break (=='=') x of- (w,v) -> (map toLower $ trim w,- map toLower $ trim $ drop 1 v)+parseOptions :: Text -> Options+parseOptions = map breakOpt . T.splitOn ","+ where breakOpt x = case T.break (=='=') x of+ (w,v) -> (T.toLower $ trim w,+ T.toLower $ trim $ T.drop 1 v) -ordinalize :: Locale -> String -> String+ordinalize :: Locale -> Text -> Text ordinalize locale n =- case [termSingular c | c <- terms, cslTerm c == ("ordinal-" ++ pad0 n)] +++ case [termSingular c | c <- terms, cslTerm c == ("ordinal-" <> pad0 n)] ++ [termSingular c | c <- terms, cslTerm c == "ordinal"] of- (suff:_) -> n ++ suff+ (suff:_) -> n <> suff [] -> n- where pad0 [c] = ['0',c]- pad0 s = s+ where pad0 s = case T.uncons s of+ Just (c,"") -> T.pack ['0', c]+ _ -> s terms = localeTerms locale itemToReference :: Lang -> Locale -> Bool -> Bool -> Item -> Maybe Reference@@ -1252,13 +1261,13 @@ Lang "en" _ -> caseTransform _ -> False } id' <- asks identifier- otherIds <- (map trim . splitWhen (==',') <$> getRawField "ids")+ otherIds <- (map trim . T.splitOn "," <$> getRawField "ids") <|> return [] et <- asks entryType guard $ et /= "xdata" opts <- (parseOptions <$> getRawField "options") <|> return [] let getAuthorList' = getAuthorList- (("bibtex", map toLower $ show bibtex):opts)+ (("bibtex", T.toLower . T.pack $ show bibtex):opts) st <- getRawField "entrysubtype" <|> return mempty isEvent <- (True <$ (getRawField "eventdate" <|> getRawField "eventtitle"@@ -1281,7 +1290,7 @@ "inproceedings" -> (PaperConference,mempty) "manual" -> (Book,mempty) "mastersthesis" -> (Thesis, if reftype' == mempty- then Formatted [Str $ T.pack $ resolveKey' lang "mathesis"]+ then Formatted [Str $ resolveKey' lang "mathesis"] else reftype') "misc" -> (NoType,mempty) "mvbook" -> (Book,mempty)@@ -1295,7 +1304,7 @@ | st == "newspaper" -> (ArticleNewspaper,mempty) | otherwise -> (ArticleJournal,mempty) "phdthesis" -> (Thesis, if reftype' == mempty- then Formatted [Str $ T.pack $ resolveKey' lang "phdthesis"]+ then Formatted [Str $ resolveKey' lang "phdthesis"] else reftype') "proceedings" -> (Book,mempty) "reference" -> (Book,mempty)@@ -1334,10 +1343,10 @@ -- hyphenation: let defaultHyphenation = case lang of- Lang x y -> x ++ "-" ++ y+ Lang x y -> x <> "-" <> y let getLangId = do- langid <- (trim . map toLower) <$> getRawField "langid"- idopts <- (trim . map toLower) <$>+ langid <- trim . T.toLower <$> getRawField "langid"+ idopts <- trim . T.toLower <$> getRawField "langidopts" <|> return "" case (langid, idopts) of ("english","variant=british") -> return "british"@@ -1348,7 +1357,7 @@ ("english","variant=australian") -> return "australian" ("english","variant=newzealand") -> return "newzealand" (x,_) -> return x- hyphenation <- ((toLocale . map toLower) <$>+ hyphenation <- (toLocale . T.toLower <$> (getLangId <|> getRawField "hyphenation")) <|> return mempty @@ -1370,10 +1379,10 @@ let isChapterlike = et `elem` ["inbook","incollection","inproceedings","inreference","bookinbook"] hasMaintitle <- (True <$ getRawField "maintitle") <|> return False- let hyphenation' = if null hyphenation+ let hyphenation' = if T.null hyphenation then defaultHyphenation else hyphenation- let la = case splitWhen (== '-') hyphenation' of+ let la = case T.splitOn "-" hyphenation' of (x:_) -> x [] -> mempty modify $ \s -> s{ untitlecase = caseTransform && la == "en" }@@ -1419,10 +1428,10 @@ <|> return mempty -- change numerical series title to e.g. 'series 3' let fixSeriesTitle (Formatted [Str xs]) | T.all isDigit xs =- Formatted [Str (T.pack $ ordinalize locale $ T.unpack xs),- Space, Str (T.pack $ resolveKey' lang "ser.")]+ Formatted [Str (ordinalize locale xs),+ Space, Str (resolveKey' lang "ser.")] fixSeriesTitle x = x- seriesTitle' <- (fixSeriesTitle . resolveKey lang) <$>+ seriesTitle' <- fixSeriesTitle . resolveKey lang <$> getTitle "series" <|> return mempty shortTitle' <- (guard (not hasMaintitle || isChapterlike) >> getTitle "shorttitle")@@ -1458,7 +1467,7 @@ else getLiteralList' "origlocation") <|> return mempty jurisdiction' <- if et == "patent"- then ((concatWith ';' . map (resolveKey lang)) <$>+ then (concatWith ';' . map (resolveKey lang) <$> getLiteralList "location") <|> return mempty else return mempty @@ -1500,15 +1509,15 @@ <|> (do etype <- getRawField "eprinttype" eprint <- getRawField "eprint" let baseUrl =- case map toLower etype of+ case T.toLower etype of "arxiv" -> "http://arxiv.org/abs/" "jstor" -> "http://www.jstor.org/stable/" "pubmed" -> "http://www.ncbi.nlm.nih.gov/pubmed/" "googlebooks" -> "http://books.google.com?id=" _ -> ""- if null baseUrl+ if T.null baseUrl then mzero- else return $ baseUrl ++ eprint)+ else return $ baseUrl <> eprint) <|> return mempty doi' <- (guard (lookup "doi" opts /= Just "false") >> getRawField "doi") <|> return mempty
src/Text/CSL/Input/Bibutils.hs view
@@ -29,7 +29,9 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS import qualified Data.HashMap.Strict as HM+import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import qualified Data.YAML.Aeson as YA import qualified Data.YAML as Y import qualified Data.Vector as V@@ -59,7 +61,7 @@ -- -- Supported formats are: @json@, @mods@, @bibtex@, @biblatex@, @ris@, -- @endnote@, @endnotexml@, @isi@, @medline@, @copac@, and @nbib@.-readBiblioFile :: (String -> Bool) -> FilePath -> IO [Reference]+readBiblioFile :: (Text -> Bool) -> FilePath -> IO [Reference] readBiblioFile idpred f = case getExt f of ".json" -> BL.readFile f >>= either@@ -67,7 +69,7 @@ (return . filterEntries idpred) . eitherDecode ".yaml" -> UTF8.readFile f >>= either (E.throwIO . ErrorReadingBibFile f) return .- readYamlBib idpred+ readYamlBib idpred . T.pack ".bib" -> readBibtex idpred False True f ".bibtex" -> readBibtex idpred True True f ".biblatex" -> readBibtex idpred False True f@@ -102,10 +104,12 @@ #endif deriving Show -readBiblioString :: (String -> Bool) -> BibFormat -> String -> IO [Reference]+readBiblioString :: (Text -> Bool) -> BibFormat -> Text -> IO [Reference] readBiblioString idpred b s | Json <- b = either (E.throwIO . ErrorReadingBib)- return $ eitherDecode $ UTF8.fromStringLazy s+ return $ eitherDecode+ $ UTF8.fromTextLazy+ $ TL.fromStrict s | Yaml <- b = either (E.throwIO . ErrorReadingBib) return $ readYamlBib idpred s | Bibtex <- b = readBibtexString idpred True True s@@ -126,12 +130,12 @@ where go f = withTempDir "citeproc" $ \tdir -> do let tfile = tdir </> "bibutils-tmp.biblio"- UTF8.writeFile tfile s+ UTF8.writeFile tfile (T.unpack s) readBiblioFile' idpred tfile f #endif #ifdef USE_BIBUTILS-readBiblioFile' :: (String -> Bool) -> FilePath -> BiblioIn -> IO [Reference]+readBiblioFile' :: (Text -> Bool) -> FilePath -> BiblioIn -> IO [Reference] readBiblioFile' idpred fin bin | bin == biblatex_in = readBibtex idpred False True fin | otherwise = withTempDir "citeproc"@@ -171,19 +175,19 @@ getExt :: String -> String getExt = takeExtension . map toLower -readYamlBib :: (String -> Bool) -> String -> Either String [Reference]+readYamlBib :: (Text -> Bool) -> Text -> Either String [Reference] readYamlBib idpred s = case readMarkdown s' of (Pandoc meta _) -> convertRefs (lookupMeta "references" meta)- where s' = addTop $ addBottom- $ UTF8.toString- $ selectEntries idpred- $ UTF8.fromString+ where s' = addTop . addBottom+ . UTF8.toText+ . selectEntries idpred+ . UTF8.fromText $ s- addTop = ("---\n" ++)- addBottom = (++ "...\n")+ addTop = ("---\n" <>)+ addBottom = (<> "...\n") -selectEntries :: (String -> Bool) -> BS.ByteString -> BS.ByteString+selectEntries :: (Text -> Bool) -> BS.ByteString -> BS.ByteString selectEntries idpred bs = case YA.decode1Strict bs of Right (Array vs) -> YA.encode1Strict (filterObjects $ V.toList vs)@@ -209,7 +213,7 @@ _ -> False _ -> False) -filterEntries :: (String -> Bool) -> [Reference] -> [Reference]+filterEntries :: (Text -> Bool) -> [Reference] -> [Reference] filterEntries idpred = filter (\r -> idpred (unLiteral (refId r))) convertRefs :: Maybe MetaValue -> Either String [Reference]
src/Text/CSL/Output/Pandoc.hs view
@@ -29,7 +29,9 @@ ) where import Prelude+import Data.List (dropWhileEnd) import Data.Maybe (fromMaybe)+import Data.Text (Text) import qualified Data.Text as T import Text.CSL.Style import Text.CSL.Util (headInline, initInline, lastInline,@@ -45,11 +47,10 @@ -- remove leading/trailing LineBreak fixBreaks :: [Inline] -> [Inline]-fixBreaks =- dropWhile (== LineBreak) . reverse . dropWhile (== LineBreak) . reverse+fixBreaks = dropWhile (== LineBreak) . dropWhileEnd (== LineBreak) -renderPandoc' :: Style -> (Formatted, String) -> Block-renderPandoc' sty (form, citId) = Div (T.pack $ "ref-" <> citId, [], []) [Para $ renderPandoc sty form]+renderPandoc' :: Style -> (Formatted, Text) -> Block+renderPandoc' sty (form, citId) = Div ("ref-" <> citId, [], []) [Para $ renderPandoc sty form] clean' :: Style -> [Inline] -> [Inline] clean' _ [] = []@@ -65,14 +66,14 @@ (Span ("",["csl-inquote"],kvs) inls : _) -> let isOuter = lookup "position" kvs == Just "outer" in case headInline is of- [x] -> if x `elem` (".," :: String) && isPunctuationInQuote sty- then if lastInline inls `elem` [".",",",";",":","!","?"]- then quoted isOuter inls ++- clean' sty (tailInline is)- else quoted isOuter (inls ++ [Str (T.singleton x)]) +++ Just x -> if x `elem` (".," :: String) && isPunctuationInQuote sty+ then if lastInline inls `elem` map Just ".,;:!?"+ then quoted isOuter inls +++ clean' sty (tailInline is)+ else quoted isOuter (inls ++ [Str (T.singleton x)]) ++ clean' sty (tailInline is)- else quoted isOuter inls ++ clean' sty is- _ -> quoted isOuter inls ++ clean' sty is+ else quoted isOuter inls ++ clean' sty is+ _ -> quoted isOuter inls ++ clean' sty is (Quoted t inls : _) -> quoted (t == DoubleQuote) inls ++ clean' sty is _ -> if lastInline [i] == headInline is && isPunct then i : clean' sty (tailInline is)@@ -81,9 +82,9 @@ isPunct = all (`elem` (".,;:!? " :: String)) $ headInline is locale = case styleLocale sty of (x:_) -> x- [] -> Locale [] [] [] [] [] -- should not happen+ [] -> Locale "" "" [] [] [] -- should not happen getQuote s d = case [term | term <- localeTerms locale, cslTerm term == s] of- (x:_) -> Str $ T.pack $ termSingular x+ (x:_) -> Str $ termSingular x _ -> Str d openQuoteOuter = getQuote "open-quote" "“" openQuoteInner = getQuote "open-inner-quote" "‘"@@ -95,8 +96,8 @@ convertQuoted :: Style -> [Inline] -> [Inline] convertQuoted s = convertQuoted' where- locale = let l = styleLocale s in case l of [x] -> x; _ -> Locale [] [] [] [] []- getQuote x y = fromEntities . T.pack . termSingular . fromMaybe newTerm {termSingular = x} .+ locale = let l = styleLocale s in case l of [x] -> x; _ -> Locale "" "" [] [] []+ getQuote x y = fromEntities . termSingular . fromMaybe newTerm {termSingular = x} . findTerm y Long . localeTerms $ locale doubleQuotesO = getQuote "\"" "open-quote" doubleQuotesC = getQuote "\"" "close-quote"
src/Text/CSL/Output/Plain.hs view
@@ -19,11 +19,12 @@ ) where import Prelude+import Data.Text (Text) import Text.CSL.Compat.Pandoc (writePlain) import Text.CSL.Style import Text.Pandoc (Block (Plain), Pandoc (..), nullMeta) -- | Render the 'Formatted' into a plain text string.-renderPlain :: Formatted -> String+renderPlain :: Formatted -> Text renderPlain (Formatted ils) = writePlain $ Pandoc nullMeta [Plain ils]
src/Text/CSL/Pandoc.hs view
@@ -19,6 +19,7 @@ import Data.Char (isDigit, isPunctuation, isSpace) import qualified Data.Map as M import qualified Data.Set as Set+import Data.Text (Text) import qualified Data.Text as T import Data.Maybe (fromMaybe) import System.Directory (getAppUserDataDirectory)@@ -69,17 +70,17 @@ Nothing -> m3 Just x -> setMeta "nocite" x m3 notemap = mkNoteMap (Pandoc m3 bs)- hanging = maybe False (== "true")+ hanging = (== Just "true") (biblio style >>= lookup "hanging-indent" . bibOptions) in Pandoc m $ walk (addFirstNoteNumber notemap) $ walk (concatMap removeNocaseSpans) $ insertRefs hanging m biblioList bs -addFirstNoteNumber :: M.Map String Int -> Inline -> Inline+addFirstNoteNumber :: M.Map Text Int -> Inline -> Inline addFirstNoteNumber notemap s@(Span ("",["first-reference-note-number"],[("refid",refid)]) _)- = case M.lookup (T.unpack refid) notemap of+ = case M.lookup refid notemap of Nothing -> s Just n -> Str $ T.pack (show n) addFirstNoteNumber _ -- see below, these spans added by deNote@@ -87,13 +88,13 @@ = Note [Para ils] addFirstNoteNumber _ x = x -mkNoteMap :: Pandoc -> M.Map String Int+mkNoteMap :: Pandoc -> M.Map Text Int mkNoteMap doc = foldr go mempty $ splitUp $ zip [1..] $ query getNoteCitationIds doc where- splitUp :: [(Int, [String])] -> [(Int, String)]+ splitUp :: [(Int, [Text])] -> [(Int, Text)] splitUp = concatMap (\(n,ss) -> map (n,) ss)- go :: (Int, String) -> M.Map String Int -> M.Map String Int+ go :: (Int, Text) -> M.Map Text Int -> M.Map Text Int go (notenumber, citeid) = M.insert citeid notenumber -- if document contains a Div with id="refs", insert@@ -106,16 +107,22 @@ then bs else case runState (walkM go bs) False of (bs', True) -> bs'- (_, False) ->- case reverse bs of- Header lev (id',classes,kvs) ys : xs ->- reverse xs +++ (_, False)+ -> case refTitle meta of+ Nothing ->+ case reverse bs of+ Header lev (id',classes,kvs) ys : xs ->+ reverse xs ++ [Header lev (id',addUnNumbered classes,kvs) ys, Div ("refs",refclasses,[]) refs]- _ -> bs ++ refHeader ++- [Div ("refs",refclasses,[]) refs]+ _ -> bs ++ [refDiv]+ Just ils -> bs +++ [Header 1 ("bibliography", ["unnumbered"], []) ils,+ refDiv] where refclasses = "references" : if hanging then ["hanging-indent"] else []+ refDiv = Div ("refs", refclasses, []) refs+ addUnNumbered cs = "unnumbered" : [c | c <- cs, c /= "unnumbered"] go :: Block -> State Bool Block go (Div ("refs",cs,kvs) xs) = do put True@@ -123,11 +130,6 @@ let cs' = ordNub $ cs ++ refclasses return $ Div ("refs",cs',kvs) (xs ++ refs) go x = return x- addUnNumbered cs = "unnumbered" : [c | c <- cs, c /= "unnumbered"]- refHeader = case refTitle meta of- Just ils ->- [Header 1 ("bibliography", ["unnumbered"], []) ils]- _ -> [] refTitle :: Meta -> Maybe [Inline] refTitle meta =@@ -148,12 +150,12 @@ truish :: MetaValue -> Bool truish (MetaBool t) = t-truish (MetaString s) = isYesValue (T.unpack $ T.toLower s)-truish (MetaInlines ils) = isYesValue (T.unpack $ T.toLower (stringify ils))-truish (MetaBlocks [Plain ils]) = isYesValue (T.unpack $ T.toLower (stringify ils))+truish (MetaString s) = isYesValue (T.toLower s)+truish (MetaInlines ils) = isYesValue (T.toLower (stringify ils))+truish (MetaBlocks [Plain ils]) = isYesValue (T.toLower (stringify ils)) truish _ = False -isYesValue :: String -> Bool+isYesValue :: Text -> Bool isYesValue "t" = True isYesValue "true" = True isYesValue "yes" = True@@ -170,7 +172,7 @@ [] -> cs _ -> allcites allcites = map (\ref -> Citation{- citationId = T.pack $ unLiteral (refId ref),+ citationId = unLiteral (refId ref), citationPrefix = [], citationSuffix = [], citationMode = NormalCitation,@@ -202,7 +204,7 @@ let cslfile = (lookupMeta "csl" meta <|> lookupMeta "citation-style" meta) >>= toPath let mbLocale = (lookupMeta "lang" meta `mplus` lookupMeta "locale" meta)- >>= toPath+ >>= toText let tryReadCSLFile Nothing _ = mzero tryReadCSLFile (Just d) f = E.catch (readCSLFile mbLocale (d </> f)) (\(_ :: E.SomeException) -> mzero)@@ -216,8 +218,8 @@ -- if pandoc-citeproc compiled with unicode_collation flag case styleLocale csl of (l:_) -> do- setEnv "LC_ALL" (localeLang l)- setEnv "LANG" (localeLang l)+ setEnv "LC_ALL" (T.unpack $ localeLang l)+ setEnv "LANG" (T.unpack $ localeLang l) [] -> do envlang <- getEnv "LANG" if null envlang@@ -245,6 +247,15 @@ let csl' = csl{ styleAbbrevs = abbrevs } return $ processCites (tr' "CSL" csl') refs $ Pandoc meta blocks +toText :: MetaValue -> Maybe Text+toText (MetaString s) = Just s+-- take last in a list+toText (MetaList xs) = case reverse xs of+ [] -> Nothing+ (x:_) -> toText x+toText (MetaInlines ils) = Just $ stringify ils+toText _ = Nothing+ toPath :: MetaValue -> Maybe String toPath (MetaString s) = Just $ T.unpack s -- take last in a list@@ -254,7 +265,7 @@ toPath (MetaInlines ils) = Just $ T.unpack $ stringify ils toPath _ = Nothing -getBibRefs :: (String -> Bool) -> MetaValue -> IO [Reference]+getBibRefs :: (Text -> Bool) -> MetaValue -> IO [Reference] getBibRefs idpred (MetaList xs) = concat `fmap` mapM (getBibRefs idpred) xs getBibRefs idpred (MetaInlines xs) = getBibRefs idpred (MetaString $ stringify xs) getBibRefs idpred (MetaString s) = do@@ -267,20 +278,21 @@ unescapeRefId :: Reference -> Reference unescapeRefId ref = ref{ refId = Literal $ decodeEntities (unLiteral $ refId ref) } -decodeEntities :: String -> String-decodeEntities [] = []-decodeEntities ('&':xs) =- let (ys,zs) = break (==';') xs- in case zs of- ';':ws -> case lookupEntity ('&':ys ++ ";") of+decodeEntities :: Text -> Text+decodeEntities t = case T.uncons t of+ Nothing -> ""+ Just ('&',xs) ->+ let (ys,zs) = T.break (==';') xs+ in case T.uncons zs of+ Just (';',ws) -> case lookupEntity ('&': T.unpack ys ++ ";") of #if MIN_VERSION_tagsoup(0,13,0)- Just s -> s ++ decodeEntities ws+ Just s -> T.pack s <> decodeEntities ws #else- Just c -> c : decodeEntities ws+ Just c -> T.cons c (decodeEntities ws) #endif- Nothing -> '&' : decodeEntities xs- _ -> '&' : decodeEntities xs-decodeEntities (x:xs) = x : decodeEntities xs+ Nothing -> T.cons '&' (decodeEntities xs)+ _ -> T.cons '&' (decodeEntities xs)+ Just (x,xs) -> T.cons x (decodeEntities xs) -- | Substitute 'Cite' elements with formatted citations. processCite :: Style -> M.Map [Citation] Formatted -> Inline -> Inline@@ -293,11 +305,11 @@ where isSuppressAuthor c = citationMode c == SuppressAuthor processCite _ _ x = x -getNoteCitationIds :: Inline -> [[String]]+getNoteCitationIds :: Inline -> [[Text]] getNoteCitationIds (Note [Para (Span ("",["reference-id-list"] ,[("refids",refids)]) [] : _)]) -- see deNote below which inserts this special Span- = [words $ T.unpack refids]+ = [T.words refids] getNoteCitationIds (Note _) = [[]] getNoteCitationIds _ = [] @@ -330,8 +342,8 @@ = if moveNotes then mvPunct moveNotes sty $ case headInline ys of- "" -> q : x : tailInline ys- w -> q : Str (T.pack w) : x : tailInline ys+ Nothing -> q : x : tailInline ys+ Just w -> q : Str (T.singleton w) : x : tailInline ys else q : x : mvPunct moveNotes sty ys mvPunct moveNotes sty (Cite cs ils : ys) | length ils > 1@@ -341,9 +353,9 @@ = Cite cs (init ils ++ (case headInline ys of- "" -> []- s' | not (endWithPunct False (init ils)) -> [Str $ T.pack s']- | otherwise -> [])+ Nothing -> []+ Just s' | not (endWithPunct False (init ils)) -> [Str $ T.singleton s']+ | otherwise -> []) ++ [last ils]) : mvPunct moveNotes sty (tailInline ys) mvPunct moveNotes sty (q@(Quoted _ _) : w@(Str _) : x : ys) | isNote x@@ -355,7 +367,7 @@ mvPunct moveNotes sty (s : x@(Cite _ (Superscript _ : _)) : ys) | isSpacy s = x : mvPunct moveNotes sty ys mvPunct moveNotes sty (Cite cs ils : Str "." : ys)- | lastInline ils == "."+ | lastInline ils == Just '.' = Cite cs ils : mvPunct moveNotes sty ys mvPunct moveNotes sty (x:xs) = x : mvPunct moveNotes sty xs mvPunct _ _ [] = []@@ -414,8 +426,8 @@ getCitation i | Cite t _ <- i = [t] | otherwise = [] -getCitationIds :: Inline -> Set.Set String-getCitationIds (Cite cs _) = Set.map T.unpack $ Set.fromList (map citationId cs)+getCitationIds :: Inline -> Set.Set Text+getCitationIds (Cite cs _) = Set.fromList (map citationId cs) getCitationIds _ = mempty setHashes :: Inline -> State Int Inline@@ -440,12 +452,12 @@ _ -> s isPunct (Str (T.uncons -> Just (x,_))) = isPunctuation x isPunct _ = False- in emptyCite { CSL.citeId = T.unpack $ citationId c+ in emptyCite { CSL.citeId = citationId c , CSL.citePrefix = Formatted $ citationPrefix c , CSL.citeSuffix = Formatted s' , CSL.citeLabel = la , CSL.citeLocator = lo- , CSL.citeNoteNumber = show $ citationNoteNum c+ , CSL.citeNoteNumber = T.pack $ show $ citationNoteNum c , CSL.authorInText = citationMode c == AuthorInText , CSL.suppressAuthor = citationMode c == SuppressAuthor , CSL.citeHash = citationHash c@@ -457,7 +469,7 @@ splitOn ':' = False splitOn c = isPunctuation c -locatorWords :: LocatorMap -> [Inline] -> (String, String, [Inline])+locatorWords :: LocatorMap -> [Inline] -> (Text, Text, [Inline]) locatorWords locMap inp = case parse (pLocatorWords locMap) "suffix" $ splitInp inp of Right r -> r@@ -495,7 +507,7 @@ -- (a)(b)(c) -- (hello) -pLocatorWords :: LocatorMap -> Parsec [Inline] st (String, String, [Inline])+pLocatorWords :: LocatorMap -> Parsec [Inline] st (Text, Text, [Inline]) pLocatorWords locMap = do optional $ pMatchChar "," (== ',') optional pSpace@@ -505,26 +517,26 @@ -- i.e. the first one will be " 9" return (la, trim lo, s) -pLocatorDelimited :: LocatorMap -> Parsec [Inline] st (String, String)+pLocatorDelimited :: LocatorMap -> Parsec [Inline] st (Text, Text) pLocatorDelimited locMap = try $ do _ <- pMatchChar "{" (== '{') skipMany pSpace -- gobble pre-spaces so label doesn't try to include them (la, _) <- pLocatorLabelDelimited locMap -- we only care about balancing {} and [] (because of the outer [] scope); -- the rest can be anything- let inner = do { t <- anyToken; return (True, T.unpack $ stringify t) }+ let inner = do { t <- anyToken; return (True, stringify t) } gs <- many (pBalancedBraces [('{','}'), ('[',']')] inner) _ <- pMatchChar "}" (== '}')- let lo = concatMap snd gs+ let lo = T.concat $ map snd gs return (la, lo) -pLocatorLabelDelimited :: LocatorMap -> Parsec [Inline] st (String, Bool)+pLocatorLabelDelimited :: LocatorMap -> Parsec [Inline] st (Text, Bool) pLocatorLabelDelimited locMap = pLocatorLabel' locMap lim <|> return ("page", True) where- lim = T.unpack . stringify <$> anyToken+ lim = stringify <$> anyToken -pLocatorIntegrated :: LocatorMap -> Parsec [Inline] st (String, String)+pLocatorIntegrated :: LocatorMap -> Parsec [Inline] st (Text, Text) pLocatorIntegrated locMap = try $ do (la, wasImplicit) <- pLocatorLabelIntegrated locMap -- if we got the label implicitly, we have presupposed the first one is going@@ -535,17 +547,17 @@ else requireRomansOrDigits g <- try $ pLocatorWordIntegrated (not wasImplicit) >>= modifier gs <- many (try $ pLocatorWordIntegrated False >>= modifier)- let lo = concat (g:gs)+ let lo = T.concat (g:gs) return (la, lo) -pLocatorLabelIntegrated :: LocatorMap -> Parsec [Inline] st (String, Bool)+pLocatorLabelIntegrated :: LocatorMap -> Parsec [Inline] st (Text, Bool) pLocatorLabelIntegrated locMap = pLocatorLabel' locMap lim <|> (lookAhead digital >> return ("page", True)) where lim = try $ pLocatorWordIntegrated True >>= requireRomansOrDigits digital = try $ pLocatorWordIntegrated True >>= requireDigits -pLocatorLabel' :: LocatorMap -> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)+pLocatorLabel' :: LocatorMap -> Parsec [Inline] st Text -> Parsec [Inline] st (Text, Bool) pLocatorLabel' locMap lim = go "" where -- grow the match string until we hit the end@@ -555,15 +567,15 @@ -- the pathological case is "p.3" t <- anyToken ts <- manyTill anyToken (try $ lookAhead lim)- let s = acc ++ T.unpack (stringify (t:ts))+ let s = acc <> stringify (t:ts) case M.lookup (trim s) locMap of -- try to find a longer one, or return this one Just l -> go s <|> return (l, False) Nothing -> go s -- hard requirement for a locator to have some real digits in it-requireDigits :: (Bool, String) -> Parsec [Inline] st String-requireDigits (_, s) = if not (any isDigit s)+requireDigits :: (Bool, Text) -> Parsec [Inline] st Text+requireDigits (_, s) = if not (T.any isDigit s) then Prelude.fail "requireDigits" else return s @@ -571,39 +583,43 @@ -- (a)(iv) -- because iv is roman -- 1(a) -- because 1 is an actual digit -- NOT: a, (a)-(b), hello, (some text in brackets)-requireRomansOrDigits :: (Bool, String) -> Parsec [Inline] st String+requireRomansOrDigits :: (Bool, Text) -> Parsec [Inline] st Text requireRomansOrDigits (d, s) = if not d then Prelude.fail "requireRomansOrDigits" else return s -pLocatorWordIntegrated :: Bool -> Parsec [Inline] st (Bool, String)+pLocatorWordIntegrated :: Bool -> Parsec [Inline] st (Bool, Text) pLocatorWordIntegrated isFirst = try $ do punct <- if isFirst then return "" else (stringify <$> pLocatorSep) <|> return "" sp <- option "" (pSpace >> return " ") (dig, s) <- pBalancedBraces [('(',')'), ('[',']'), ('{','}')] pPageSeq- return (dig, T.unpack punct ++ sp ++ s)+ return (dig, punct <> sp <> s) -- we want to capture: 123, 123A, C22, XVII, 33-44, 22-33; 22-11 -- 34(1), 34A(A), 34(1)(i)(i), (1)(a) -- [17], [17]-[18], '591 [84]' -- (because CSL cannot pull out individual pages/sections -- to wrap in braces on a per-style basis)-pBalancedBraces :: [(Char, Char)] -> Parsec [Inline] st (Bool, String) -> Parsec [Inline] st (Bool, String)+pBalancedBraces :: [(Char, Char)]+ -> Parsec [Inline] st (Bool, Text)+ -> Parsec [Inline] st (Bool, Text) pBalancedBraces braces p = try $ do ss <- many1 surround return $ anyWereDigitLike ss where except = notFollowedBy pBraces >> p -- outer and inner- surround = foldl (\a (open, close) -> sur open close except <|> a) except braces+ surround = foldl (\a (open, close) -> sur open close except <|> a)+ except+ braces isc c = stringify <$> pMatchChar [c] (== c) sur c c' m = try $ do (d, mid) <- between (isc c) (isc c') (option (False, "") m)- return (d, [c] ++ mid ++ [c'])+ return (d, T.cons c . flip T.snoc c' $ mid) flattened = concatMap (\(o, c) -> [o, c]) braces pBraces = pMatchChar "braces" (`elem` flattened)@@ -611,7 +627,7 @@ -- YES 1, 1.2, 1.2.3 -- NO 1., 1.2. a.6 -- can't use sepBy because we want to leave trailing .s-pPageSeq :: Parsec [Inline] st (Bool, String)+pPageSeq :: Parsec [Inline] st (Bool, Text) pPageSeq = oneDotTwo <|> withPeriod where oneDotTwo = do@@ -622,12 +638,12 @@ -- .2 p <- pMatchChar "." (== '.') u <- try pPageUnit- return (fst u, T.unpack (stringify p) ++ snd u)+ return (fst u, stringify p <> snd u) -anyWereDigitLike :: [(Bool, String)] -> (Bool, String)-anyWereDigitLike as = (any fst as, concatMap snd as)+anyWereDigitLike :: [(Bool, Text)] -> (Bool, Text)+anyWereDigitLike as = (any fst as, T.concat $ map snd as) -pPageUnit :: Parsec [Inline] st (Bool, String)+pPageUnit :: Parsec [Inline] st (Bool, Text) pPageUnit = roman <|> plainUnit where -- roman is a 'digit'@@ -636,17 +652,17 @@ ts <- many1 (notFollowedBy pSpace >> notFollowedBy pLocatorPunct >> anyToken)- let s = T.unpack $ stringify ts+ let s = stringify ts -- otherwise look for actual digits or -s- return (any isDigit s, s)+ return (T.any isDigit s, s) -pRoman :: Parsec [Inline] st String+pRoman :: Parsec [Inline] st Text pRoman = try $ do t <- anyToken case t of Str xs -> case parseRomanNumeral (T.unpack xs) of Nothing -> mzero- Just _ -> return $ T.unpack xs+ Just _ -> return $ xs _ -> mzero isLocatorPunct :: Char -> Bool@@ -682,7 +698,7 @@ then Prelude.fail msg else return t -type LocatorMap = M.Map String String+type LocatorMap = M.Map Text Text locatorMap :: Style -> LocatorMap locatorMap sty =
src/Text/CSL/Parser.hs view
@@ -26,35 +26,36 @@ import Data.Maybe (fromMaybe, listToMaybe) import Data.Text (Text, unpack) import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL import System.Directory (getAppUserDataDirectory) import Text.CSL.Compat.Pandoc (fetchItem) import Text.CSL.Data (getLocale) import Text.CSL.Exception import Text.CSL.Style hiding (parseNames)-import Text.CSL.Util (findFile, toRead)+import Text.CSL.Util (findFile, toRead, trim) import Text.Pandoc.Shared (safeRead)-import Text.Pandoc.UTF8 (fromStringLazy) import qualified Text.XML as X import Text.XML.Cursor -- | Parse a 'String' into a 'Style' (with default locale).-parseCSL :: String -> Style-parseCSL = parseCSL' . fromStringLazy+parseCSL :: Text -> Style+parseCSL = parseCSL' . TL.encodeUtf8 . TL.fromStrict -- | Parse locale. Raises 'CSLLocaleException' on error.-parseLocale :: String -> IO Locale+parseLocale :: Text -> IO Locale parseLocale locale = parseLocaleElement . fromDocument . X.parseLBS_ X.def <$> getLocale locale -- | Merge locale into a CSL style.-localizeCSL :: Maybe String -> Style -> IO Style+localizeCSL :: Maybe Text -> Style -> IO Style localizeCSL mbLocale s = do let locale = fromMaybe (styleDefaultLocale s) mbLocale l <- parseLocale locale return s { styleLocale = mergeLocales locale l (styleLocale s) } -- | Read and parse a CSL style file into a localized sytle.-readCSLFile :: Maybe String -> FilePath -> IO Style+readCSLFile :: Maybe Text -> FilePath -> IO Style readCSLFile mbLocale src = do csldir <- getAppUserDataDirectory "csl" mbSrc <- findFile [".", csldir] src@@ -66,8 +67,8 @@ -- see if it's a dependent style, and if so, try to fetch its parent: let pickParentCur = get "link" >=> attributeIs (X.Name "rel" Nothing Nothing) "independent-parent" let parentCur = cur $/ get "info" &/ pickParentCur- let parent' = concatMap (stringAttr "href") parentCur- when (parent' == src) $+ let parent' = T.concat $ map (stringAttr "href") parentCur+ when (parent' == T.pack src) $ E.throwIO $ DependentStyleHasItselfAsParent src case parent' of "" -> localizeCSL mbLocale $ parseCSLCursor cur@@ -76,15 +77,15 @@ let mbLocale' = case stringAttr "default-locale" cur of "" -> mbLocale x -> Just x- readCSLFile mbLocale' y+ readCSLFile mbLocale' (T.unpack y) parseCSL' :: L.ByteString -> Style parseCSL' = parseCSLCursor . fromDocument . X.parseLBS_ X.def parseCSLCursor :: Cursor -> Style parseCSLCursor cur =- Style{ styleVersion = version- , styleClass = class_+ Style{ styleVersion = T.pack version+ , styleClass = T.pack class_ , styleInfo = Just info , styleDefaultLocale = defaultLocale , styleLocale = locales@@ -104,20 +105,20 @@ where version = unpack . T.concat $ cur $| laxAttribute "version" class_ = unpack . T.concat $ cur $| laxAttribute "class" defaultLocale = case cur $| laxAttribute "default-locale" of- (x:_) -> unpack x+ (x:_) -> x [] -> "en-US" author = case cur $// get "info" &/ get "author" of- (x:_) -> CSAuthor (x $/ get "name" &/ string)- (x $/ get "email" &/ string)- (x $/ get "uri" &/ string)+ (x:_) -> CSAuthor (T.concat $ x $/ get "name" &/ content)+ (T.concat $ x $/ get "email" &/ content)+ (T.concat $ x $/ get "uri" &/ content) _ -> CSAuthor "" "" "" info = CSInfo- { csiTitle = cur $/ get "info" &/ get "title" &/ string+ { csiTitle = T.concat $ (cur $/ get "info" &/ get "title" &/ content) , csiAuthor = author , csiCategories = [] -- TODO we don't really use this, and the type -- in Style doesn't match current CSL at all- , csiId = cur $/ get "info" &/ get "id" &/ string- , csiUpdated = cur $/ get "info" &/ get "updated" &/ string+ , csiId = T.concat $ cur $/ get "info" &/ get "id" &/ content+ , csiUpdated = T.concat $ cur $/ get "info" &/ get "updated" &/ content } locales = cur $/ get "locale" &| parseLocaleElement macros = cur $/ get "macro" &| parseMacroMap@@ -126,45 +127,40 @@ get name = element (X.Name name (Just "http://purl.org/net/xbiblio/csl") Nothing) -string :: Cursor -> String-string = unpack . T.concat . content- attrWithDefault :: Read a => Text -> a -> Cursor -> a attrWithDefault t d cur =- fromMaybe d $ safeRead (T.pack $ toRead $ stringAttr t cur)+ fromMaybe d $ safeRead (toRead $ stringAttr t cur) -stringAttr :: Text -> Cursor -> String+stringAttr :: Text -> Cursor -> Text stringAttr t cur = case node cur of X.NodeElement e ->- case M.lookup (X.Name t Nothing Nothing)- (X.elementAttributes e) of- Just x -> unpack x+ case M.lookup (X.Name t Nothing Nothing) (X.elementAttributes e) of+ Just x -> x Nothing -> "" _ -> "" parseCslTerm :: Cursor -> CslTerm parseCslTerm cur =- let body = unpack $ T.dropAround (`elem` (" \t\r\n" :: String)) $- T.concat $ cur $/ content+ let body = trim . T.concat $ cur $/ content in CT { cslTerm = stringAttr "name" cur , termForm = attrWithDefault "form" Long cur , termGender = attrWithDefault "gender" Neuter cur , termGenderForm = attrWithDefault "gender-form" Neuter cur- , termSingular = if null body- then cur $/ get "single" &/ string+ , termSingular = if T.null body+ then T.concat $ cur $/ get "single" &/ content else body- , termPlural = if null body- then cur $/ get "multiple" &/ string+ , termPlural = if T.null body+ then T.concat $ cur $/ get "multiple" &/ content else body , termMatch = stringAttr "match" cur } parseLocaleElement :: Cursor -> Locale parseLocaleElement cur = Locale- { localeVersion = unpack $ T.concat version- , localeLang = unpack $ T.concat lang+ { localeVersion = T.concat version+ , localeLang = T.concat lang , localeOptions = concat $ cur $/ get "style-options" &| parseOptions , localeTerms = terms , localeDate = concat $ cur $/ get "date" &| parseElement@@ -212,7 +208,7 @@ } parseDate :: Cursor -> [Element]-parseDate cur = [Date (words variable) form format delim parts partsAttr]+parseDate cur = [Date (T.words variable) form format delim parts partsAttr] where variable = stringAttr "variable" cur form = case stringAttr "form" cur of "text" -> TextDate@@ -239,13 +235,13 @@ } parseNames :: Cursor -> [Element]-parseNames cur = [Names (words variable) names formatting delim others]+parseNames cur = [Names (T.words variable) names formatting delim others] where variable = stringAttr "variable" cur formatting = getFormatting cur delim = stringAttr "delimiter" cur elts = cur $/ parseName names = case rights elts of- [] -> [Name NotSet emptyFormatting [] [] []]+ [] -> [Name NotSet emptyFormatting [] "" []] xs -> xs others = lefts elts @@ -265,7 +261,7 @@ plural = attrWithDefault "plural" Contextual cur delim = stringAttr "delimiter" cur nameParts = cur $/ get "name-part" &| parseNamePart- nameAttrs x = [(T.unpack n, T.unpack v) |+ nameAttrs x = [(n, v) | (X.Name n _ _, v) <- M.toList (X.elementAttributes x), n `elem` nameAttrKeys] nameAttrKeys = [ "et-al-min"@@ -308,13 +304,13 @@ formatting = getFormatting cur plural = attrWithDefault "plural" True cur textForm = attrWithDefault "form" Long cur- in if not (null term)+ in if not (T.null term) then [Term term textForm formatting plural]- else if not (null macro)+ else if not (T.null macro) then [Macro macro formatting]- else if not (null variable)- then [Variable (words variable) textForm formatting delim]- else [Const value formatting | not (null value)]+ else if not (T.null variable)+ then [Variable (T.words variable) textForm formatting delim]+ else [Const value formatting | not (T.null value)] parseChoose :: Cursor -> [Element] parseChoose cur =@@ -336,7 +332,7 @@ } mat = attrWithDefault "match" All cur elts = cur $/ parseElement- go x = words $ stringAttr x cur+ go x = T.words $ stringAttr x cur parseLabel :: Cursor -> [Element] parseLabel cur = [Label variable form formatting plural]@@ -408,7 +404,7 @@ parseOptions cur = case node cur of X.NodeElement e ->- [(T.unpack n, T.unpack v) |+ [(n, v) | (X.Name n _ _, v) <- M.toList (X.elementAttributes e)] _ -> []
src/Text/CSL/Proc.hs view
@@ -25,10 +25,11 @@ import Control.Arrow (second, (&&&), (>>>)) import Control.Monad.State (execState, modify) import Data.Aeson-import Data.Char (isDigit, isLetter, toLower)+import Data.Char (isDigit, isLetter) import Data.List import Data.Maybe (mapMaybe) import Data.Ord (comparing)+import Data.Text (Text) import qualified Data.Text as T import Text.CSL.Eval import Text.CSL.Proc.Collapse@@ -46,13 +47,13 @@ deriving ( Show, Read, Eq ) data BibOpts- = Select [(String, String)] [(String, String)]- | Include [(String, String)] [(String, String)]- | Exclude [(String, String)] [(String, String)]+ = Select [(Text, Text)] [(Text, Text)]+ | Include [(Text, Text)] [(Text, Text)]+ | Exclude [(Text, Text)] [(Text, Text)] deriving ( Show, Read, Eq ) newtype FieldVal = FieldVal{- unFieldVal :: (String, String)+ unFieldVal :: (Text, Text) } deriving Show instance FromJSON FieldVal where@@ -125,15 +126,15 @@ addLink :: (Cite, Output) -> (Cite, Output) addLink (cit, outp) = (cit, proc (addLink' (citeId cit)) outp) addLink' citeid (OYear y _ f) =- OYear y citeid f{hyperlink = "#ref-" ++ citeid}+ OYear y citeid f{hyperlink = "#ref-" <> citeid} addLink' citeid (OYearSuf y _ d f) =- OYearSuf y citeid d f{hyperlink = "#ref-" ++ citeid}+ OYearSuf y citeid d f{hyperlink = "#ref-" <> citeid} addLink' citeid (OCitNum n f) =- OCitNum n f{hyperlink = "#ref-" ++ citeid}+ OCitNum n f{hyperlink = "#ref-" <> citeid} addLink' citeid (OCitLabel l f) =- OCitLabel l f{hyperlink = "#ref-" ++ citeid}+ OCitLabel l f{hyperlink = "#ref-" <> citeid} addLink' citeid (Output xs@(OStr _ _: _) f) =- Output xs f{hyperlink = "#ref-" ++ citeid}+ Output xs f{hyperlink = "#ref-" <> citeid} addLink' _ x = x -- | Given the CSL 'Style' and the list of 'Reference's sort the list@@ -190,13 +191,13 @@ evalBib b = evalLayout (bibLayout b) (EvalBiblio emptyCite {citePosition = "first"}) False l ms (mergeOptions (bibOptions b) opts) as . Just subsequentAuthorSubstitute :: Bibliography -> [[Output]] -> [[Output]]-subsequentAuthorSubstitute b = if null subAuthStr then id else chkCreator+subsequentAuthorSubstitute b = if T.null subAuthStr then id else chkCreator where subAuthStr = getOptionVal "subsequent-author-substitute" (bibOptions b) subAuthRule = getOptionVal "subsequent-author-substitute-rule" (bibOptions b) queryContrib = proc' rmLabel . query contribsQ- getContrib = if null subAuthStr+ getContrib = if T.null subAuthStr then const [] else case subAuthRule of "partial-first" -> take 1 . query namesQ . queryContrib@@ -277,6 +278,7 @@ select s r = all (lookup_ r) s include i r = any (lookup_ r) i exclude e r = all (not . lookup_ r) e+ lookup_ :: Reference -> (Text, Text) -> Bool lookup_ r (f, v) = case f of "type" -> look "ref-type" "id" -> look "ref-id"@@ -284,11 +286,11 @@ x -> look x where look s = case lookup s (mkRefMap (Just r)) of- Just x | Just v' <- (fromValue x :: Maybe RefType ) -> v == uncamelize (show v')- | Just v' <- (fromValue x :: Maybe String ) -> v == v'- | Just v' <- (fromValue x :: Maybe [String] ) -> v `elem` v'- | Just v' <- (fromValue x :: Maybe [Agent] ) -> null v && null v' || v == show v'- | Just v' <- (fromValue x :: Maybe [RefDate]) -> null v && null v' || v == show v'+ Just x | Just v' <- (fromValue x :: Maybe RefType ) -> v == T.pack (uncamelize (show v'))+ | Just v' <- (fromValue x :: Maybe Text ) -> v == v'+ | Just v' <- (fromValue x :: Maybe [Text] ) -> v `elem` v'+ | Just v' <- (fromValue x :: Maybe [Agent] ) -> T.null v && null v' || v == T.pack (show v')+ | Just v' <- (fromValue x :: Maybe [RefDate]) -> T.null v && null v' || v == T.pack (show v') _ -> False -- | Given the CSL 'Style' and the list of 'Cite's coupled with their@@ -349,7 +351,7 @@ formatOutputList . appendOutput formatting . addAffixes f . addDelim d . map (fst &&& localMod >>> uncurry addCiteAffixes)- formatting = f{ prefix = [], suffix = [],+ formatting = f{ prefix = "", suffix = "", verticalAlign = if isAuthorInText cs then "" else verticalAlign f }@@ -368,15 +370,15 @@ | [Output [ONull] _] <- os = [] | otherwise = pref ++ suff where- pref = if not (null (prefix f))+ pref = if not (T.null (prefix f)) then OStr (prefix f) emptyFormatting : os else os- suff = case suffix f of- [] -> []- (c:cs)+ suff = case T.uncons $ suffix f of+ Nothing -> []+ Just (c,_) | isLetter c || isDigit c || c == '(' || c == '[' ->- [OSpace, OStr (c:cs) emptyFormatting]- | otherwise -> [OStr (c:cs) emptyFormatting]+ [OSpace, OStr (suffix f) emptyFormatting]+ | otherwise -> [OStr (suffix f) emptyFormatting] -- | The 'Bool' is 'True' if we are formatting a textual citation (in -- pandoc terminology).@@ -386,8 +388,8 @@ | suppressAuthor c = check . rmContrib . return | otherwise = id where- isPunct' [] = False- isPunct' xs = all (`elem` (".,;:!? " :: String)) xs+ isPunct' "" = False+ isPunct' xs = T.all (`elem` (".,;:!? " :: String)) xs check o = case cleanOutput o of [] -> ONull x -> case trim' x of@@ -401,15 +403,15 @@ | otherwise = [True] trim' [] = [] trim' (o:os)- | Output ot f <- o, p <- prefix f, p /= []- , isPunct' p = trim' $ Output ot f { prefix = []} : os+ | Output ot f <- o, p <- prefix f, p /= ""+ , isPunct' p = trim' $ Output ot f { prefix = "" } : os | Output ot f <- o = if or (query hasOutput ot) then Output (trim' ot) f : os else Output ot f : trim' os | ODel _ <- o = trim' os | OSpace <- o = trim' os | OStr x f <- o = OStr x (if isPunct' (prefix f)- then f { prefix = []} else f) : os+ then f { prefix = "" } else f) : os | otherwise = o:os rmCitNum o | OCitNum {} <- o = ONull@@ -436,7 +438,7 @@ | OContrib _ "authorsub" _ _ _ <- o = rmContrib' os | OStr x _ <- o- , "ibid" <- filter (/= '.') (map toLower x) = rmContrib' os+ , "ibid" <- T.filter (/= '.') (T.toLower x) = rmContrib' os | otherwise = o : rmContrib' os @@ -456,6 +458,5 @@ prefix = "", suffix = "" } | OStr x _ <- o- , "ibid" <- filter (/= '.')- (map toLower x) = o+ , "ibid" <- T.filter (/= '.') (T.toLower x) = o | otherwise = ONull
src/Text/CSL/Proc/Collapse.hs view
@@ -25,11 +25,12 @@ import Data.List (groupBy, sortBy) import Data.Monoid (Any (..)) import Data.Ord (comparing)+import Data.Text (Text) import qualified Data.Text as T import Text.CSL.Eval import Text.CSL.Proc.Disamb import Text.CSL.Style hiding (Any)-import Text.CSL.Util (orIfNull, proc, proc', query)+import Text.CSL.Util (proc, proc', query) import Text.Pandoc.Definition (Inline (Str)) -- | Collapse citations according to the style options.@@ -38,14 +39,14 @@ = map doCollapse where doCollapse = case getCollapseOptions s of- "year" : _ -> collapseYear s []+ "year" : _ -> collapseYear s "" "year-suffix" : _ -> collapseYear s "year-suffix" "year-suffix-ranged" : _ -> collapseYear s "year-suffix-ranged" "citation-number" : _ -> collapseNumber _ -> id -- | Get the collapse option set in the 'Style' for citations.-getCollapseOptions :: Style -> [String]+getCollapseOptions :: Style -> [Text] getCollapseOptions = map snd . filter ((==) "collapse" . fst) . citOptions . citation @@ -103,13 +104,15 @@ | OStatus {} : _ <- o = [head o] | otherwise = [] -collapseYear :: Style -> String -> CitationGroup -> CitationGroup-collapseYear s ranged (CG cs f d os) = CG cs f [] (process os)+collapseYear :: Style -> Text -> CitationGroup -> CitationGroup+collapseYear s ranged (CG cs f d os) = CG cs f "" (process os) where styleYSD = getOptionVal "year-suffix-delimiter" . citOptions . citation $ s- yearSufDel = styleYSD `orIfNull` (layDelim . citLayout . citation $ s)+ yearSufDel = if T.null styleYSD+ then layDelim . citLayout . citation $ s+ else styleYSD afterCD = getOptionVal "after-collapse-delimiter" . citOptions . citation $ s- afterColDel = afterCD `orIfNull` d+ afterColDel = if T.null afterCD then d else afterCD format [] = [] format (x:xs) = x : map getYearAndSuf xs@@ -118,14 +121,14 @@ "year-suffix-ranged" -> True _ -> False - collapseRange = if null ranged then map (uncurry addCiteAffixes)+ collapseRange = if T.null ranged then map (uncurry addCiteAffixes) else collapseYearSuf isRanged yearSufDel rmAffixes x = x {citePrefix = mempty, citeSuffix = mempty} delim = let d' = getOptionVal "cite-group-delimiter" . citOptions . citation $ s -- FIXME: see https://bitbucket.org/bdarcus/citeproc-test/issue/15 -- in if null d' then if null d then ", " else d else d'- in if null d' then ", " else d'+ in if T.null d' then ", " else d' collapsYS a = case a of [] -> (emptyCite, ONull)@@ -149,10 +152,10 @@ namesOf (snd a) == namesOf (snd b) process = doCollapse . groupBy hasSameNames . groupCites -collapseYearSuf :: Bool -> String -> [(Cite,Output)] -> [Output]+collapseYearSuf :: Bool -> Text -> [(Cite,Output)] -> [Output] collapseYearSuf ranged ysd = process where- yearOf = concat . query getYear+ yearOf = T.concat . query getYear getYear o | OYear y _ _ <- o = [y] | otherwise = []@@ -168,8 +171,8 @@ checkAffix (citeSuffix $ fst a) && checkAffix (citePrefix $ fst b) && checkAffix (citeSuffix $ fst b) &&- null (citeLocator $ fst a) &&- null (citeLocator $ fst b)+ T.null (citeLocator $ fst a) &&+ T.null (citeLocator $ fst b) getYS [] = [] getYS [x] = return $ uncurry addCiteAffixes x@@ -187,17 +190,17 @@ collapseYearSufRanged = process where getOYS o- | OYearSuf s _ _ f <- o = [(if s /= [] then ord (head s) else 0, f)]+ | OYearSuf s _ _ f <- o = [(if s /= "" then ord (T.head s) else 0, f)] | otherwise = [] sufOf = foldr const (0,emptyFormatting) . query getOYS newSuf = map sufOf >>> (map fst >>> groupConsec) &&& map snd >>> uncurry zip process xs = flip concatMap (newSuf xs) $ \(x,f) -> if length x > 2- then return $ Output [ OStr [chr $ head x] f+ then return $ Output [ OStr (T.singleton . chr $ head x) f , OPan [Str "\x2013"]- , OStr [chr $ last x] f+ , OStr (T.singleton . chr $ last x) f ] emptyFormatting- else map (\y -> if y == 0 then ONull else flip OStr f . return . chr $ y) x+ else map (\y -> if y == 0 then ONull else flip OStr f . T.singleton . chr $ y) x addCiteAffixes :: Cite -> Output -> Output addCiteAffixes c x =
src/Text/CSL/Proc/Disamb.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} #if MIN_VERSION_base(4,9,0) {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}@@ -25,7 +26,9 @@ import Prelude import Control.Arrow (second, (&&&), (>>>)) import Data.List (elemIndex, find, findIndex, groupBy,- isPrefixOf, mapAccumL, nub, nubBy, sortOn)+ mapAccumL, nub, nubBy, sortOn)+import Data.Text (Text)+import qualified Data.Text as T import Data.Maybe import Text.CSL.Eval import Text.CSL.Reference@@ -36,7 +39,7 @@ -- | Given the 'Style', the list of references and the citation -- groups, disambiguate citations according to the style options. disambCitations :: Style -> [Reference] -> Citations -> [CitationGroup]- -> ([(String, String)], [CitationGroup])+ -> ([(Text, Text)], [CitationGroup]) disambCitations s bibs cs groups = (,) yearSuffs citOutput where@@ -81,7 +84,7 @@ -- the list of citations that need re-evaluation with the -- \"disambiguate\" condition set to 'True'- reEval = let chk = if hasYSuffOpt then filter ((==) [] . citYear) else id+ reEval = let chk = if hasYSuffOpt then filter (T.null . citYear) else id in chk needYSuff reEvaluated = if or (query hasIfDis s) && not (null reEval) then zipWith (reEvaluate s reEval) refs groups@@ -188,10 +191,10 @@ -- | Get the list of disambiguation options set in the 'Style' for -- citations.-getCitDisambOptions :: Style -> [String]+getCitDisambOptions :: Style -> [Text] getCitDisambOptions = map fst . filter ((==) "true" . snd) .- filter (isPrefixOf "disambiguate" . fst) . citOptions . citation+ filter (T.isPrefixOf "disambiguate" . fst) . citOptions . citation -- | Group citation data (with possible alternative names) of -- citations which have a duplicate (same 'collision', and same@@ -222,8 +225,8 @@ ys -> ys ++ rmExtras g xs | OContrib _ _ (y:ys) _ _ : xs <- os = if g == PrimaryName- then OContrib [] [] [y] [] [] : rmExtras g xs- else OContrib [] [] (y:ys) [] [] : rmExtras g xs+ then OContrib "" "" [y] [] [] : rmExtras g xs+ else OContrib "" "" (y:ys) [] [] : rmExtras g xs | OYear{} : xs <- os = rmExtras g xs | OYearSuf{} : xs <- os = rmExtras g xs | OLabel{} : xs <- os = rmExtras g xs@@ -241,21 +244,21 @@ = (contribs &&& years >>> zipData) out where contribs x = case query contribsQ x of- [] -> [CD [] [out] [] [] [] [] []]+ [] -> [CD "" [out] [] [] [] [] ""] -- allow title to disambiguate xs -> xs years o = case query getYears o of- [] -> [([],[])]+ [] -> [("","")] r -> r- zipData = uncurry . zipWith $ \c y -> if key c /= []+ zipData = uncurry . zipWith $ \c y -> if key c /= "" then c {citYear = snd y} else c {key = fst y ,citYear = snd y} contribsQ o- | OContrib k _ _ d dd <- o = [CD k [out] d (d:dd) [] [] []]+ | OContrib k _ _ d dd <- o = [CD k [out] d (d:dd) [] [] ""] | otherwise = [] -getYears :: Output -> [(String,String)]+getYears :: Output -> [(Text,Text)] getYears o | OYear x k _ <- o = [(k,x)] | otherwise = []@@ -283,7 +286,7 @@ | OName i n ns _ <- o = [ND i n (n:ns) []] | otherwise = [] -generateYearSuffix :: [Reference] -> [(String, [Output])] -> [(String,String)]+generateYearSuffix :: [Reference] -> [(Text, [Output])] -> [(Text,Text)] generateYearSuffix refs = concatMap (`zip` suffs) . -- sort clashing cites using their position in the sorted bibliography@@ -299,15 +302,15 @@ getP k = case findIndex ((==) k . unLiteral . refId) refs of Just x -> (k, x + 1) _ -> (k, 0)- suffs = letters ++ [x ++ y | x <- letters, y <- letters ]- letters = map (:[]) ['a'..'z']+ suffs = letters ++ [x <> y | x <- letters, y <- letters ]+ letters = map T.singleton ['a'..'z'] setYearSuffCollision :: Bool -> [CiteData] -> [Output] -> [Output] setYearSuffCollision b cs = proc (setYS cs) . map (\x -> if hasYearSuf x then x else addYearSuffix x) where setYS c o- | OYearSuf _ k _ f <- o = OYearSuf [] k (getCollision k c) f+ | OYearSuf _ k _ f <- o = OYearSuf "" k (getCollision k c) f | otherwise = o collide = if b then disambed else disambYS getCollision k c = case find ((==) k . key) c of@@ -316,14 +319,14 @@ ys -> ys _ -> [] -updateYearSuffixes :: [(String, String)] -> Output -> Output+updateYearSuffixes :: [(Text, Text)] -> Output -> Output updateYearSuffixes yss o | OYearSuf _ k c f <- o = case lookup k yss of Just x -> OYearSuf x k c f _ -> ONull | otherwise = o -getYearSuffixes :: CitationGroup -> [(String,[Output])]+getYearSuffixes :: CitationGroup -> [(Text,[Output])] getYearSuffixes (CG _ _ _ d) = map go d where go (c,x) = (citeId c, relevant False [x]) relevant :: Bool -> [Output] -> [Output] -- bool is true if has contrib@@ -391,7 +394,7 @@ addYearSuffix :: Output -> Output addYearSuffix o | OYear y k f <- o = Output [ OYear y k emptyFormatting- , OYearSuf [] k [] emptyFormatting] f+ , OYearSuf "" k [] emptyFormatting] f | ODate (x:xs) <- o = if any hasYear xs then Output (x : [addYearSuffix $ ODate xs]) emptyFormatting else addYearSuffix (Output (x:xs) emptyFormatting)@@ -411,7 +414,7 @@ hasYearSuf :: Output -> Bool hasYearSuf = not . null . query getYearSuf- where getYearSuf :: Output -> [String]+ where getYearSuf :: Output -> [Text] getYearSuf o | OYearSuf{} <- o = ["a"] | otherwise = []
src/Text/CSL/Reference.hs view
@@ -67,7 +67,6 @@ import Data.Generics hiding (Generic) import qualified Data.HashMap.Strict as H import Data.List (find, elemIndex)-import Data.List.Split (splitWhen) import Data.Maybe (fromMaybe, isNothing) import Data.String import Data.Text (Text)@@ -83,13 +82,13 @@ uncamelize, AddYaml(..), splitStrWhen) import Text.Pandoc (Inline (Str)) import qualified Text.Parsec as P-import qualified Text.Parsec.String as P+import qualified Text.Parsec.Text as P -newtype Literal = Literal { unLiteral :: String }+newtype Literal = Literal { unLiteral :: Text } deriving ( Show, Read, Eq, Data, Typeable, Semigroup, Monoid, Generic ) instance AddYaml Literal- where x &= (Literal y) = x &= (T.pack y)+ where x &= (Literal y) = x &= y instance FromJSON Literal where parseJSON v = Literal `fmap` parseString v@@ -98,10 +97,10 @@ toJSON = toJSON . unLiteral instance ToYaml Literal where- toYaml = Y.string . T.pack . unLiteral+ toYaml = Y.string . unLiteral instance IsString Literal where- fromString = Literal+ fromString = Literal . T.pack -- | An existential type to wrap the different types a 'Reference' is -- made of. This way we can create a map to make queries easier.@@ -111,12 +110,12 @@ instance Show Value where show (Value a) = gshow a -type ReferenceMap = [(String, Value)]+type ReferenceMap = [(Text, Value)] mkRefMap :: Maybe Reference -> ReferenceMap mkRefMap Nothing = [] mkRefMap (Just r) = zip fields (gmapQ Value r)- where fields = map uncamelize . constrFields . toConstr $ r+ where fields = map (T.pack . uncamelize) . constrFields . toConstr $ r fromValue :: Data a => Value -> Maybe a fromValue (Value a) = cast a@@ -136,7 +135,7 @@ data Empty = Empty deriving ( Typeable, Data, Generic ) -data Season = Spring | Summer | Autumn | Winter | RawSeason String+data Season = Spring | Summer | Autumn | Winter | RawSeason Text deriving (Show, Read, Eq, Typeable, Data, Generic) instance ToYaml Season where@@ -144,7 +143,7 @@ toYaml Summer = toYaml (2 :: Int) toYaml Autumn = toYaml (3 :: Int) toYaml Winter = toYaml (4 :: Int)- toYaml (RawSeason s) = toYaml (T.pack s)+ toYaml (RawSeason s) = toYaml s seasonToInt :: Season -> Maybe Int seasonToInt Spring = Just 1@@ -177,7 +176,7 @@ Nothing -> fail $ "Could not read season: " ++ show n Nothing -> do s <- parseString x- if null s+ if T.null s then return Nothing else return $ Just $ RawSeason s @@ -277,8 +276,8 @@ Just (RawSeason s) -> ["season" .= s] _ -> []) ++ (case mconcat (map other ds) of- Literal l | not (null l) -> ["literal" .= l]- _ -> [])+ Literal l | not (T.null l) -> ["literal" .= l]+ _ -> []) where dateparts = filter (not . emptyDatePart) $ map toDatePart ds emptyDatePart [] = True emptyDatePart xs = all (== 0) xs@@ -300,12 +299,12 @@ -- workaround is 2005_2007 or 2005_; support this as date range: handleLiteral :: RefDate -> [RefDate] handleLiteral d@(RefDate Nothing Nothing Nothing Nothing (Literal xs) b)- = case splitWhen (=='_') xs of- [x,y] | all isDigit x && all isDigit y &&- not (null x) ->- [RefDate (safeRead $ T.pack x) Nothing Nothing Nothing mempty b,- RefDate (safeRead $ T.pack y) Nothing Nothing Nothing mempty b]- _ -> [d]+ = case T.splitOn "_" xs of+ [x,y] | T.all isDigit x && T.all isDigit y &&+ not (T.null x) ->+ [RefDate (safeRead x) Nothing Nothing Nothing mempty b,+ RefDate (safeRead y) Nothing Nothing Nothing mempty b]+ _ -> [d] handleLiteral d = [d] setCirca :: Bool -> RefDate -> RefDate@@ -360,12 +359,12 @@ -- found in one of the test cases: parseJSON (String "film") = return MotionPicture parseJSON (String t) =- safeRead (T.pack . capitalize . camelize . T.unpack $ t) <|>+ safeRead (capitalize . T.pack . camelize $ t) <|> fail ("'" ++ T.unpack t ++ "' is not a valid reference type") parseJSON v@(Array _) =- fmap (capitalize . camelize . inlinesToString) (parseJSON v) >>= \t ->- safeRead (T.pack t) <|>- fail ("'" ++ t ++ "' is not a valid reference type")+ fmap (capitalize . T.pack . camelize . inlinesToString) (parseJSON v) >>= \t ->+ safeRead t <|>+ fail ("'" ++ T.unpack t ++ "' is not a valid reference type") parseJSON _ = fail "Could not parse RefType" instance ToJSON RefType where@@ -394,7 +393,8 @@ instance ToYaml CNum where toYaml r = Y.string (T.pack $ show $ unCNum r) -newtype CLabel = CLabel { unCLabel :: String } deriving ( Show, Read, Eq, Typeable, Data, Generic, Semigroup, Monoid )+newtype CLabel = CLabel { unCLabel :: Text }+ deriving ( Show, Read, Eq, Typeable, Data, Generic, Semigroup, Monoid ) instance FromJSON CLabel where parseJSON x = CLabel `fmap` parseString x@@ -403,7 +403,7 @@ toJSON (CLabel s) = toJSON s instance ToYaml CLabel where- toYaml (CLabel s) = toYaml $ T.pack s+ toYaml (CLabel s) = toYaml s -- | The 'Reference' record. data Reference =@@ -863,7 +863,7 @@ , citationLabel = mempty } -numericVars :: [String]+numericVars :: [Text] numericVars = [ "edition", "volume", "number-of-volumes", "number", "issue", "citation-number" , "chapter-number", "collection-number", "number-of-pages"] @@ -872,7 +872,7 @@ = case (hasId (citeId c)) `find` rs of Just r -> Just $ setPageFirst r Nothing -> Nothing- where hasId :: String -> Reference -> Bool+ where hasId :: Text -> Reference -> Bool hasId ident r = ident `elem` (map unLiteral (refId r : refOtherIds r)) processCites :: [Reference] -> [[Cite]] -> [[(Cite, Maybe Reference)]]@@ -957,8 +957,8 @@ setNearNote s cs = procGr [] cs where- near_note = let nn = fromMaybe [] . lookup "near-note-distance" . citOptions . citation $ s- in if null nn then 5 else readNum nn+ near_note = let nn = lookup "near-note-distance" . citOptions . citation $ s+ in maybe 5 readNum nn procGr _ [] = [] procGr a (x:xs) = let (a',res) = procCs a x in res : procGr a' xs@@ -973,7 +973,7 @@ readNum (citeNoteNumber c) - readNum (citeNoteNumber x) <= near_note _ -> False -parseRawDate :: String -> [RefDate]+parseRawDate :: Text -> [RefDate] parseRawDate o = case P.parse rawDate "raw date" o of Left _ -> [RefDate Nothing Nothing Nothing Nothing (Literal o) False]@@ -982,21 +982,22 @@ rawDate :: P.Parser [RefDate] rawDate = rawDateISO <|> rawDateOld -parseEDTFDate :: String -> [RefDate]+parseEDTFDate :: Text -> [RefDate] parseEDTFDate o = case handleRanges (trim o) of- [] -> []+ "" -> [] o' -> case P.parse rawDateISO "date" o' of Left _ -> [] Right ds -> ds where handleRanges s =- case splitWhen (=='/') s of+ case T.splitOn "/" s of -- 199u EDTF format for a range- [x] | 'u' `elem` x ->- map (\c -> if c == 'u' then '0' else c) x ++ "/" ++- map (\c -> if c == 'u' then '9' else c) x- [x, "open"] -> x ++ "/" -- EDTF- [x, "unknown"] -> x ++ "/" -- EDTF+ [x] | T.any (== 'u') x ->+ T.map (\c -> if c == 'u' then '0' else c) x+ <> "/" <>+ T.map (\c -> if c == 'u' then '9' else c) x+ [x, "open"] -> x <> "/" -- EDTF+ [x, "unknown"] -> x <> "/" -- EDTF _ -> s rawDateISO :: P.Parser [RefDate]
src/Text/CSL/Style.hs view
@@ -104,21 +104,22 @@ import Data.Char (isLetter, isPunctuation, isUpper, toLower, isDigit) import qualified Data.Char as Char import Data.Generics (Data, Typeable)-import Data.List (intercalate, intersperse, isInfixOf,- isPrefixOf, nubBy)-import Data.List.Split (splitWhen, wordsBy)+import Data.List (intercalate, intersperse, nubBy)+import Data.List.Split (wordsBy) import qualified Data.Map as M import Data.Maybe (listToMaybe, isNothing) import Data.String+import Data.Text (Text) import qualified Data.Text as T import Data.Yaml.Builder (ToYaml (..)) import qualified Data.Yaml.Builder as Y import GHC.Generics (Generic) import Text.CSL.Compat.Pandoc (readHtml, writeMarkdown)-import Text.CSL.Util (orIfNull, headInline, initInline,+import Text.CSL.Util (headInline, initInline, lastInline, mapping', mb, parseBool,- parseString, query, splitStrWhen,- tailInline, trimr, (.#:), (.#?),+ parseString, query, splitWhen,+ splitStrWhen, tailInline, trimr,+ (.#:), (.#?), AddYaml(..), addSpaceAfterPeriod) import qualified Text.Pandoc.Builder as B import Text.Pandoc.Definition hiding (Citation, Cite)@@ -139,7 +140,7 @@ -- for reading JSON citeproc bibliographies. ToJSON is used to create -- pandoc metadata bibliographies. -readCSLString :: String -> [Inline]+readCSLString :: Text -> [Inline] readCSLString s = Walk.walk handleSmallCapsSpans $ case readHtml (adjustScTags s) of Pandoc _ [Plain ils] -> ils@@ -154,23 +155,23 @@ -- <sc> is not a real HTML tag, but a CSL convention. So we -- replace it with a real tag that the HTML reader will understand.-adjustScTags :: String -> String-adjustScTags zs =- case zs of- ('<':'s':'c':'>':xs) -> "<span style=\"font-variant:small-caps;\">" ++- adjustScTags xs- ('<':'/':'s':'c':'>':xs) -> "</span>" ++ adjustScTags xs- (x:xs) -> x : adjustScTags xs- [] -> []-+adjustScTags :: Text -> Text+adjustScTags zs+ | Just xs <- T.stripPrefix "<sc>" zs =+ "<span style=\"font-variant:small-caps;\">" <> adjustScTags xs+ | Just xs <- T.stripPrefix "</sc>" zs =+ "</span>" <> adjustScTags xs+ | Just (x, xs) <- T.uncons zs =+ T.cons x (adjustScTags xs)+ | otherwise = "" -writeYAMLString :: [Inline] -> String+writeYAMLString :: [Inline] -> Text writeYAMLString ils = trimr $ writeMarkdown $ Pandoc nullMeta [Plain $ Walk.walk (concatMap (adjustCSL False)) ils] -writeCSLString :: [Inline] -> String+writeCSLString :: [Inline] -> Text writeCSLString ils = trimr $ writeMarkdown $ Pandoc nullMeta@@ -215,7 +216,7 @@ toJSON = toJSON . writeCSLString . unFormatted instance ToYaml Formatted where- toYaml = Y.string . T.pack . writeYAMLString . unFormatted+ toYaml = Y.string . writeYAMLString . unFormatted instance IsString Formatted where fromString = Formatted . toStr@@ -246,8 +247,8 @@ toStr :: String -> [Inline] toStr = intercalate [Str "\n"] .- map (B.toList . B.text . T.pack . tweak . T.unpack . fromEntities . T.pack) .- splitWhen (=='\n')+ map (B.toList . B.text . T.pack . tweak . T.unpack . fromEntities) .+ splitWhen (=='\n') . T.pack where tweak ('«':' ':xs) = "«\8239" ++ tweak xs tweak (' ':'»':xs) = "\8239»" ++ tweak xs@@ -261,28 +262,28 @@ appendWithPunct :: Formatted -> Formatted -> Formatted appendWithPunct (Formatted left) (Formatted right) = Formatted $- case lastleft ++ firstright of- [' ',d] | d `elem` (",.:;" :: String) -> initInline left ++ right- [c,d] | c `elem` (" ,.:;" :: String), d == c -> left ++ tailInline right- [c,'.'] | c `elem` (",.!:;?" :: String) -> left ++ tailInline right- [c,':'] | c `elem` (",!:;?" :: String) -> left ++ tailInline right -- Mich.: 2005- [c,'!'] | c `elem` (",.!:;?" :: String) -> left ++ tailInline right- [c,'?'] | c `elem` (",.!:;?" :: String) -> left ++ tailInline right- [c,';'] | c `elem` (",:;" :: String) -> left ++ tailInline right -- et al.;- [':',c] | c `elem` (",.!:;?" :: String) -> left ++ tailInline right- [';',c] | c `elem` (",.!:;?" :: String) -> left ++ tailInline right- -- ".;" -> right -- e.g. et al.;- _ -> left ++ right+ case (,) <$> lastleft <*> firstright of+ Just (' ', d) | d `elem` (",.:;" :: String) -> initInline left ++ right+ Just (c,d) | c `elem` (" ,.:;" :: String), d == c -> left ++ tailInline right+ Just (c,'.') | c `elem` (",.!:;?" :: String) -> left ++ tailInline right+ Just (c,':') | c `elem` (",!:;?" :: String) -> left ++ tailInline right -- Mich.: 2005+ Just (c,'!') | c `elem` (",.!:;?" :: String) -> left ++ tailInline right+ Just (c,'?') | c `elem` (",.!:;?" :: String) -> left ++ tailInline right+ Just (c,';') | c `elem` (",:;" :: String) -> left ++ tailInline right -- et al.;+ Just (':',c) | c `elem` (",.!:;?" :: String) -> left ++ tailInline right+ Just (';',c) | c `elem` (",.!:;?" :: String) -> left ++ tailInline right+ -- ".;" -> right -- e.g. et al.;+ _ -> left ++ right where lastleft = lastInline left firstright = headInline right -- | The representation of a parsed CSL style. data Style = Style- { styleVersion :: String- , styleClass :: String+ { styleVersion :: Text+ , styleClass :: Text , styleInfo :: Maybe CSInfo- , styleDefaultLocale :: String+ , styleDefaultLocale :: Text , styleLocale :: [Locale] , styleAbbrevs :: Abbreviations , csOptions :: [Option]@@ -293,8 +294,8 @@ data Locale = Locale- { localeVersion :: String- , localeLang :: String+ { localeVersion :: Text+ , localeLang :: Text , localeOptions :: [Option] , localeTerms :: [CslTerm] , localeDate :: [Element]@@ -304,12 +305,12 @@ -- the parsed 'Style' cs:locale elements, produce the final 'Locale' -- as the only element of a list, taking into account CSL locale -- prioritization.-mergeLocales :: String -> Locale -> [Locale] -> [Locale]+mergeLocales :: Text -> Locale -> [Locale] -> [Locale] mergeLocales s l ls = doMerge list where list = filter ((==) s . localeLang) ls ++- filter ((\x -> x /= [] && x `isPrefixOf` s) . localeLang) ls ++- filter ((==) [] . localeLang) ls+ filter ((\x -> x /= "" && x `T.isPrefixOf` s) . localeLang) ls +++ filter ((==) "" . localeLang) ls doMerge x = return l { localeOptions = newOpt x , localeTerms = newTerms x , localeDate = newDate x@@ -323,25 +324,25 @@ data CslTerm = CT- { cslTerm :: String+ { cslTerm :: Text , termForm :: Form , termGender :: Gender , termGenderForm :: Gender- , termSingular :: String- , termPlural :: String- , termMatch :: String+ , termSingular :: Text+ , termPlural :: Text+ , termMatch :: Text } deriving ( Show, Read, Eq, Typeable, Data, Generic ) newTerm :: CslTerm-newTerm = CT [] Long Neuter Neuter [] [] []+newTerm = CT "" Long Neuter Neuter "" "" "" -findTerm :: String -> Form -> [CslTerm] -> Maybe CslTerm+findTerm :: Text -> Form -> [CslTerm] -> Maybe CslTerm findTerm s f = findTerm'' s f Nothing -findTerm' :: String -> Form -> Gender -> [CslTerm] -> Maybe CslTerm+findTerm' :: Text -> Form -> Gender -> [CslTerm] -> Maybe CslTerm findTerm' s f g = findTerm'' s f (Just g) -findTerm'' :: String -> Form -> Maybe Gender -> [CslTerm] -> Maybe CslTerm+findTerm'' :: Text -> Form -> Maybe Gender -> [CslTerm] -> Maybe CslTerm findTerm'' s f mbg ts = listToMaybe [ t | t <- ts, cslTerm t == s, termForm t == f, isNothing mbg || mbg == Just (termGenderForm t) ]@@ -359,18 +360,18 @@ where hasOrd o | CT {cslTerm = t} <- o- , "ordinal" `isInfixOf` t = True- | otherwise = False+ , "ordinal" `T.isInfixOf` t = True+ | otherwise = False rmOrdinals :: [CslTerm] -> [CslTerm] rmOrdinals [] = [] rmOrdinals (o:os) | CT {cslTerm = t} <- o- , "ordinal" `isInfixOf` t = rmOrdinals os- | otherwise = o:rmOrdinals os+ , "ordinal" `T.isInfixOf` t = rmOrdinals os+ | otherwise = o:rmOrdinals os newtype Abbreviations = Abbreviations {- unAbbreviations :: M.Map String (M.Map String (M.Map String String))+ unAbbreviations :: M.Map Text (M.Map Text (M.Map Text Text)) } deriving ( Show, Read, Typeable, Data, Generic ) instance FromJSON Abbreviations where@@ -379,7 +380,7 @@ parseJSON _ = fail "Could not read Abbreviations" type MacroMap- = (String,[Element])+ = (Text,[Element]) data Citation = Citation@@ -395,7 +396,7 @@ , bibLayout :: Layout } deriving ( Show, Read, Typeable, Data, Generic ) -type Option = (String,String)+type Option = (Text,Text) mergeOptions :: [Option] -> [Option] -> [Option] mergeOptions os = nubBy (\x y -> fst x == fst y) . (++) os@@ -409,16 +410,16 @@ data Element = Choose IfThen [IfThen] [Element]- | Macro String Formatting- | Const String Formatting- | Variable [String] Form Formatting Delimiter- | Term String Form Formatting Bool- | Label String Form Formatting Plural- | Number String NumericForm Formatting- | Names [String] [Name] Formatting Delimiter [Element]+ | Macro Text Formatting+ | Const Text Formatting+ | Variable [Text] Form Formatting Delimiter+ | Term Text Form Formatting Bool+ | Label Text Form Formatting Plural+ | Number Text NumericForm Formatting+ | Names [Text ] [Name] Formatting Delimiter [Element] | Substitute [Element] | Group Formatting Delimiter [Element]- | Date [String] DateForm Formatting Delimiter [DatePart] String+ | Date [Text ] DateForm Formatting Delimiter [DatePart] Text deriving ( Show, Read, Eq, Typeable, Data, Generic ) data IfThen@@ -427,16 +428,16 @@ data Condition = Condition- { isType :: [String]- , isSet :: [String]- , isNumeric :: [String]- , isUncertainDate :: [String]- , isPosition :: [String]- , disambiguation :: [String]- , isLocator :: [String]+ { isType :: [Text]+ , isSet :: [Text]+ , isNumeric :: [Text]+ , isUncertainDate :: [Text]+ , isPosition :: [Text]+ , disambiguation :: [Text]+ , isLocator :: [Text] } deriving ( Eq, Show, Read, Typeable, Data, Generic ) -type Delimiter = String+type Delimiter = Text data Match = Any@@ -451,9 +452,9 @@ data DatePart = DatePart- { dpName :: String- , dpForm :: String- , dpRangeDelim :: String+ { dpName :: Text+ , dpForm :: Text+ , dpRangeDelim :: Text , dpFormatting :: Formatting } deriving ( Show, Read, Eq, Typeable, Data, Generic ) @@ -464,34 +465,37 @@ , DatePart "day" "" "-" emptyFormatting] data Sort- = SortVariable String Sorting- | SortMacro String Sorting Int Int String+ = SortVariable Text Sorting+ | SortMacro Text Sorting Int Int Text deriving ( Eq, Show, Read, Typeable, Data, Generic ) data Sorting- = Ascending String- | Descending String+ = Ascending Text+ | Descending Text deriving ( Read, Show, Eq, Typeable, Data, Generic ) instance Ord Sorting where- compare (Ascending []) (Ascending []) = EQ- compare (Ascending []) (Ascending _) = GT- compare (Ascending _) (Ascending []) = LT+ compare (Ascending "") (Ascending "") = EQ+ compare (Ascending "") (Ascending _) = GT+ compare (Ascending _) (Ascending "") = LT compare (Ascending a) (Ascending b) = compare' a b- compare (Descending []) (Descending []) = EQ- compare (Descending []) (Descending _) = GT- compare (Descending _) (Descending []) = LT+ compare (Descending "") (Descending "") = EQ+ compare (Descending "") (Descending _) = GT+ compare (Descending _) (Descending "") = LT compare (Descending a) (Descending b) = compare' b a compare _ _ = EQ -compare' :: String -> String -> Ordering-compare' x y+compare' :: Text -> Text -> Ordering+compare' x' y' = case (x, y) of ('-':_,'-':_) -> comp (normalize y) (normalize x) ('-':_, _ ) -> LT (_ ,'-':_) -> GT _ -> comp (normalize x) (normalize y) where+ -- FIXME: to Text+ x = T.unpack x'+ y = T.unpack y' -- we zero pad numbers so they're sorted numerically, see #399 zeropad [] = [] zeropad xs = if all isDigit xs@@ -548,13 +552,13 @@ data Name = Name Form Formatting NameAttrs Delimiter [NamePart] | NameLabel Form Formatting Plural- | EtAl Formatting String+ | EtAl Formatting Text deriving ( Eq, Show, Read, Typeable, Data, Generic ) -type NameAttrs = [(String, String)]+type NameAttrs = [(Text, Text)] data NamePart- = NamePart String Formatting+ = NamePart Text Formatting deriving ( Show, Read, Eq, Typeable, Data, Generic ) isPlural :: Plural -> Int -> Bool@@ -577,21 +581,21 @@ data Formatting = Formatting- { prefix :: String- , suffix :: String- , fontFamily :: String- , fontStyle :: String- , fontVariant :: String- , fontWeight :: String- , textDecoration :: String- , verticalAlign :: String- , textCase :: String- , display :: String+ { prefix :: Text+ , suffix :: Text+ , fontFamily :: Text+ , fontStyle :: Text+ , fontVariant :: Text+ , fontWeight :: Text+ , textDecoration :: Text+ , verticalAlign :: Text+ , textCase :: Text+ , display :: Text , quotes :: Quote , stripPeriods :: Bool , noCase :: Bool , noDecor :: Bool- , hyperlink :: String -- null for no link+ , hyperlink :: Text -- null for no link } deriving ( Read, Eq, Ord, Typeable, Data, Generic ) -- custom instance to make debugging output less busy@@ -637,44 +641,47 @@ emptyFormatting :: Formatting emptyFormatting- = Formatting [] [] [] [] [] [] [] [] [] [] NoQuote False False False []+ = Formatting "" "" "" "" "" "" "" "" "" "" NoQuote False False False "" mergeFM :: Formatting -> Formatting -> Formatting mergeFM (Formatting aa ab ac ad ae af ag ah ai aj ak al am an ahl) (Formatting ba bb bc bd be bf bg bh bi bj bk bl bm bn bhl) =- Formatting (ba `orIfNull` aa)- (bb `orIfNull` ab)- (bc `orIfNull` ac)- (bd `orIfNull` ad)- (be `orIfNull` ae)- (bf `orIfNull` af)- (bg `orIfNull` ag)- (bh `orIfNull` ah)- (bi `orIfNull` ai)- (bj `orIfNull` aj)+ Formatting (ba `orIfEmpty` aa)+ (bb `orIfEmpty` ab)+ (bc `orIfEmpty` ac)+ (bd `orIfEmpty` ad)+ (be `orIfEmpty` ae)+ (bf `orIfEmpty` af)+ (bg `orIfEmpty` ag)+ (bh `orIfEmpty` ah)+ (bi `orIfEmpty` ai)+ (bj `orIfEmpty` aj) (if bk == NoQuote then ak else bk) (bl || al) (bm || am) (bn || an)- (bhl `mplus` ahl)+ (bhl <> ahl)+ where orIfEmpty :: Text -> Text -> Text+ orIfEmpty "" fallback = fallback+ orIfEmpty t _ = t data CSInfo = CSInfo- { csiTitle :: String+ { csiTitle :: Text , csiAuthor :: CSAuthor , csiCategories :: [CSCategory]- , csiId :: String- , csiUpdated :: String+ , csiId :: Text+ , csiUpdated :: Text } deriving ( Show, Read, Typeable, Data, Generic ) -data CSAuthor = CSAuthor String String String+data CSAuthor = CSAuthor Text Text Text deriving ( Show, Read, Eq, Typeable, Data, Generic )-data CSCategory = CSCategory String String String+data CSCategory = CSCategory Text Text Text deriving ( Show, Read, Eq, Typeable, Data, Generic ) data CiteprocError = NoOutput- | ReferenceNotFound String+ | ReferenceNotFound Text deriving ( Eq, Ord, Show, Typeable, Data, Generic ) -- | The 'Output' generated by the evaluation of a style. Must be@@ -684,34 +691,34 @@ | OSpace | OPan [Inline] | OStatus [Inline]- | ODel String -- ^ A delimiter string.- | OStr String Formatting -- ^ A simple 'String'+ | ODel Text -- ^ A delimiter string.+ | OStr Text Formatting -- ^ A simple 'String' | OErr CiteprocError -- ^ Warning message- | OLabel String Formatting -- ^ A label used for roles- | ONum Int Formatting -- ^ A number (used to count contributors)- | OCitNum Int Formatting -- ^ The citation number- | OCitLabel String Formatting -- ^ The citation label+ | OLabel Text Formatting -- ^ A label used for roles+ | ONum Int Formatting -- ^ A number (used to count contributors)+ | OCitNum Int Formatting -- ^ The citation number+ | OCitLabel Text Formatting -- ^ The citation label | ODate [Output] -- ^ A (possibly) ranged date- | OYear String String Formatting -- ^ The year and the citeId- | OYearSuf String String [Output] Formatting -- ^ The year suffix, the citeId and a holder for collision data+ | OYear Text Text Formatting -- ^ The year and the citeId+ | OYearSuf Text Text [Output] Formatting -- ^ The year suffix, the citeId and a holder for collision data | OName Agent [Output] [[Output]] Formatting -- ^ A (family) name with the list of given names.- | OContrib String String [Output] [Output] [[Output]] -- ^ The citation key, the role (author, editor, etc.), the contributor(s),+ | OContrib Text Text [Output] [Output] [[Output]] -- ^ The citation key, the role (author, editor, etc.), the contributor(s), -- the output needed for year suf. disambiguation, and everything used for -- name disambiguation.- | OLoc [Output] Formatting -- ^ The citation's locator- | Output [Output] Formatting -- ^ Some nested 'Output'+ | OLoc [Output] Formatting -- ^ The citation's locator+ | Output [Output] Formatting -- ^ Some nested 'Output' deriving ( Eq, Ord, Show, Typeable, Data, Generic ) type Citations = [[Cite]] data Cite = Cite- { citeId :: String+ { citeId :: Text , citePrefix :: Formatted , citeSuffix :: Formatted- , citeLabel :: String- , citeLocator :: String- , citeNoteNumber :: String- , citePosition :: String+ , citeLabel :: Text+ , citeLocator :: Text+ , citeNoteNumber :: Text+ , citePosition :: Text , nearNote :: Bool , authorInText :: Bool , suppressAuthor :: Bool@@ -739,7 +746,7 @@ parseJSON _ = return [] emptyCite :: Cite-emptyCite = Cite [] mempty mempty [] [] [] [] False False False 0+emptyCite = Cite "" mempty mempty "" "" "" "" False False False 0 -- | A citation group: the first list has a single member when the -- citation group starts with an "author-in-text" cite, the@@ -751,7 +758,7 @@ = BD { citations :: [Formatted] , bibliography :: [Formatted]- , citationIds :: [String]+ , citationIds :: [Text] } deriving ( Show, Typeable, Data, Generic ) -- | A record with all the data to produce the 'Formatted' of a@@ -763,13 +770,13 @@ -- year, initially empty. data CiteData = CD- { key :: String+ { key :: Text , collision :: [Output] , disambYS :: [Output] , disambData :: [[Output]] , disambed :: [Output]- , sameAs :: [String]- , citYear :: String+ , sameAs :: [Text]+ , citYear :: Text } deriving ( Show, Typeable, Data, Generic ) instance Eq CiteData where@@ -873,7 +880,7 @@ unFormatted $ familyName ag) of ([], _) -> ag (xs, ys)- | lastInline xs `elem` [" ", "-", "'", "’"] -> ag {+ | lastInline xs `elem` map Just (" -'’" :: String) -> ag { nonDroppingPart = Formatted $ trimSpace xs, familyName = Formatted ys } | otherwise -> ag@@ -906,7 +913,7 @@ startWithCapital (Formatted (x:_)) = startWithCapital' x startWithCapital _ = False -stripFinalComma :: Formatted -> (String, Formatted)+stripFinalComma :: Formatted -> (Text, Formatted) stripFinalComma (Formatted ils) = case reverse $ splitStrWhen isPunctuation ils of Str ",":xs -> (",", Formatted $ reverse xs)
src/Text/CSL/Util.hs view
@@ -32,6 +32,7 @@ , titlecase , unTitlecase , protectCase+ , splitWhen , splitStrWhen , proc , proc'@@ -90,32 +91,36 @@ tr' _ x = x #endif -readNum :: String -> Int-readNum s = case reads s of+readNum :: Text -> Int+readNum s = case reads (T.unpack s) of [(x,"")] -> x _ -> 0 -- | Conjoin strings, avoiding repeated punctuation.-(<^>) :: String -> String -> String-[] <^> sb = sb-sa <^> [] = sa-sa <^> (s:xs)- | s `elem` puncts && last sa `elem` puncts = sa ++ xs- where puncts = ";:,. " :: String-sa <^> sb = sa ++ sb+(<^>) :: Text -> Text -> Text+"" <^> sb = sb+sa <^> "" = sa+sa <^> sb = case (,) <$> T.unsnoc sa <*> T.uncons sb of+ Just ((_,la), (c,xs)) | isPunct' la && isPunct' c -> sa <> xs+ _ -> sa <> sb+ where isPunct' = (`elem` (";:,. " :: String)) -capitalize :: String -> String-capitalize [] = []-capitalize (c:cs) = toUpper c : cs+capitalize :: Text -> Text+capitalize t = case T.uncons t of+ Nothing -> ""+ Just (c, cs) -> T.cons (toUpper c) cs isPunct :: Char -> Bool isPunct c = c `elem` (".;?!" :: String) -camelize :: String -> String-camelize ('-':y:ys) = toUpper y : camelize ys-camelize ('_':y:ys) = toUpper y : camelize ys-camelize (y:ys) = y : camelize ys-camelize _ = []+camelize :: Text -> String+camelize =+ let camelize' t = case t of+ ('-':y:ys) -> toUpper y : camelize' ys+ ('_':y:ys) -> toUpper y : camelize' ys+ (y:ys) -> y : camelize' ys+ _ -> []+ in camelize' . T.unpack uncamelize :: String -> String uncamelize = foldr g [] . f@@ -136,15 +141,18 @@ words' = wordsBy (\c -> c == ' ' || c == '\t' || c == '\r' || c == '\n') -- | Remove leading and trailing space (including newlines) from string.-trim :: String -> String-trim = triml . trimr+trim :: Text -> Text+trim = T.dropAround isSpaceOrNewline -triml :: String -> String-triml = dropWhile (`elem` (" \r\n\t" :: String))+triml :: Text -> Text+triml = T.dropWhile isSpaceOrNewline -trimr :: String -> String-trimr = reverse . triml . reverse+trimr :: Text -> Text+trimr = T.dropWhileEnd isSpaceOrNewline +isSpaceOrNewline :: Char -> Bool+isSpaceOrNewline c = c `elem` (" \r\n\t" :: String)+ -- | Parse JSON Boolean or Number as Bool. parseBool :: Value -> Parser Bool parseBool (Bool b) = return b@@ -155,14 +163,14 @@ parseBool _ = Prelude.fail "Could not read boolean" -- | Parse JSON value as String.-parseString :: Value -> Parser String-parseString (String s) = return $ T.unpack s+parseString :: Value -> Parser Text+parseString (String s) = return s parseString (Number n) = case fromJSON (Number n) of- Success (x :: Int) -> return $ show x+ Success (x :: Int) -> return . T.pack $ show x Error _ -> case fromJSON (Number n) of- Success (x :: Double) -> return $ show x- Error e -> Prelude.fail $ "Could not read string: " ++ e-parseString (Bool b) = return $ map toLower $ show b+ Success (x :: Double) -> return . T.pack $ show x+ Error e -> Prelude.fail $ "Could not read string: " ++ e+parseString (Bool b) = return . T.toLower . T.pack $ show b parseString v@(Array _)= inlinesToString `fmap` parseJSON v parseString v = Prelude.fail $ "Could not read as string: " ++ show v @@ -172,7 +180,7 @@ Success (x :: Int) -> return x Error e -> Prelude.fail $ "Could not read Int: " ++ e parseInt x = parseString x >>= \s ->- case safeRead (T.pack s) of+ case safeRead s of Just n -> return n Nothing -> Prelude.fail "Could not read Int" @@ -184,9 +192,9 @@ Error e -> Prelude.fail $ "Could not read Int: " ++ e parseMaybeInt (Just x) = parseString x >>= \s ->- if null s+ if T.null s then return Nothing- else case safeRead (T.pack s) of+ else case safeRead s of Just n -> return (Just n) Nothing -> Prelude.fail $ "Could not read as Int: " ++ show s @@ -194,10 +202,10 @@ mb = Data.Traversable.mapM -- | Parse as a string (even if the value is a number).-(.#?) :: Object -> Text -> Parser (Maybe String)+(.#?) :: Object -> Text -> Parser (Maybe Text) x .#? y = (x .:? y) >>= mb parseString -(.#:) :: Object -> Text -> Parser String+(.#:) :: Object -> Text -> Parser Text x .#: y = (x .: y) >>= parseString onBlocks :: ([Inline] -> [Inline]) -> [Block] -> [Block]@@ -355,6 +363,9 @@ go acc (Span attr xs) = (:acc) <$> (Span attr <$> caseTransform xform xs) go acc x = return $ x : acc +splitWhen :: (Char -> Bool) -> Text -> [Text]+splitWhen f = filter (not . T.null) . T.split f+ splitStrWhen :: (Char -> Bool) -> [Inline] -> [Inline] splitStrWhen _ [] = [] splitStrWhen p (Str xs : ys) = go (T.unpack xs) ++ splitStrWhen p ys@@ -362,8 +373,8 @@ go s = case break p s of ([],[]) -> [] (zs,[]) -> [Str $ T.pack zs]- ([],(w:ws)) -> Str (T.singleton w) : go ws- (zs,(w:ws)) -> Str (T.pack zs) : Str (T.singleton w) : go ws+ ([],w:ws) -> Str (T.singleton w) : go ws+ (zs,w:ws) -> Str (T.pack zs) : Str (T.singleton w) : go ws splitStrWhen p (x : ys) = x : splitStrWhen p ys -- | A generic processing function.@@ -387,9 +398,10 @@ orIfNull [] b = b orIfNull a _ = a -toRead :: String -> String-toRead [] = []-toRead (s:ss) = toUpper s : camel ss+toRead :: Text -> Text+toRead t = case T.uncons t of+ Nothing -> ""+ Just (s,ss) -> T.cons (toUpper s) . T.pack . camel . T.unpack $ ss where camel x | '-':y:ys <- x = toUpper y : camel ys@@ -397,16 +409,14 @@ | y:ys <- x = y : camel ys | otherwise = [] -inlinesToString :: [Inline] -> String-inlinesToString = T.unpack . stringify+inlinesToString :: [Inline] -> Text+inlinesToString = stringify -headInline :: [Inline] -> String-headInline = take 1 . T.unpack . stringify+headInline :: [Inline] -> Maybe Char+headInline = fmap fst . T.uncons . stringify -lastInline :: [Inline] -> String-lastInline xs = case T.unpack $ stringify xs of- [] -> []- ys -> [last ys]+lastInline :: [Inline] -> Maybe Char+lastInline = fmap snd . T.unsnoc . stringify initInline :: [Inline] -> [Inline] initInline [] = []@@ -431,19 +441,19 @@ tailInline xs = tailFirstInlineStr xs tailFirstInlineStr :: [Inline] -> [Inline]-tailFirstInlineStr = mapHeadInline (drop 1)+tailFirstInlineStr = mapHeadInline (T.drop 1) toCapital :: [Inline] -> [Inline] toCapital ils@(Span (_,["nocase"],_) _:_) = ils toCapital ils = mapHeadInline capitalize ils -mapHeadInline :: (String -> String) -> [Inline] -> [Inline]+mapHeadInline :: (Text -> Text) -> [Inline] -> [Inline] mapHeadInline _ [] = [] mapHeadInline f (i:xs) | Str "" <- i = mapHeadInline f xs- | Str s <- i = case f (T.unpack s) of+ | Str s <- i = case f s of "" -> xs- _ -> Str (T.pack $ f $ T.unpack s) : xs+ t -> Str t : xs | Emph is <- i = Emph (mapHeadInline f is) : xs | Strong is <- i = Strong (mapHeadInline f is) : xs | Superscript is <- i = Superscript (mapHeadInline f is) : xs@@ -534,8 +544,8 @@ then Prelude.fail "not a roman numeral" else return total -isRange :: String -> Bool-isRange s = ',' `elem` s || '-' `elem` s || '\x2013' `elem` s+isRange :: Text -> Bool+isRange = T.any (`elem` [',', '-', '\x2013']) -- see issue 392 for motivation. We want to treat -- "J.G. Smith" and "J. G. Smith" the same.
stack.yaml view
@@ -12,16 +12,17 @@ - HsYAML-0.2.0.0 - HsYAML-aeson-0.2.0.0 - haddock-library-1.8.0-- skylighting-0.8.3-- skylighting-core-0.8.3+- skylighting-0.8.3.2+- skylighting-core-0.8.3.2 - regex-pcre-builtin-0.95.0.8.8.35-- doctemplates-0.8-- doclayout-0.2.0.1+- doctemplates-0.8.1+- doclayout-0.3 - emojis-0.1 - texmath-0.12 - pandoc-types-1.20+- jira-wiki-markup-1.0.0 - git: 'https://github.com/jgm/pandoc'- commit: d4c2923025591f7645ca6a3c96570edbf8331e61+ commit: 05a217091f47b11d31eac687c6f62caeada4fb14 ghc-options: "$locals": -fhide-source-paths
+ tests/issue437.csl view
@@ -0,0 +1,26 @@+<?xml version="1.0" encoding="utf-8"?>+<style xmlns="http://purl.org/net/xbiblio/csl" class="note" default-locale="en-US" version="1.0">+ <info>+ <title>Minimal style to reproduce bug</title>+ <id>http://www.example.org/styles/minimal-test-style</id>+ <author>+ <name>Nicolas Chachereau</name>+ <email>nicolas@nchachereau.ch</email>+ </author>+ <updated>2020-01-27T14:27:45+01:00</updated>+ </info>+ <citation>+ <layout>+ <group delimiter=", ">+ <names variable="author"/>+ <text variable="title"/>+ <text variable="publisher-place"/>+ <date variable="issued" form="numeric" date-parts="year"/>+ <group delimiter=" ">+ <number variable="number-of-pages"/>+ <label variable="number-of-pages"/>+ </group>+ </group>+ </layout>+ </citation>+</style>
+ tests/issue437.expected.native view
@@ -0,0 +1,3 @@+Pandoc (Meta {unMeta = fromList [("csl",MetaInlines [Str "tests/issue437.csl"]),("references",MetaList [MetaMap (fromList [("author",MetaList [MetaMap (fromList [("family",MetaInlines [Str "Smith"]),("given",MetaInlines [Str "John"])])]),("id",MetaInlines [Str "hirt2009"]),("issued",MetaList [MetaMap (fromList [("year",MetaInlines [Str "2009"])])]),("publisher",MetaInlines [Str "Publishing",Space,Str "House"]),("publisher-place",MetaInlines [Str "Lausanne"]),("title",MetaInlines [Str "Some",Space,Str "Book"]),("type",MetaInlines [Str "book"])])])]})+[BlockQuote+ [Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "quote.",Cite [Citation {citationId = "hirt2009", citationPrefix = [], citationSuffix = [], citationMode = NormalCitation, citationNoteNum = 0, citationHash = 1}] [Note [Para [Str "John",Space,Str "Smith,",Space,Str "Some",Space,Str "Book,",Space,Str "Lausanne,",Space,Str "2009"]]]]]]
+ tests/issue437.in.native view
@@ -0,0 +1,3 @@+Pandoc (Meta {unMeta = fromList [("csl",MetaInlines [Str "tests/issue437.csl"]),("references",MetaList [MetaMap (fromList [("author",MetaList [MetaMap (fromList [("family",MetaInlines [Str "Smith"]),("given",MetaInlines [Str "John"])])]),("id",MetaInlines [Str "hirt2009"]),("issued",MetaList [MetaMap (fromList [("year",MetaInlines [Str "2009"])])]),("publisher",MetaInlines [Str "Publishing",Space,Str "House"]),("publisher-place",MetaInlines [Str "Lausanne"]),("title",MetaInlines [Str "Some",Space,Str "Book"]),("type",MetaInlines [Str "book"])])])]})+[BlockQuote+ [Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "quote.",Space,Cite [Citation {citationId = "hirt2009", citationPrefix = [], citationSuffix = [], citationMode = NormalCitation, citationNoteNum = 0, citationHash = 0}] [Str "[@hirt2009]"]]]]
tests/test-citeproc.hs view
@@ -28,6 +28,8 @@ Pandoc (..), bottomUp, nullMeta) import qualified Text.Pandoc.UTF8 as UTF8 import Text.Printf+import qualified Data.Text as T+import Data.Text (Text) data TestCase = TestCase{ testMode :: Mode -- mode@@ -37,7 +39,7 @@ , testCsl :: Style -- csl , testAbbreviations :: Abbreviations -- abbreviations , testReferences :: [Reference] -- input- , testResult :: String -- result+ , testResult :: Text -- result } deriving (Show) data Mode = CitationMode@@ -119,10 +121,10 @@ let expected = adjustEntities $ fixBegins $ trimEnd $ testResult testCase let mode = testMode testCase let assemble BibliographyMode xs =- "<div class=\"csl-bib-body\">\n" ++- unlines (map (\x -> " <div class=\"csl-entry\">" ++ x ++- "</div>") xs) ++ "</div>\n"- assemble _ xs = unlines xs+ "<div class=\"csl-bib-body\">\n" <>+ T.unlines (map (\x -> " <div class=\"csl-entry\">" <> x <>+ "</div>") xs) <> "</div>\n"+ assemble _ xs = T.unlines xs case mode of BibliographyHeaderMode -> do putStrLn $ "[SKIPPED] " ++ path ++ "\n"@@ -141,35 +143,35 @@ return Passed else do putStrLn $ "[FAILED] " ++ path- showDiff expected result+ showDiff (T.unpack expected) (T.unpack result) putStrLn "" return Failed -trimEnd :: String -> String-trimEnd = reverse . ('\n':) . dropWhile isSpace . reverse+trimEnd :: Text -> Text+trimEnd t = T.stripEnd t <> "\n" -- this is designed to mimic the test suite's output:-inlinesToString :: [Inline] -> String+inlinesToString :: [Inline] -> Text inlinesToString ils = writeHtmlString $ bottomUp (concatMap adjustSpans) $ Pandoc nullMeta [Plain ils] -- We want & instead of & etc.-adjustEntities :: String -> String-adjustEntities ('&':'#':'3':'8':';':xs) = "&" ++ adjustEntities xs-adjustEntities (x:xs) = x : adjustEntities xs-adjustEntities [] = []+adjustEntities :: Text -> Text+adjustEntities = T.replace "&" "&" -- citeproc-js test suite expects "citations" to be formatted like -- .. [0] Smith (2007) -- >> [1] Jones (2008) -- To get a meaningful comparison, we remove this.-fixBegins :: String -> String-fixBegins = unlines . map fixLine . lines- where fixLine ('.':'.':'[':xs) = dropWhile isSpace $ dropWhile (not . isSpace) xs- fixLine ('>':'>':'[':xs) = dropWhile isSpace $ dropWhile (not . isSpace) xs- fixLine xs = xs+fixBegins :: Text -> Text+fixBegins = T.unlines . map fixLine . T.lines+ where fixLine t =+ case T.stripPrefix "..[" t `mplus` T.stripPrefix ">>[" t of+ Just rest ->+ T.dropWhile isSpace . T.dropWhile (not . isSpace) $ rest+ Nothing -> t -- adjust the spans so we fit what the test suite expects. adjustSpans :: Inline -> [Inline]
tests/test-pandoc-citeproc.hs view
@@ -4,7 +4,11 @@ module Main where import Prelude import qualified Data.Aeson as Aeson+import qualified Data.ByteString as B import Data.List (isSuffixOf)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import qualified Data.Text as T import Data.Maybe (fromMaybe) import System.Directory import System.Environment@@ -75,12 +79,8 @@ else if regenerate then do- UTF8.writeFile ("tests/" ++ csl ++ ".expected.native") $-#if MIN_VERSION_pandoc(1,19,0)- writeNative outDoc-#else- writeNative outDoc-#endif+ B.writeFile ("tests/" ++ csl ++ ".expected.native") $+ encodeUtf8 (writeNative outDoc) err "PASSED (accepted)" return Passed else do@@ -92,13 +92,13 @@ err $ "Error status " ++ show ec return Errored -showDiff :: String -> String -> IO ()+showDiff :: Text -> Text -> IO () showDiff expected result = withSystemTempDirectory "test-pandoc-citeproc-XXX" $ \fp -> do let expectedf = fp </> "expected" let actualf = fp </> "actual"- UTF8.writeFile expectedf expected- UTF8.writeFile actualf result+ UTF8.writeFile expectedf $ T.unpack expected+ UTF8.writeFile actualf $ T.unpack result oldDir <- getCurrentDirectory setCurrentDirectory fp _ <- rawSystem "diff" ["-U1","expected","actual"]@@ -150,8 +150,8 @@ err "PASSED (accepted)" return Passed else do- err $ "FAILED"- showDiff expected result+ err "FAILED"+ showDiff (T.pack expected) (T.pack result) return Failed else do err "ERROR"