citeproc-hs 0.3.5 → 0.3.6

raw patch · 8 files changed

+263/−103 lines, 8 filesdep +hexpatPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hexpat

API changes (from Hackage documentation)

Files

• citeproc-hs.cabal +18/−4
• src/Text/CSL/Input/Bibutils.hs +2/−1
• src/Text/CSL/Parser.hs +10/−6
• src/Text/CSL/Pickle.hs +26/−77
• src/Text/CSL/Pickle/Hexpat.hs +101/−0
• src/Text/CSL/Pickle/Xml.hs +90/−0
• src/Text/CSL/Style.hs +12/−12
• src/Text/CSL/Test.hs +4/−3

@@ -1,5 +1,5 @@ name:               citeproc-hs-version:            0.3.5+version:            0.3.6 homepage:           http://gorgias.mine.nu/repos/citeproc-hs/ synopsis:           A Citation Style Language implementation in Haskell @@ -30,14 +30,15 @@                     locales/locales-de-CH.xml                     locales/locales-de-DE.xml                     locales/locales-el-GR.xml-                    locales/locales-en-US.xml                     locales/locales-en-GB.xml+                    locales/locales-en-US.xml                     locales/locales-es-ES.xml                     locales/locales-et-EE.xml                     locales/locales-eu.xml                     locales/locales-fa-IR.xml                     locales/locales-fi-FI.xml-		    locales/locales-fr-FR.xml+                    locales/locales-fr-CA.xml+                    locales/locales-fr-FR.xml                     locales/locales-he-IL.xml                     locales/locales-hu-HU.xml                     locales/locales-is-IS.xml@@ -45,6 +46,7 @@                     locales/locales-ja-JP.xml                     locales/locales-km-KH.xml                     locales/locales-ko-KR.xml+                    locales/locales-lt-LT.xml                     locales/locales-mn-MN.xml                     locales/locales-nb-NO.xml                     locales/locales-nl-NL.xml@@ -76,6 +78,10 @@   description: Use network and HTTP to retrieve csl file from URIs.   default:     True +flag hexpat+  description: Use hexpat to parse XML+  default:     True+ flag embed_data_files   description: Embed locale files into the library (needed for windows packaging)   default:     False@@ -104,7 +110,7 @@     ghc-options:      -funbox-strict-fields -Wall     ghc-prof-options: -prof -auto-all     hs-source-dirs:   src-    build-depends:    containers, directory, mtl, xml, json, utf8-string,+    build-depends:    containers, directory, mtl, json, utf8-string,                       bytestring, filepath, pandoc-types >= 1.8 && < 1.11      if flag(bibutils)@@ -116,6 +122,14 @@        build-depends: network >= 2, HTTP >= 4000.0.9        extensions:    CPP        cpp-options:   -DUSE_NETWORK++    if flag(hexpat)+       build-depends: hexpat >= 0.20.2+       exposed-modules:  Text.CSL.Pickle.Hexpat+       cpp-options:   -DUSE_HEXPAT+    else+       build-depends: xml+       exposed-modules:  Text.CSL.Pickle.Xml      if flag(embed_data_files)        build-depends: template-haskell, file-embed

@@ -17,6 +17,7 @@     , BibFormat (..)     ) where +import Data.ByteString.Lazy.UTF8 ( fromString ) import Data.Char import System.FilePath ( takeExtension ) import Text.CSL.Pickle@@ -83,7 +84,7 @@  readBiblioString :: BibFormat -> String -> IO [Reference] readBiblioString b s-    | Mods      <- b = return $ readXmlString xpModsCollection s+    | Mods      <- b = return $ readXmlString xpModsCollection (fromString s)     | Json      <- b = return $ readJsonInputString s     | Native    <- b = return $ decodeJSON s #ifdef USE_BIBUTILS

