{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Writers.CslJson
   Copyright   : Copyright (C) 2020-2022 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of references from 'Pandoc' metadata to CSL JSON:
<https://citeproc-js.readthedocs.io/en/latest/csl-json/markup.html>.

Note that this writer ignores everything in the body of the
document and everything in the metadata except `references`.
It assumes that the `references` field is a list with the structure
of a CSL JSON bibliography.
-}
module Text.Pandoc.Writers.CslJson ( writeCslJson )
where
import Data.Text (Text)
import qualified Data.Text as T
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Error
import Text.Pandoc.Class
import Control.Monad.Except (throwError)
import Data.ByteString.Lazy (toStrict)
import Data.ByteString (ByteString)
import Text.Pandoc.Definition
import Text.Pandoc.Builder as B
import Text.Pandoc.Citeproc.MetaValue (metaValueToReference, metaValueToText)
import Citeproc (parseLang, Locale, Reference(..), Lang(..))
import Control.Monad.Identity
import Citeproc.Locale (getLocale)
import Citeproc.CslJson
import Text.Pandoc.Options (WriterOptions)
import Data.Maybe (mapMaybe, fromMaybe)
import Data.Aeson.Encode.Pretty         (Config (..), Indent (Spaces),
                                         NumberFormat (Generic),
                                         defConfig, encodePretty')

writeCslJson :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeCslJson :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeCslJson WriterOptions
_opts (Pandoc Meta
meta [Block]
_) = do
  let lang :: Lang
lang = forall a. a -> Maybe a -> a
fromMaybe (Text
-> Maybe Text
-> Maybe Text
-> [Text]
-> [(Text, [(Text, Text)])]
-> [Text]
-> Lang
Lang Text
"en" forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
"US") [] [] [])
               (Text -> Meta -> Maybe MetaValue
lookupMeta Text
"lang" Meta
meta forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Lang
parseLang)
  Locale
locale <- case Lang -> Either CiteprocError Locale
getLocale Lang
lang of
               Left CiteprocError
e  -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ CiteprocError -> PandocError
PandocCiteprocError CiteprocError
e
               Right Locale
l -> forall (m :: * -> *) a. Monad m => a -> m a
return Locale
l
  let rs :: [MetaValue]
rs = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"references" Meta
meta of
             Just (MetaList [MetaValue]
xs) -> [MetaValue]
xs
             Maybe MetaValue
_ -> []
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Text
UTF8.toText
           (Locale -> [Reference Inlines] -> ByteString
toCslJson Locale
locale (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MetaValue -> Maybe (Reference Inlines)
metaValueToReference [MetaValue]
rs)) forall a. Semigroup a => a -> a -> a
<> Text
"\n"

fromInlines :: [Inline] -> CslJson Text
fromInlines :: [Inline] -> CslJson Text
fromInlines = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Inline -> CslJson Text
fromInline forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Many a
B.fromList

fromInline :: Inline -> CslJson Text
fromInline :: Inline -> CslJson Text
fromInline (Str Text
t) = forall a. a -> CslJson a
CslText Text
t
fromInline (Emph [Inline]
ils) = forall a. CslJson a -> CslJson a
CslItalic ([Inline] -> CslJson Text
fromInlines [Inline]
ils)
fromInline (Strong [Inline]
ils) = forall a. CslJson a -> CslJson a
CslBold ([Inline] -> CslJson Text
fromInlines [Inline]
ils)
fromInline (Underline [Inline]
ils) = forall a. CslJson a -> CslJson a
CslUnderline ([Inline] -> CslJson Text
fromInlines [Inline]
ils)
fromInline (Strikeout [Inline]
ils) = [Inline] -> CslJson Text
fromInlines [Inline]
ils
fromInline (Superscript [Inline]
ils) = forall a. CslJson a -> CslJson a
CslSup ([Inline] -> CslJson Text
fromInlines [Inline]
ils)
fromInline (Subscript [Inline]
ils) = forall a. CslJson a -> CslJson a
CslSub ([Inline] -> CslJson Text
fromInlines [Inline]
ils)
fromInline (SmallCaps [Inline]
ils) = forall a. CslJson a -> CslJson a
CslSmallCaps ([Inline] -> CslJson Text
fromInlines [Inline]
ils)
fromInline (Quoted QuoteType
_ [Inline]
ils) = forall a. CslJson a -> CslJson a
CslQuoted ([Inline] -> CslJson Text
fromInlines [Inline]
ils)
fromInline (Cite [Citation]
_ [Inline]
ils) = [Inline] -> CslJson Text
fromInlines [Inline]
ils
fromInline (Code Attr
_ Text
t) = forall a. a -> CslJson a
CslText Text
t
fromInline Inline
Space = forall a. a -> CslJson a
CslText Text
" "
fromInline Inline
SoftBreak = forall a. a -> CslJson a
CslText Text
" "
fromInline Inline
LineBreak = forall a. a -> CslJson a
CslText Text
"\n"
fromInline (Math MathType
_ Text
t) = forall a. a -> CslJson a
CslText Text
t
fromInline (RawInline Format
_ Text
_) = forall a. CslJson a
CslEmpty
fromInline (Link Attr
_ [Inline]
ils (Text, Text)
_) = [Inline] -> CslJson Text
fromInlines [Inline]
ils
fromInline (Image Attr
_ [Inline]
ils (Text, Text)
_) = [Inline] -> CslJson Text
fromInlines [Inline]
ils
fromInline (Note [Block]
_) = forall a. CslJson a
CslEmpty
fromInline (Span (Text
_,[Text
cl],[(Text, Text)]
_) [Inline]
ils)
  | Text
"csl-" Text -> Text -> Bool
`T.isPrefixOf` Text
cl = forall a. Text -> CslJson a -> CslJson a
CslDiv Text
cl ([Inline] -> CslJson Text
fromInlines [Inline]
ils)
  | Text
cl forall a. Eq a => a -> a -> Bool
== Text
"nocase" = forall a. CslJson a -> CslJson a
CslNoCase ([Inline] -> CslJson Text
fromInlines [Inline]
ils)
fromInline (Span Attr
_ [Inline]
ils) = [Inline] -> CslJson Text
fromInlines [Inline]
ils

toCslJson :: Locale -> [Reference Inlines] -> ByteString
toCslJson :: Locale -> [Reference Inlines] -> ByteString
toCslJson Locale
locale = ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
defConfig{ confIndent :: Indent
confIndent = Int -> Indent
Spaces Int
2
                         , confCompare :: Text -> Text -> Ordering
confCompare = forall a. Ord a => a -> a -> Ordering
compare
                         , confNumFormat :: NumberFormat
confNumFormat = NumberFormat
Generic }
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Bool -> Locale -> CslJson Text -> Text
renderCslJson Bool
False Locale
locale forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Inline -> CslJson Text
fromInline))