{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Citeproc.CslJson
  ( cslJsonToReferences )
where

import Citeproc.CslJson
import Citeproc.Types
import Control.Monad.Identity (runIdentity)
import Data.Aeson (eitherDecodeStrict')
import Data.ByteString (ByteString)
import Text.Pandoc.Builder as B
import Data.Text (Text)

fromCslJson :: CslJson Text -> Inlines
fromCslJson :: CslJson Text -> Inlines
fromCslJson (CslText Text
t) = Text -> Inlines
B.text Text
t
fromCslJson CslJson Text
CslEmpty = Inlines
forall a. Monoid a => a
mempty
fromCslJson (CslConcat CslJson Text
x CslJson Text
y) = CslJson Text -> Inlines
fromCslJson CslJson Text
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> CslJson Text -> Inlines
fromCslJson CslJson Text
y
fromCslJson (CslQuoted CslJson Text
x) = Inlines -> Inlines
B.doubleQuoted (CslJson Text -> Inlines
fromCslJson CslJson Text
x)
fromCslJson (CslItalic CslJson Text
x) = Inlines -> Inlines
B.emph (CslJson Text -> Inlines
fromCslJson CslJson Text
x)
fromCslJson (CslNormal CslJson Text
x) = CslJson Text -> Inlines
fromCslJson CslJson Text
x  -- TODO?
fromCslJson (CslBold CslJson Text
x) = Inlines -> Inlines
B.strong (CslJson Text -> Inlines
fromCslJson CslJson Text
x)
fromCslJson (CslUnderline CslJson Text
x) = Inlines -> Inlines
B.underline (CslJson Text -> Inlines
fromCslJson CslJson Text
x)
fromCslJson (CslNoDecoration CslJson Text
x) =
  Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"nodecoration"],[]) (CslJson Text -> Inlines
fromCslJson CslJson Text
x)
fromCslJson (CslSmallCaps CslJson Text
x) = Inlines -> Inlines
B.smallcaps (CslJson Text -> Inlines
fromCslJson CslJson Text
x)
fromCslJson (CslBaseline CslJson Text
x) = CslJson Text -> Inlines
fromCslJson CslJson Text
x
fromCslJson (CslSub CslJson Text
x) = Inlines -> Inlines
B.subscript (CslJson Text -> Inlines
fromCslJson CslJson Text
x)
fromCslJson (CslSup CslJson Text
x) = Inlines -> Inlines
B.superscript (CslJson Text -> Inlines
fromCslJson CslJson Text
x)
fromCslJson (CslNoCase CslJson Text
x) = Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"nocase"],[]) (CslJson Text -> Inlines
fromCslJson CslJson Text
x)
fromCslJson (CslDiv Text
t CslJson Text
x) = Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"csl-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t],[]) (CslJson Text -> Inlines
fromCslJson CslJson Text
x)

cslJsonToReferences :: ByteString -> Either String [Reference Inlines]
cslJsonToReferences :: ByteString -> Either String [Reference Inlines]
cslJsonToReferences ByteString
raw =
  case ByteString -> Either String [Reference (CslJson Text)]
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
raw of
    Left String
e        -> String -> Either String [Reference Inlines]
forall a b. a -> Either a b
Left String
e
    Right [Reference (CslJson Text)]
cslrefs -> [Reference Inlines] -> Either String [Reference Inlines]
forall a b. b -> Either a b
Right ([Reference Inlines] -> Either String [Reference Inlines])
-> [Reference Inlines] -> Either String [Reference Inlines]
forall a b. (a -> b) -> a -> b
$
      (Reference (CslJson Text) -> Reference Inlines)
-> [Reference (CslJson Text)] -> [Reference Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Identity (Reference Inlines) -> Reference Inlines
forall a. Identity a -> a
runIdentity (Identity (Reference Inlines) -> Reference Inlines)
-> (Reference (CslJson Text) -> Identity (Reference Inlines))
-> Reference (CslJson Text)
-> Reference Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CslJson Text -> Identity Inlines)
-> Reference (CslJson Text) -> Identity (Reference Inlines)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Inlines -> Identity Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> Identity Inlines)
-> (CslJson Text -> Inlines) -> CslJson Text -> Identity Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CslJson Text -> Inlines
fromCslJson)) [Reference (CslJson Text)]
cslrefs