@@ -22,7 +22,7 @@ import Text.CSL.Pickle #ifdef EMBED_DATA_FILES import Data.FileEmbed-import qualified Data.ByteString as BS+import qualified Data.ByteString as S import Data.ByteString.UTF8 ( toString ) #else import Paths_citeproc_hs ( getDataFileName )@@ -31,6 +31,8 @@  import Data.Char        ( isUpper, toUpper, toLower ) import Data.Maybe       ( catMaybes                 )+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Lazy.UTF8 ( fromString )  #ifdef USE_NETWORK import Network.HTTP ( getResponseBody, mkRequest, RequestMethod(..) )@@ -54,18 +56,20 @@ #else   f <- readFile' src #endif-  parseCSL f+  parseCSL' f  -- | Parse a 'String' into a fully localized 'Style' parseCSL :: String -> IO Style-parseCSL f = do+parseCSL = parseCSL' . fromString++parseCSL' :: L.ByteString -> IO Style+parseCSL' f = do   let s = readXmlString xpStyle f   l <- readLocaleFile (styleDefaultLocale s)   return s { styleLocale = mergeLocales (styleDefaultLocale s) l (styleLocale s)} - #ifdef EMBED_DATA_FILES-localeFiles :: [(FilePath, BS.ByteString)]+localeFiles :: [(FilePath, L.ByteString)] localeFiles = $(embedDir "locales/") #endif @@ -82,7 +86,7 @@             | otherwise     -> case lookup ("locales-" ++ take 5 x ++ ".xml") localeFiles of                                  Just x' -> return x'                                  _       -> error "could not load the locale file"-  return $ readXmlString xpLocale (toString f)+  return $ readXmlString xpLocale f #else   f <- case s of          x | length x == 2 -> getDataFileName ("locales/locales-" ++

