summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohnMacFarlane <>2020-02-16 05:50:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-02-16 05:50:00 (GMT)
commit01a6795ab8a9ba7ec231c649387bd9da77d18e3d (patch)
treef863336371a527c96e133730313d56ff5436ba72
parentfcdecd7ed069d7c19d8dcedd71d386f9b976891c (diff)
version 0.170.17
-rw-r--r--changelog9
-rw-r--r--compat/Text/CSL/Compat/Pandoc.hs34
-rw-r--r--pandoc-citeproc.cabal2
-rw-r--r--pandoc-citeproc.hs11
-rw-r--r--src/Text/CSL/Data.hs47
-rw-r--r--src/Text/CSL/Eval.hs212
-rw-r--r--src/Text/CSL/Eval/Common.hs71
-rw-r--r--src/Text/CSL/Eval/Date.hs90
-rw-r--r--src/Text/CSL/Eval/Names.hs98
-rw-r--r--src/Text/CSL/Eval/Output.hs64
-rw-r--r--src/Text/CSL/Input/Bibtex.hs297
-rw-r--r--src/Text/CSL/Input/Bibutils.hs34
-rw-r--r--src/Text/CSL/Output/Pandoc.hs31
-rw-r--r--src/Text/CSL/Output/Plain.hs3
-rwxr-xr-xsrc/Text/CSL/Pandoc.hs174
-rw-r--r--src/Text/CSL/Parser.hs88
-rw-r--r--src/Text/CSL/Proc.hs65
-rw-r--r--src/Text/CSL/Proc/Collapse.hs37
-rw-r--r--src/Text/CSL/Proc/Disamb.hs43
-rw-r--r--src/Text/CSL/Reference.hs77
-rw-r--r--src/Text/CSL/Style.hs293
-rw-r--r--src/Text/CSL/Util.hs118
-rw-r--r--stack.yaml11
-rw-r--r--tests/issue437.csl26
-rw-r--r--tests/issue437.expected.native3
-rw-r--r--tests/issue437.in.native3
-rw-r--r--tests/test-citeproc.hs38
-rw-r--r--tests/test-pandoc-citeproc.hs22
28 files changed, 1063 insertions, 938 deletions
diff --git a/changelog b/changelog
index de80c29..33f4907 100644
--- a/changelog
+++ b/changelog
@@ -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.
diff --git a/compat/Text/CSL/Compat/Pandoc.hs b/compat/Text/CSL/Compat/Pandoc.hs
index 8445792..81f3228 100644
--- a/compat/Text/CSL/Compat/Pandoc.hs
+++ b/compat/Text/CSL/Compat/Pandoc.hs
@@ -18,9 +18,9 @@ import qualified Control.Exception as E
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 qualified Text.Pandoc.Class (fetchItem)
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 :: Text -> Pandoc
+readNative = either mempty id . runPure . Pandoc.readNative def
-readNative = either mempty id . runPure . Pandoc.readNative def . T.pack
+writeMarkdown, writePlain, writeNative, writeHtmlString :: Pandoc -> Text
-writeMarkdown = either mempty T.unpack . runPure . Pandoc.writeMarkdown
+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 }
diff --git a/pandoc-citeproc.cabal b/pandoc-citeproc.cabal
index efc7639..f0293ee 100644
--- a/pandoc-citeproc.cabal
+++ b/pandoc-citeproc.cabal
@@ -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
diff --git a/pandoc-citeproc.hs b/pandoc-citeproc.hs
index aa69c16..d9d74a2 100644
--- a/pandoc-citeproc.hs
+++ b/pandoc-citeproc.hs
@@ -17,7 +17,7 @@ import qualified Data.ByteString.Lazy as BL
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 @@ main = do
("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 @@ options =
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)]
diff --git a/src/Text/CSL/Data.hs b/src/Text/CSL/Data.hs
index 79c933a..e9c3365 100644
--- a/src/Text/CSL/Data.hs
+++ b/src/Text/CSL/Data.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module : Text.CSL.Data
@@ -25,6 +26,8 @@ module Text.CSL.Data
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 @@ import System.Directory (doesFileExist)
#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 @@ getLicense =
getDataFileName "LICENSE" >>= L.readFile
#endif
-langBase :: [(String, String)]
+langBase :: [(Text, Text)]
langBase
= [("af", "af-ZA")
,("bg", "bg-BG")
diff --git a/src/Text/CSL/Eval.hs b/src/Text/CSL/Eval.hs
index 7ad9d38..51b4754 100644
--- a/src/Text/CSL/Eval.hs
+++ b/src/Text/CSL/Eval.hs
@@ -29,10 +29,11 @@ import Prelude
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.Exception
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 @@ evalLayout (Layout _ _ es) em b l m o a mbr
| 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 @@ evalLayout (Layout _ _ es) em b l m o a mbr
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 @@ evalSorting m l ms opts ss as mbr
-- 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 @@ evalElement el
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 @@ evalElement el
| 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 @@ evalElement el
"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 @@ evalIfThen (IfThen c' m' el') ei e = whenElse (evalCond m' c') (return el') rest
_ -> 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 @@ evalIfThen (IfThen c' m' el') ei e = whenElse (evalCond m' c') (return el') rest
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 @@ evalIfThen (IfThen c' m' el') ei e = whenElse (evalCond m' c') (return el') rest
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 @@ getFormattedValue o as f fm s val
, 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 @@ formatTitle s f fm
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 @@ formatNumber f fm v n
]
-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 @@ formatRange fm p = do
-- 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 @@ expandedRange (sa, sb)
-- 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 @@ minimalRange _ (as, bs) = (as, bs)
-- 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
diff --git a/src/Text/CSL/Eval/Common.hs b/src/Text/CSL/Eval/Common.hs
index 2711302..ed9623d 100644
--- a/src/Text/CSL/Eval/Common.hs
+++ b/src/Text/CSL/Eval/Common.hs
@@ -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.Char (toLower)
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 @@ data EvalState
= 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 @@ isSorting m = case m of EvalSorting _ -> True; _ -> False
-- | 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 @@ getAgents s
_ -> return []
_ -> return []
-getAgents' :: String -> State EvalState [Agent]
+getAgents' :: Text -> State EvalState [Agent]
getAgents' s
= do
mv <- withRefMap (lookup s)
@@ -120,42 +122,43 @@ getAgents' s
_ -> 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 :: (ReferenceMap -> a) -> State EvalState a
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 }
diff --git a/src/Text/CSL/Eval/Date.hs b/src/Text/CSL/Eval/Date.hs
index 8be260c..68d7f7e 100644
--- a/src/Text/CSL/Eval/Date.hs
+++ b/src/Text/CSL/Eval/Date.hs
@@ -21,9 +21,9 @@ import Prelude
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 @@ evalDate (Date s f fm dl dp dp') = do
(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 @@ getDate f = do
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 @@ formatDate em k tm dp date
| 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 @@ formatDate em k tm dp date
| "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 @@ formatDate em k tm dp date
| 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 @@ longOrdinal ts v s
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
-
diff --git a/src/Text/CSL/Eval/Names.hs b/src/Text/CSL/Eval/Names.hs
index dff6aca..27b9452 100644
--- a/src/Text/CSL/Eval/Names.hs
+++ b/src/Text/CSL/Eval/Names.hs
@@ -25,6 +25,7 @@ import Data.Char (isLower, isUpper)
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 qualified Text.Pandoc.Builder as B
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 @@ evalNames skipEdTrans ns nl d
| 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 @@ evalNames skipEdTrans ns nl d
| 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 @@ formatNames ea del p s as n
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 @@ formatNames ea del p s as n
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 @@ formatNames ea del p s as n
| 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 @@ formatNames ea del p s as n
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 @@ isEtAl b os p as
, 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 @@ formatName m b f fm ops np n
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 @@ formatName m b f fm ops np n
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 @@ formatName m b f fm ops np n
| 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 @@ formatTerm f fm p refid s = do
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 @@ formatLabel f fm p s
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
diff --git a/src/Text/CSL/Eval/Output.hs b/src/Text/CSL/Eval/Output.hs
index 3cafd01..239ca46 100644
--- a/src/Text/CSL/Eval/Output.hs
+++ b/src/Text/CSL/Eval/Output.hs
@@ -20,6 +20,7 @@ module Text.CSL.Eval.Output where
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.CSL.Util (capitalize, isPunct, titlecase,
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 @@ pRaw = try $ do
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 @@ cleanOutput = flatten
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 @@ noOutputError = OErr NoOutput
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 @@ formatOutput o =
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 @@ addFormatting f =
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 @@ addFormatting f =
"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 @@ addFormatting f =
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 [] = []
diff --git a/src/Text/CSL/Input/Bibtex.hs b/src/Text/CSL/Input/Bibtex.hs
index c1d446d..cd9dd2e 100644
--- a/src/Text/CSL/Input/Bibtex.hs
+++ b/src/Text/CSL/Input/Bibtex.hs
@@ -29,13 +29,16 @@ import Control.Applicative
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.Reference
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 _ (Span ("",[],[]) xs) = xs
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 @@ parseRawLaTeX lang ('\\':xs) =
-- ... 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 @@ inlinesToFormatted ils = do
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 :: IO Lang
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 @@ readBibtexString idpred isBibtex caseTransform contents = do
(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 @@ bibString = do
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 @@ bibItem = do
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 @@ entField = do
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 @@ expandString = do
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 @@ resolveCrossRef isBibtex entries entry =
-- 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 @@ transformKey "periodical" y z
_ -> [z]
transformKey _ _ x = [x]
-standardTrans :: String -> [String]
+standardTrans :: Text -> [Text]
standardTrans z =
case z of
"title" -> ["maintitle"]
@@ -355,7 +358,7 @@ standardTrans z =
"indexsorttitle" -> []
_ -> [z]
-bookTrans :: String -> [String]
+bookTrans :: Text -> [Text]
bookTrans z =
case z of
"title" -> ["booktitle"]
@@ -368,11 +371,11 @@ bookTrans z =
_ -> [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 @@ langToLocale (Lang x y) = x ++ (if null y then [] else '-':y)
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 @@ resolveKey' (Lang "ca" "AD") k =
"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 @@ resolveKey' (Lang "da" "DK") k =
"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 @@ resolveKey' (Lang "de" "DE") k =
"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 @@ resolveKey' (Lang "en" "US") k =
"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 @@ resolveKey' (Lang "es" "ES") k =
"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 @@ resolveKey' (Lang "fi" "FI") k =
_ -> 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 @@ resolveKey' (Lang "fr" "FR") k =
"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 @@ resolveKey' (Lang "it" "IT") k =
"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 @@ resolveKey' (Lang "nl" "NL") k =
"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 @@ resolveKey' (Lang "pl" "PL") k =
"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 @@ resolveKey' (Lang "pt" "PT") k =
"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 @@ resolveKey' (Lang "pt" "BR") k =
"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 @@ resolveKey' (Lang "sv" "SE") k =
_ -> 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 @@ parseMonth s =
"oct" -> Just 10
"nov" -> Just 11
"dec" -> Just 12
- _ -> safeRead $ T.pack s
+ _ -> safeRead s
data BibState = BibState{
untitlecase :: Bool
@@ -889,31 +892,31 @@ data BibState = BibState{
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 [Para xs] = [Para $ takeWhile (/= Str ":") xs]
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 @@ getOldDates prefix = do
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 @@ getLiteralList f = do
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 @@ toAuthor _ [Span ("",[],[]) ils] =
}
-- 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 @@ toAuthor opts ils = do
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 (Str (T.uncons -> Just (c,cs)) : rest)
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 :: Inline -> Inline
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 @@ concatWith sep = Formatted . foldl' go mempty . map unFormatted
-> 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 @@ itemToReference lang locale bibtex caseTransform = bib $ do
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 @@ itemToReference lang locale bibtex caseTransform = bib $ do
"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 @@ itemToReference lang locale bibtex caseTransform = bib $ do
| 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 @@ itemToReference lang locale bibtex caseTransform = bib $ do
-- 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 @@ itemToReference lang locale bibtex caseTransform = bib $ do
("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 @@ itemToReference lang locale bibtex caseTransform = bib $ do
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 @@ itemToReference lang locale bibtex caseTransform = bib $ do
<|> 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 @@ itemToReference lang locale bibtex caseTransform = bib $ do
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 @@ itemToReference lang locale bibtex caseTransform = bib $ do
<|> (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
diff --git a/src/Text/CSL/Input/Bibutils.hs b/src/Text/CSL/Input/Bibutils.hs
index 0d5ed6d..903ca47 100644
--- a/src/Text/CSL/Input/Bibutils.hs
+++ b/src/Text/CSL/Input/Bibutils.hs
@@ -29,7 +29,9 @@ import Data.Aeson.Types (parseMaybe)
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 @@ import Text.Bibutils
--
-- 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 @@ readBiblioFile idpred f
(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 @@ data BibFormat
#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 @@ readBiblioString idpred b s
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 @@ createTempDir num baseName = do
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 @@ selectEntries idpred bs =
_ -> 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]
diff --git a/src/Text/CSL/Output/Pandoc.hs b/src/Text/CSL/Output/Pandoc.hs
index c361f9c..b673ae3 100644
--- a/src/Text/CSL/Output/Pandoc.hs
+++ b/src/Text/CSL/Output/Pandoc.hs
@@ -29,7 +29,9 @@ module Text.CSL.Output.Pandoc
) 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 @@ renderPandoc sty
-- 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 @@ clean' sty (i:is) =
(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 ++
+ 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 ++ [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 @@ clean' sty (i:is) =
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 @@ clean' sty (i:is) =
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"
diff --git a/src/Text/CSL/Output/Plain.hs b/src/Text/CSL/Output/Plain.hs
index 3fb3bd8..8944b09 100644
--- a/src/Text/CSL/Output/Plain.hs
+++ b/src/Text/CSL/Output/Plain.hs
@@ -19,11 +19,12 @@ module Text.CSL.Output.Plain
) 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]
diff --git a/src/Text/CSL/Pandoc.hs b/src/Text/CSL/Pandoc.hs
index 2591dd9..343e270 100755
--- a/src/Text/CSL/Pandoc.hs
+++ b/src/Text/CSL/Pandoc.hs
@@ -19,6 +19,7 @@ import qualified Data.ByteString.Lazy as L
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 @@ processCites style refs (Pandoc m1 b1) =
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 @@ addFirstNoteNumber _ -- see below, these spans added by deNote
= 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 @@ insertRefs hanging meta refs bs =
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 @@ insertRefs hanging meta refs bs =
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 @@ isLinkCitations meta =
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 @@ mkNociteWildcards refs = map expandStar
[] -> cs
_ -> allcites
allcites = map (\ref -> Citation{
- citationId = T.pack $ unLiteral (refId ref),
+ citationId = unLiteral (refId ref),
citationPrefix = [],
citationSuffix = [],
citationMode = NormalCitation,
@@ -202,7 +204,7 @@ processCites' (Pandoc meta blocks) = do
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 @@ processCites' (Pandoc meta blocks) = do
-- 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 @@ processCites' (Pandoc meta blocks) = do
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 (MetaList xs) = case reverse xs of
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 @@ getBibRefs _ _ = return []
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 @@ processCite s cs (Cite t _) =
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 @@ mvPunct moveNotes sty (q : s : x : ys)
= 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 @@ mvPunct moveNotes sty (Cite cs ils : ys)
= 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 : ys) | isSpacy s, isNote x =
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 :: Inline -> [[Citation]]
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 @@ toCslCite locMap c
_ -> 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 @@ splitInp = splitStrWhen (\c -> splitOn c || isSpace c)
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 @@ locatorWords locMap inp =
-- (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 @@ pLocatorWords locMap = do
-- 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 @@ pLocatorIntegrated locMap = try $ do
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 @@ pLocatorLabel' locMap lim = go ""
-- 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 @@ requireDigits (_, s) = if not (any isDigit s)
-- (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 @@ pBalancedBraces braces p = try $ do
-- 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 @@ pPageSeq = oneDotTwo <|> withPeriod
-- .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 @@ pPageUnit = roman <|> plainUnit
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 @@ pMatch msg condition = try $ do
then Prelude.fail msg
else return t
-type LocatorMap = M.Map String String
+type LocatorMap = M.Map Text Text
locatorMap :: Style -> LocatorMap
locatorMap sty =
diff --git a/src/Text/CSL/Parser.hs b/src/Text/CSL/Parser.hs
index cba230f..346c6f0 100644
--- a/src/Text/CSL/Parser.hs
+++ b/src/Text/CSL/Parser.hs
@@ -26,35 +26,36 @@ import qualified Data.Map as M
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 @@ readCSLFile mbLocale src = do
-- 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 @@ readCSLFile mbLocale src = do
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 @@ parseCSLCursor cur =
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 :: Text -> Axis
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 @@ getFormatting cur =
}
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 @@ parseDatePart defaultForm cur =
}
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 @@ parseName cur =
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 @@ parseText cur =
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 @@ parseIf cur = IfThen cond mat elts
}
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 :: Cursor -> [Option]
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)]
_ -> []
diff --git a/src/Text/CSL/Proc.hs b/src/Text/CSL/Proc.hs
index d9ce819..68a3ac7 100644
--- a/src/Text/CSL/Proc.hs
+++ b/src/Text/CSL/Proc.hs
@@ -25,10 +25,11 @@ import Control.Applicative ((<|>))
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 @@ data ProcOpts
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 @@ citeproc ops s rs cs
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 @@ procBiblio bos Style {biblio = mb, csMacros = ms , styleLocale = l,
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 @@ filterRefs bos refs
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 @@ filterRefs bos refs
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 @@ formatCitLayout s (CG co f d cs)
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 @@ addAffixes f os
| [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 @@ localModifiers s b c
| 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 @@ localModifiers s b c
| 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 @@ localModifiers s b c
| 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 @@ contribOnly s o
prefix = "",
suffix = "" }
| OStr x _ <- o
- , "ibid" <- filter (/= '.')
- (map toLower x) = o
+ , "ibid" <- T.filter (/= '.') (T.toLower x) = o
| otherwise = ONull
diff --git a/src/Text/CSL/Proc/Collapse.hs b/src/Text/CSL/Proc/Collapse.hs
index 82577e2..e92dc57 100644
--- a/src/Text/CSL/Proc/Collapse.hs
+++ b/src/Text/CSL/Proc/Collapse.hs
@@ -25,11 +25,12 @@ import Data.Char
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 @@ collapseCitGroups s
= 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 @@ getYearAndSuf x
| 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 @@ collapseYear s ranged (CG cs f d os) = CG cs f [] (process os)
"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 @@ collapseYear s ranged (CG cs f d os) = CG cs f [] (process os)
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 @@ collapseYearSuf ranged ysd = process
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 :: [Output] -> [Output]
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 =
diff --git a/src/Text/CSL/Proc/Disamb.hs b/src/Text/CSL/Proc/Disamb.hs
index de8f17c..6fa5cb7 100644
--- a/src/Text/CSL/Proc/Disamb.hs
+++ b/src/Text/CSL/Proc/Disamb.hs
@@ -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 @@ module Text.CSL.Proc.Disamb where
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 @@ import Text.Pandoc.Shared (ordNub)
-- | 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 @@ disambCitations s bibs cs groups
-- 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 @@ hasIfDis _ = [False]
-- | 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 @@ rmExtras g os
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 @@ getCiteData out
= (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 @@ getName = query getName'
| 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 @@ generateYearSuffix refs
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 @@ setYearSuffCollision b cs = proc (setYS cs) .
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 @@ allTheSame (x:xs) = all (== x) xs
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 @@ hasYear = not . null . query getYear
hasYearSuf :: Output -> Bool
hasYearSuf = not . null . query getYearSuf
- where getYearSuf :: Output -> [String]
+ where getYearSuf :: Output -> [Text]
getYearSuf o
| OYearSuf{} <- o = ["a"]
| otherwise = []
diff --git a/src/Text/CSL/Reference.hs b/src/Text/CSL/Reference.hs
index 3bd72de..82e2c4c 100644
--- a/src/Text/CSL/Reference.hs
+++ b/src/Text/CSL/Reference.hs
@@ -67,7 +67,6 @@ import Data.Either (lefts, rights)
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 @@ import Text.CSL.Util (camelize, capitalize, inlinesToString,
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 @@ instance ToJSON Literal where
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 @@ data Value = forall a . Data a => Value a
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 @@ isValueSet val
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 @@ instance ToYaml Season where
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 @@ parseMaybeSeason (Just x) = do
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 @@ toJSONDate ds = object' $
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 @@ toDatePart refdate =
-- 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 @@ instance FromJSON RefType where
-- 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 ToJSON CNum where
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 @@ instance ToJSON CLabel where
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 @@ emptyReference =
, 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 @@ getReference rs c
= 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 :: Style -> [[Cite]] -> [[Cite]]
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 @@ setNearNote s cs
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 @@ parseRawDate o =
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]
diff --git a/src/Text/CSL/Style.hs b/src/Text/CSL/Style.hs
index bbde624..9c52d35 100644
--- a/src/Text/CSL/Style.hs
+++ b/src/Text/CSL/Style.hs
@@ -104,21 +104,22 @@ import Data.Aeson.Types (Pair)
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 @@ import qualified Data.Vector as V
-- 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 @@ readCSLString s = Walk.walk handleSmallCapsSpans
-- <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
- [] -> []
-
-
-writeYAMLString :: [Inline] -> String
+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] -> 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 @@ instance ToJSON Formatted where
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 @@ instance Walk.Walkable Formatted Formatted where
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 @@ toStr = intercalate [Str "\n"] .
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 Style
data Locale
= Locale
- { localeVersion :: String
- , localeLang :: String
+ { localeVersion :: Text
+ , localeLang :: Text
, localeOptions :: [Option]
, localeTerms :: [CslTerm]
, localeDate :: [Element]
@@ -304,12 +305,12 @@ data Locale
-- 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 @@ mergeLocales s l ls = doMerge list
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 @@ hasOrdinals = any (any hasOrd . localeTerms)
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 @@ instance FromJSON Abbreviations where
parseJSON _ = fail "Could not read Abbreviations"
type MacroMap
- = (String,[Element])
+ = (Text,[Element])
data Citation
= Citation
@@ -395,7 +396,7 @@ data Bibliography
, 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 Layout
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 IfThen
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 @@ match None = all not
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 @@ defaultDate
, 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 Plural
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 @@ hasEtAl = any isEtAl
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 @@ data Quote
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 @@ data Output
| 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 @@ instance OVERLAPS
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 @@ data BiblioData
= 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 @@ data BiblioData
-- 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 @@ nonDroppingPartTransform ag
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 -> Bool
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)
diff --git a/src/Text/CSL/Util.hs b/src/Text/CSL/Util.hs
index 5fd9ed0..a37ab7c 100644
--- a/src/Text/CSL/Util.hs
+++ b/src/Text/CSL/Util.hs
@@ -32,6 +32,7 @@ module Text.CSL.Util
, titlecase
, unTitlecase
, protectCase
+ , splitWhen
, splitStrWhen
, proc
, proc'
@@ -90,32 +91,36 @@ tr' :: String -> a -> a
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
-
-capitalize :: String -> String
-capitalize [] = []
-capitalize (c:cs) = toUpper c : cs
+(<^>) :: 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 :: 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,14 +141,17 @@ words' :: String -> [String]
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
@@ -155,14 +163,14 @@ parseBool (Number n) = case fromJSON (Number n) of
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 @@ parseInt (Number n) = case fromJSON (Number n) of
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 @@ parseMaybeInt (Just (Number n)) = case fromJSON (Number n) of
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 :: Monad m => (b -> m a) -> (Maybe b -> m (Maybe a))
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 @@ caseTransform xform = fmap reverse . foldM go [] . splitUpStr
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 @@ splitStrWhen p (Str xs : ys) = go (T.unpack xs) ++ splitStrWhen p ys
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 :: [a] -> [a] -> [a]
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 @@ toRead (s:ss) = toUpper s : camel ss
| 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 (SoftBreak:xs) = xs
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 @@ pRomanNumeral = do
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.
diff --git a/stack.yaml b/stack.yaml
index 7179d3f..745f89b 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -12,16 +12,17 @@ extra-deps:
- 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
diff --git a/tests/issue437.csl b/tests/issue437.csl
new file mode 100644
index 0000000..396ff44
--- /dev/null
+++ b/tests/issue437.csl
@@ -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="&#160;">
+ <number variable="number-of-pages"/>
+ <label variable="number-of-pages"/>
+ </group>
+ </group>
+ </layout>
+ </citation>
+</style>
diff --git a/tests/issue437.expected.native b/tests/issue437.expected.native
new file mode 100644
index 0000000..e67eed9
--- /dev/null
+++ b/tests/issue437.expected.native
@@ -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"]]]]]]
diff --git a/tests/issue437.in.native b/tests/issue437.in.native
new file mode 100644
index 0000000..fee48a6
--- /dev/null
+++ b/tests/issue437.in.native
@@ -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]"]]]]
diff --git a/tests/test-citeproc.hs b/tests/test-citeproc.hs
index 234da80..7bff56e 100644
--- a/tests/test-citeproc.hs
+++ b/tests/test-citeproc.hs
@@ -28,6 +28,8 @@ import Text.Pandoc (Block (..), Format (..), Inline (..),
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 @@ data TestCase = TestCase{
, testCsl :: Style -- csl
, testAbbreviations :: Abbreviations -- abbreviations
, testReferences :: [Reference] -- input
- , testResult :: String -- result
+ , testResult :: Text -- result
} deriving (Show)
data Mode = CitationMode
@@ -119,10 +121,10 @@ runTest path = E.handle (handler path) $ do
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 @@ runTest path = E.handle (handler path) $ do
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 &amp; instead of &#38; etc.
-adjustEntities :: String -> String
-adjustEntities ('&':'#':'3':'8':';':xs) = "&amp;" ++ adjustEntities xs
-adjustEntities (x:xs) = x : adjustEntities xs
-adjustEntities [] = []
+adjustEntities :: Text -> Text
+adjustEntities = T.replace "&#38;" "&amp;"
-- 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]
diff --git a/tests/test-pandoc-citeproc.hs b/tests/test-pandoc-citeproc.hs
index 08efcf9..4186e30 100644
--- a/tests/test-pandoc-citeproc.hs
+++ b/tests/test-pandoc-citeproc.hs
@@ -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 @@ testCase regenerate csl = do
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 @@ testCase regenerate csl = do
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 @@ biblio2yamlTest regenerate fp = do
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"