@@ -22,10 +22,14 @@ import Data.List        ( elemIndex     ) import Data.Maybe import System.Directory ( doesFileExist )-import qualified Data.ByteString as B-import Data.ByteString.UTF8 ( toString )+import qualified Data.ByteString.Lazy as L +#ifdef USE_HEXPAT+import Text.CSL.Pickle.Hexpat+#else+import Text.CSL.Pickle.Xml import Text.XML.Light+#endif  data St     = St { attributes :: [Attr]@@ -38,7 +42,7 @@          }  pickleXML :: PU a -> a -> String-pickleXML p v = concatMap showContent $ contents st+pickleXML p v = concatMap showXML $ contents st     where st = appPickle p (v, emptySt)  unpickleXML :: PU a -> [Content] -> Maybe a@@ -59,11 +63,11 @@ addCont x s = s {contents = x : contents s}  dropCont :: St -> St-dropCont s = s { contents = drop 1 (contents s) }+dropCont s = s { contents = dropFirstElem (contents s)}  getAtt :: String -> St -> Maybe Attr getAtt name-    = listToMaybe . filter ((==) name .  qName . attrKey) . attributes+    = listToMaybe . filter ((==) name .  getAttName) . attributes  getCont	:: St -> Maybe Content getCont	= listToMaybe . contents@@ -234,35 +238,6 @@  -------------------------------------------------------------------------------- -getText :: Content -> Maybe String-getText c-    | Text cd <- c = Just (showCData cd)-    | otherwise    = Nothing--getChildren :: Content -> [Content]-getChildren c-    | Elem el <- c = elContent el-    | otherwise    = []--getElemName :: Content -> Maybe QName-getElemName c-    | Elem el <- c = Just (elName el)-    | otherwise    = Nothing--getAttrl :: Content -> [Attr]-getAttrl c-    | Elem el <- c = elAttribs el-    | otherwise    = []--mkText :: String -> Content-mkText str = Text $ blank_cdata { cdData = str}--mkName :: String -> QName-mkName n = blank_name {qName = n}--qualifiedName :: QName -> String-qualifiedName qn = (fromMaybe [] $ qPrefix qn) ++ qName qn- xpText :: PU String xpText     = PU { appPickle   = \ (s, st) -> addCont (mkText s) st@@ -271,9 +246,8 @@     where     unpickleString st 	= do-	  t <- getCont st-	  s <- getText t-	  return (Just (unescape s), dropCont st)+	  s <- getText (contents st)+	  return (Just (unescape s), st {contents = dropText $ contents st})  xpText0 :: PU String xpText0@@ -288,21 +262,21 @@ 			   let 	                   st' = appPickle pa (a, emptySt) 			   in-			   addCont (Elem $ Element (mkName name) (attributes st') (contents st') Nothing) st+			   addCont (mkElement name (attributes st') (contents st')) st 			 ) 	 , appUnPickle = \ st -> fromMaybe (Nothing, st) (unpickleElement st) 	 }       where       unpickleElement st           = do-            e  <- listToMaybe . map Elem . onlyElems . contents $ st+            e <- listToMaybe . onlyElems' . contents $ st             n <- getElemName e             if qualifiedName n /= name               then fail "element name does not match"               else do                 al  <- Just $ getAttrl e                 res <- fst . appUnPickle pa $ St {attributes = al, contents = getChildren e}-                return (Just res, st {contents = filter ((/=) (show e) . show) $ contents st})+                return (Just res, dropCont st)  -- | A pickler for interleaved elements. xpIElem	:: String -> PU a -> PU a@@ -311,14 +285,14 @@ 			   let 	                   st' = appPickle pa (a, emptySt) 			   in-			   addCont (Elem $ Element (mkName name) (attributes st') (contents st') Nothing) st+			   addCont (mkElement name (attributes st') (contents st')) st 			 ) 	 , appUnPickle = \ st -> fromMaybe (Nothing, st) (unpickleElement st) 	 }       where       unpickleElement st           = do-            let t = map Elem . onlyElems . contents $ st+            let t = onlyElems' . contents $ st             ns <- mapM getElemName t             case elemIndex name (map qualifiedName ns) of               Nothing -> fail "element name does not match"@@ -334,19 +308,16 @@ 			   let 			   st' = appPickle pa (a, emptySt) 			   in-			   addAtt (Attr (mkName name) (getAtVal $ contents st')) st+			   addAtt (mkAttribute name $ getAttrVal $ contents st') st 			 ) 	 , appUnPickle = \ st -> fromMaybe (Nothing, st) (unpickleAttr st) 	 }       where-      getAtVal at-          | Text cd : _ <- at = cdData cd-          | otherwise         = []       unpickleAttr st 	  = do 	    a <- getAtt name st 	    res <- fst . appUnPickle pa $ St { attributes = []-                                             , contents   = [Text blank_cdata {cdData = attrVal a}]}+                                             , contents   = [attrToCont a]} 	    return (Just res, st)  xpElemWithAttrValue :: String -> String -> String -> PU a -> PU a@@ -383,38 +354,16 @@ unescape ('&':'a':'m':'p':';':xs) = "&" ++ unescape xs unescape (x:                  xs) = x    : unescape xs -readXmlString :: Show a => PU a -> String -> a-readXmlString xp str =-      case parseXML str of-        [] -> error $ "error while reading the style"-        x  -> case unpickleXML xp x of-                Just a -> a-                _      -> case getStyleVersion x of-                            (_:_) -> error "error while parsing the style"-                            _     -> error styleErr08+readXmlString :: Show a => PU a -> L.ByteString -> a+readXmlString xp s+    = case unpickleXML xp $ parseXML' s of+        Just a -> a+        _      -> error "error while parsing the XML string" -readXmlFile :: Show a => PU a -> String -> IO a+readXmlFile :: Show a => PU a -> FilePath -> IO a readXmlFile xp f = readXmlString xp `fmap` readFile' f -readFile' :: FilePath -> IO String+readFile' :: FilePath -> IO L.ByteString readFile' f = do   flip unless (error $ f ++ " file does not exist") =<< doesFileExist f-  toString `fmap` B.readFile f--getStyleVersion :: [Content] -> String-getStyleVersion c-    = case filterElems c of-        [x] -> case lookupAttr styleVersion (elAttribs x) of-                 Just s -> s-                 _      -> []-        _   -> error "malformed style: no cs:style element found"-    where-      filterElems  = catMaybes . map (filterElementName isStyle) . onlyElems-      styleVersion = mkName "version"-      isStyle (QName qn _ _) = qn == "style"--styleErr08 :: String-styleErr08-    = "the parsed style seems to be CSL-0.8 while citeproc-hs only supports CSL 1.0.\n" ++-      "Styles may be updated by using the csl-utils. For more information see:\n" ++-      "http://citationstyles.org/downloads/upgrade-notes.html#updating-csl-0-8-styles"+  L.readFile f

@@ -0,0 +1,101 @@+{-# LANGUAGE PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.CSL.Pickle.Hexpat+-- Copyright   :  (c) Andrea Rossato+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Andrea Rossato <andrea.rossato@unitn.it>+-- Stability   :  unstable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Text.CSL.Pickle.Hexpat where++import qualified Data.ByteString.Lazy as L+import Data.ByteString.Lazy.UTF8 ( toString )+import Data.Maybe+import Text.XML.Expat.Tree hiding ( mkText, getText, getChildren )+import Text.XML.Expat.Format+import Text.XML.Expat.Proc++type Content = UNode String+type Attr    = (String, String)++showXML :: Content -> String+showXML = toString . format++getText :: [Content] -> Maybe String+getText [] = Nothing+getText (c:xs)+    | Text x <- c = Just (x ++ getAllText xs)+    | otherwise   = Nothing++getAllText :: [Content] -> String+getAllText [] = []+getAllText (c:xs)+    | Text cd <- c = cd ++ getAllText xs+    | otherwise    = []++dropFirstElem :: [Content] -> [Content]+dropFirstElem [] = []+dropFirstElem (x:xs)+    | Text {} <- x = dropFirstElem xs+    | otherwise    = xs++dropText :: [Content] -> [Content]+dropText [] = []+dropText a@(c:cs)+    | Text _ <- c = dropText cs+    | otherwise   = a++getChildren :: Content -> [Content]+getChildren c+    | Element _ _ x <- c = x+    | otherwise          = []++getElemName :: Content -> Maybe String+getElemName c+    | Element x _ _ <- c = Just x+    | otherwise          = Nothing++getAttName :: Attr -> String+getAttName = reverse . takeWhile (/= ':') . reverse . fst++getAttrl :: Content -> [Attr]+getAttrl c+    | Element _ x _ <- c = x+    | otherwise          = []++getAttrVal :: [Content] -> String+getAttrVal at+    | Text cd : _ <- at = cd+    | otherwise         = []++mkText :: String -> Content+mkText = Text++mkName :: String -> String+mkName = id++mkElement :: String -> [Attr] -> [Content] -> Content+mkElement n a c = Element n a c++mkAttribute :: String -> String -> Attr+mkAttribute n v = (n, v)++attrToCont :: Attr -> Content+attrToCont = Text . snd++qualifiedName :: String -> String+qualifiedName = id++onlyElems' :: [Content] -> [Content]+onlyElems' = onlyElems++parseXML' :: L.ByteString -> [Content]+parseXML' s+    = case parse defaultParseOptions s of+        (_, Just  e) -> error $ "error while reading the XML file: " ++ show e+        (x, Nothing) -> return x

@@ -0,0 +1,90 @@+{-# LANGUAGE PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.CSL.Pickle.Xml+-- Copyright   :  (c) Andrea Rossato+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Andrea Rossato <andrea.rossato@unitn.it>+-- Stability   :  unstable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Text.CSL.Pickle.Xml where++import Data.ByteString.Lazy.UTF8 ( toString )+import qualified Data.ByteString.Lazy as L+import Data.Maybe+import Text.XML.Light++showXML :: Content -> String+showXML = showContent++getText :: [Content] -> Maybe String+getText [] = Nothing+getText (c:_)+    | Text  x <- c = Just (showCData x)+    | otherwise    = Nothing++getChildren :: Content -> [Content]+getChildren c+    | Elem el <- c = elContent el+    | otherwise    = []++getElemName :: Content -> Maybe QName+getElemName c+    | Elem el <- c = Just (elName el)+    | otherwise    = Nothing++dropFirstElem :: [Content] -> [Content]+dropFirstElem [] = []+dropFirstElem (x:xs)+    | Text {} <- x = dropFirstElem xs+    | otherwise    = xs++dropText :: [Content] -> [Content]+dropText [] = []+dropText a@(x:xs)+    | Text {} <- x = dropFirstElem xs+    | otherwise    = a++getAttName :: Attr -> String+getAttName = qName . attrKey++getAttrl :: Content -> [Attr]+getAttrl c+    | Elem el <- c = elAttribs el+    | otherwise    = []++getAttrVal :: [Content] -> String+getAttrVal at+    | Text cd : _ <- at = cdData cd+    | otherwise         = []++mkText :: String -> Content+mkText s = Text $ blank_cdata { cdData = s }++attrToCont :: Attr -> Content+attrToCont a = Text $ blank_cdata { cdData = attrVal a }++mkName :: String -> QName+mkName n = blank_name {qName = n }++mkElement :: String -> [Attr] -> [Content] -> Content+mkElement n a c = Elem $ Element (mkName n) a c Nothing++mkAttribute :: String -> String -> Attr+mkAttribute n c = Attr (mkName n) c++qualifiedName :: QName -> String+qualifiedName qn = (fromMaybe [] $ qPrefix qn) ++ qName qn++onlyElems' :: [Content] -> [Content]+onlyElems' = map Elem . onlyElems++parseXML' :: L.ByteString -> [Content]+parseXML' s+    = case parseXML (toString s) of+        [] -> error $ "error while reading the XML string"+        x  -> x

@@ -35,7 +35,7 @@       , csMacros           :: [MacroMap]       , citation           ::  Citation       , biblio             ::  Maybe Bibliography-      } deriving ( Show, Typeable, Data )+      } deriving ( Show, Read, Typeable, Data )  data Locale     = Locale@@ -44,7 +44,7 @@       , localeOptions :: [Option]       , localeTermMap :: [TermMap]       , localeDate    :: [Element]-      } deriving ( Show, Eq, Typeable, Data )+      } deriving ( Show, Read, Eq, Typeable, Data )  -- | With the 'defaultLocale', the locales-xx-XX.xml loaded file and -- the parsed 'Style' cs:locale elements, produce the final 'Locale'@@ -79,14 +79,14 @@       { citOptions :: [Option]       , citSort    :: [Sort]       , citLayout  ::  Layout-      } deriving ( Show, Typeable, Data )+      } deriving ( Show, Read, Typeable, Data )  data Bibliography     = Bibliography       { bibOptions :: [Option]       , bibSort    :: [Sort]       , bibLayout  ::  Layout-      } deriving ( Show, Typeable, Data )+      } deriving ( Show, Read, Typeable, Data )  type Option = (String,String) @@ -98,7 +98,7 @@       { layFormat ::  Formatting       , layDelim  ::  Delimiter       , elements  :: [Element]-      } deriving ( Show, Typeable, Data )+      } deriving ( Show, Read, Typeable, Data )  data Element     = Choose       IfThen    [IfThen]    [Element]@@ -113,11 +113,11 @@     | Substitute  [Element]     | Group        Formatting Delimiter  [Element]     | Date        [String]    DateForm    Formatting Delimiter [DatePart] String-      deriving ( Show, Eq, Typeable, Data )+      deriving ( Show, Read, Eq, Typeable, Data )  data IfThen     = IfThen Condition Match [Element]-      deriving ( Eq, Show, Typeable, Data )+      deriving ( Eq, Show, Read, Typeable, Data )  data Condition     = Condition@@ -128,7 +128,7 @@       , isPosition      :: [String]       , disambiguation  :: [String]       , isLocator       :: [String]-      } deriving ( Eq, Show, Typeable, Data )+      } deriving ( Eq, Show, Read, Typeable, Data )  type Delimiter = String @@ -149,7 +149,7 @@       , dpForm       :: String       , dpRangeDelim :: String       , dpFormatting :: Formatting-      } deriving ( Show, Eq, Typeable, Data )+      } deriving ( Show, Read, Eq, Typeable, Data )  defaultDate :: [DatePart] defaultDate@@ -160,7 +160,7 @@ data Sort     = SortVariable String Sorting     | SortMacro    String Sorting Int Int String-      deriving ( Eq, Show, Typeable, Data )+      deriving ( Eq, Show, Read, Typeable, Data )  data Sorting     = Ascending  String@@ -219,13 +219,13 @@     = Name      Form Formatting NameAttrs Delimiter [NamePart]     | NameLabel Form Formatting Plural     | EtAl           Formatting String-      deriving ( Eq, Show, Typeable, Data )+      deriving ( Eq, Show, Read, Typeable, Data )  type NameAttrs = [(String, String)]  data NamePart     = NamePart String Formatting-      deriving ( Show, Eq, Typeable, Data )+      deriving ( Show, Read, Eq, Typeable, Data )  isPlural :: Plural -> Int -> Bool isPlural p l

@@ -23,6 +23,7 @@  import Control.Arrow import Control.Monad.State+import Data.ByteString.Lazy.UTF8 ( fromString ) import Data.Char (toLower) import Data.List import Data.Maybe (isJust)@@ -44,7 +45,7 @@ import Text.CSL.Style import Text.Pandoc.Definition #ifdef EMBED_DATA_FILES-import qualified Data.ByteString.UTF8 as BS ( toString )+import Data.ByteString.UTF8 ( toString ) import Text.CSL.Parser ( localeFiles ) #else import System.IO.Unsafe@@ -79,7 +80,7 @@       look s = case lookup s object of                  Just (JSString x) -> fromJSString x                  _                 -> error $ "in test " ++ s ++ " section."-      style  = readXmlString xpStyle $ look "csl"+      style  = readXmlString xpStyle . fromString $ look "csl"       mode   = look "mode"       result = look "result" @@ -216,7 +217,7 @@                    | otherwise     -> take 5 x #ifdef EMBED_DATA_FILES   ls <- case lookup ("locales-" ++ locale ++ ".xml") localeFiles of-          Just x' -> return $ readXmlString xpLocale (BS.toString x')+          Just x' -> return $ readXmlString xpLocale (toString x')           _       -> return $ Locale [] [] [] [] [] #else   ls' <- getCachedLocale locale