{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Citeproc.MetaValue
  ( referenceToMetaValue
  , metaValueToReference
  , metaValueToText
  )
where

import Citeproc.Types
import Text.Pandoc.Definition
import Text.Pandoc.Builder as B
import Text.Pandoc.Shared (stringify, blocksToInlines')
import Data.Maybe
import Safe
import qualified Data.Set as Set
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text (Text)
import Text.Printf (printf)
import Control.Applicative ((<|>))

metaValueToText :: MetaValue -> Maybe Text
metaValueToText :: MetaValue -> Maybe Text
metaValueToText (MetaString Text
t) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
metaValueToText (MetaInlines [Inline]
ils) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils
metaValueToText (MetaBlocks [Block]
bls) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Block] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Block]
bls
metaValueToText (MetaList [MetaValue]
xs) = [Text] -> Text
T.unwords ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MetaValue -> Maybe Text) -> [MetaValue] -> Maybe [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM MetaValue -> Maybe Text
metaValueToText [MetaValue]
xs
metaValueToText MetaValue
_ = Maybe Text
forall a. Maybe a
Nothing

metaValueToBool :: MetaValue -> Maybe Bool
metaValueToBool :: MetaValue -> Maybe Bool
metaValueToBool (MetaBool Bool
b) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b
metaValueToBool (MetaString Text
"true") = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
metaValueToBool (MetaString Text
"false") = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
metaValueToBool (MetaInlines [Inline]
ils) =
  MetaValue -> Maybe Bool
metaValueToBool (Text -> MetaValue
MetaString ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils))
metaValueToBool MetaValue
_ = Maybe Bool
forall a. Maybe a
Nothing

referenceToMetaValue :: Reference Inlines -> MetaValue
referenceToMetaValue :: Reference Inlines -> MetaValue
referenceToMetaValue Reference Inlines
ref =
  let ItemId Text
id' = Reference Inlines -> ItemId
forall a. Reference a -> ItemId
referenceId Reference Inlines
ref
      type' :: Text
type' = Reference Inlines -> Text
forall a. Reference a -> Text
referenceType Reference Inlines
ref
   in Map Text MetaValue -> MetaValue
MetaMap (Map Text MetaValue -> MetaValue)
-> Map Text MetaValue -> MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"id" (Text -> MetaValue
MetaString Text
id')
              (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue -> Map Text MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"type" (Text -> MetaValue
MetaString Text
type')
              (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue -> Map Text MetaValue
forall a b. (a -> b) -> a -> b
$ (Val Inlines -> MetaValue)
-> Map Text (Val Inlines) -> Map Text MetaValue
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Val Inlines -> MetaValue
valToMetaValue
              (Map Text (Val Inlines) -> Map Text MetaValue)
-> Map Text (Val Inlines) -> Map Text MetaValue
forall a b. (a -> b) -> a -> b
$ (Variable -> Text)
-> Map Variable (Val Inlines) -> Map Text (Val Inlines)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Variable -> Text
fromVariable
              (Map Variable (Val Inlines) -> Map Text (Val Inlines))
-> Map Variable (Val Inlines) -> Map Text (Val Inlines)
forall a b. (a -> b) -> a -> b
$ Reference Inlines -> Map Variable (Val Inlines)
forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference Inlines
ref


valToMetaValue :: Val Inlines -> MetaValue
valToMetaValue :: Val Inlines -> MetaValue
valToMetaValue (TextVal Text
t) = Text -> MetaValue
MetaString Text
t
valToMetaValue (FancyVal Inlines
ils) = [Inline] -> MetaValue
MetaInlines (Inlines -> [Inline]
forall a. Many a -> [a]
B.toList Inlines
ils)
valToMetaValue (NumVal Int
n) = Text -> MetaValue
MetaString (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n)
valToMetaValue (NamesVal [Name]
ns) = [MetaValue] -> MetaValue
MetaList ([MetaValue] -> MetaValue) -> [MetaValue] -> MetaValue
forall a b. (a -> b) -> a -> b
$ (Name -> MetaValue) -> [Name] -> [MetaValue]
forall a b. (a -> b) -> [a] -> [b]
map Name -> MetaValue
nameToMetaValue [Name]
ns
valToMetaValue (DateVal Date
d) = Date -> MetaValue
dateToMetaValue Date
d
valToMetaValue Val Inlines
_ = Text -> MetaValue
MetaString Text
forall a. Monoid a => a
mempty

nameToMetaValue :: Name -> MetaValue
nameToMetaValue :: Name -> MetaValue
nameToMetaValue Name
name =
  Map Text MetaValue -> MetaValue
MetaMap (Map Text MetaValue -> MetaValue)
-> Map Text MetaValue -> MetaValue
forall a b. (a -> b) -> a -> b
$
    ((Map Text MetaValue -> Map Text MetaValue)
-> (Text -> Map Text MetaValue -> Map Text MetaValue)
-> Maybe Text
-> Map Text MetaValue
-> Map Text MetaValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Text MetaValue -> Map Text MetaValue
forall a. a -> a
id (Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"family" (MetaValue -> Map Text MetaValue -> Map Text MetaValue)
-> (Text -> MetaValue)
-> Text
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MetaValue
MetaString) (Name -> Maybe Text
nameFamily Name
name)) (Map Text MetaValue -> Map Text MetaValue)
-> (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((Map Text MetaValue -> Map Text MetaValue)
-> (Text -> Map Text MetaValue -> Map Text MetaValue)
-> Maybe Text
-> Map Text MetaValue
-> Map Text MetaValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Text MetaValue -> Map Text MetaValue
forall a. a -> a
id (Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"given" (MetaValue -> Map Text MetaValue -> Map Text MetaValue)
-> (Text -> MetaValue)
-> Text
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MetaValue
MetaString) (Name -> Maybe Text
nameGiven Name
name)) (Map Text MetaValue -> Map Text MetaValue)
-> (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((Map Text MetaValue -> Map Text MetaValue)
-> (Text -> Map Text MetaValue -> Map Text MetaValue)
-> Maybe Text
-> Map Text MetaValue
-> Map Text MetaValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Text MetaValue -> Map Text MetaValue
forall a. a -> a
id (Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"dropping-particle" (MetaValue -> Map Text MetaValue -> Map Text MetaValue)
-> (Text -> MetaValue)
-> Text
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MetaValue
MetaString)
       (Name -> Maybe Text
nameDroppingParticle Name
name)) (Map Text MetaValue -> Map Text MetaValue)
-> (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((Map Text MetaValue -> Map Text MetaValue)
-> (Text -> Map Text MetaValue -> Map Text MetaValue)
-> Maybe Text
-> Map Text MetaValue
-> Map Text MetaValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Text MetaValue -> Map Text MetaValue
forall a. a -> a
id (Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"non-dropping-particle" (MetaValue -> Map Text MetaValue -> Map Text MetaValue)
-> (Text -> MetaValue)
-> Text
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MetaValue
MetaString)
       (Name -> Maybe Text
nameNonDroppingParticle Name
name)) (Map Text MetaValue -> Map Text MetaValue)
-> (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((Map Text MetaValue -> Map Text MetaValue)
-> (Text -> Map Text MetaValue -> Map Text MetaValue)
-> Maybe Text
-> Map Text MetaValue
-> Map Text MetaValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Text MetaValue -> Map Text MetaValue
forall a. a -> a
id (Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"suffix" (MetaValue -> Map Text MetaValue -> Map Text MetaValue)
-> (Text -> MetaValue)
-> Text
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MetaValue
MetaString) (Name -> Maybe Text
nameSuffix Name
name)) (Map Text MetaValue -> Map Text MetaValue)
-> (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((Map Text MetaValue -> Map Text MetaValue)
-> (Text -> Map Text MetaValue -> Map Text MetaValue)
-> Maybe Text
-> Map Text MetaValue
-> Map Text MetaValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Text MetaValue -> Map Text MetaValue
forall a. a -> a
id (Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"literal" (MetaValue -> Map Text MetaValue -> Map Text MetaValue)
-> (Text -> MetaValue)
-> Text
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MetaValue
MetaString) (Name -> Maybe Text
nameLiteral Name
name)) (Map Text MetaValue -> Map Text MetaValue)
-> (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (if Name -> Bool
nameCommaSuffix Name
name
        then Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"comma-suffix" (Bool -> MetaValue
MetaBool Bool
True)
        else Map Text MetaValue -> Map Text MetaValue
forall a. a -> a
id) (Map Text MetaValue -> Map Text MetaValue)
-> (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (if Name -> Bool
nameStaticOrdering Name
name
        then Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"static-ordering" (Bool -> MetaValue
MetaBool Bool
True)
        else Map Text MetaValue -> Map Text MetaValue
forall a. a -> a
id)
    (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue -> Map Text MetaValue
forall a b. (a -> b) -> a -> b
$ Map Text MetaValue
forall a. Monoid a => a
mempty

dateToMetaValue :: Date -> MetaValue
dateToMetaValue :: Date -> MetaValue
dateToMetaValue Date
date =
  Text -> MetaValue
MetaString (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$
    (case Date -> Maybe Text
dateLiteral Date
date of
       Just Text
l  -> Text
l
       Maybe Text
Nothing -> Text -> [Text] -> Text
T.intercalate Text
"/" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (DateParts -> Text) -> [DateParts] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map DateParts -> Text
datePartsToEDTF ([DateParts] -> [Text]) -> [DateParts] -> [Text]
forall a b. (a -> b) -> a -> b
$ Date -> [DateParts]
dateParts Date
date)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Date -> Bool
dateCirca Date
date then Text
"~" else Text
"")
 where
  datePartsToEDTF :: DateParts -> Text
datePartsToEDTF (DateParts [Int]
dps) =
    String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
     (case [Int]
dps of
        (Int
y:[Int]
_) | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9999 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< -Int
10000 -> (Char
'y'Char -> String -> String
forall a. a -> [a] -> [a]
:)
        [Int]
_ -> String -> String
forall a. a -> a
id) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
    case [Int]
dps of
      (Int
y:Int
m:Int
d:[Int]
_)
       | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< -Int
1     -> String -> Int -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%05d-%02d-%02d" (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
m Int
d
       | Bool
otherwise  -> String -> Int -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%04d-%02d-%02d" Int
y Int
m Int
d
      (Int
y:Int
m:[])
       | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< -Int
1     -> String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%05d-%02d" (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
m
       | Bool
otherwise  -> String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%04d-%02d" Int
y Int
m
      (Int
y:[])
       | Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0     -> String -> String
forall r. PrintfType r => String -> r
printf String
"" -- used for open range
       | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< -Int
1     -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%05d" (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
       | Bool
otherwise  -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%04d" Int
y
      [Int]
_             -> String
forall a. Monoid a => a
mempty

metaValueToReference :: MetaValue
                     -> Maybe (Reference Inlines)
metaValueToReference :: MetaValue -> Maybe (Reference Inlines)
metaValueToReference (MetaMap Map Text MetaValue
m) = do
  let m' :: Map Text MetaValue
m' = (Text -> Text) -> Map Text MetaValue -> Map Text MetaValue
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Text -> Text
normalizeKey Map Text MetaValue
m
  Text
id' <- Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"id" Map Text MetaValue
m' Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText
  Text
type' <- (Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"type" Map Text MetaValue
m' Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText) Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
  let m'' :: Map Text MetaValue
m'' = Text -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Text
"id" (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue -> Map Text MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Text
"type" Map Text MetaValue
m'
  let vars :: Map Variable (Val Inlines)
vars = (Text -> Variable)
-> Map Text (Val Inlines) -> Map Variable (Val Inlines)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Text -> Variable
toVariable (Map Text (Val Inlines) -> Map Variable (Val Inlines))
-> Map Text (Val Inlines) -> Map Variable (Val Inlines)
forall a b. (a -> b) -> a -> b
$ (Text -> MetaValue -> Val Inlines)
-> Map Text MetaValue -> Map Text (Val Inlines)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey Text -> MetaValue -> Val Inlines
metaValueToVal Map Text MetaValue
m''
  Reference Inlines -> Maybe (Reference Inlines)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reference Inlines -> Maybe (Reference Inlines))
-> Reference Inlines -> Maybe (Reference Inlines)
forall a b. (a -> b) -> a -> b
$ Reference { referenceId :: ItemId
referenceId = Text -> ItemId
ItemId Text
id'
                     , referenceType :: Text
referenceType = Text
type'
                     , referenceDisambiguation :: Maybe DisambiguationData
referenceDisambiguation = Maybe DisambiguationData
forall a. Maybe a
Nothing
                     , referenceVariables :: Map Variable (Val Inlines)
referenceVariables = Map Variable (Val Inlines)
vars }
metaValueToReference MetaValue
_ = Maybe (Reference Inlines)
forall a. Maybe a
Nothing

metaValueToVal :: Text -> MetaValue -> Val Inlines
metaValueToVal :: Text -> MetaValue -> Val Inlines
metaValueToVal Text
k MetaValue
v
  | Text
k Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
dateVariables
       = Date -> Val Inlines
forall a. Date -> Val a
DateVal (Date -> Val Inlines) -> Date -> Val Inlines
forall a b. (a -> b) -> a -> b
$ MetaValue -> Date
metaValueToDate MetaValue
v
  | Text
k Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
nameVariables
       = [Name] -> Val Inlines
forall a. [Name] -> Val a
NamesVal ([Name] -> Val Inlines) -> [Name] -> Val Inlines
forall a b. (a -> b) -> a -> b
$ MetaValue -> [Name]
metaValueToNames MetaValue
v
  | Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"other-ids"
       = Text -> Val Inlines
forall a. Text -> Val a
TextVal (Text -> Val Inlines) -> Text -> Val Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ MetaValue -> Maybe Text
metaValueToText MetaValue
v
         -- will create space-separated list
  | Bool
otherwise =
    case MetaValue
v of
      MetaString Text
t -> Text -> Val Inlines
forall a. Text -> Val a
TextVal Text
t
      MetaInlines [Inline]
ils -> Inlines -> Val Inlines
forall a. a -> Val a
FancyVal ([Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils)
      MetaBlocks [Block]
bs   -> Inlines -> Val Inlines
forall a. a -> Val a
FancyVal ([Block] -> Inlines
blocksToInlines' [Block]
bs)
      MetaBool Bool
b   -> Text -> Val Inlines
forall a. Text -> Val a
TextVal (if Bool
b then Text
"true" else Text
"false")
      MetaList [MetaValue]
_   -> Text -> Val Inlines
forall a. Text -> Val a
TextVal Text
forall a. Monoid a => a
mempty
      MetaMap  Map Text MetaValue
_   -> Text -> Val Inlines
forall a. Text -> Val a
TextVal Text
forall a. Monoid a => a
mempty

metaValueToDate :: MetaValue -> Date
metaValueToDate :: MetaValue -> Date
metaValueToDate (MetaMap Map Text MetaValue
m) = Date -> Maybe Date -> Date
forall a. a -> Maybe a -> a
fromMaybe
  (Date
   { dateParts :: [DateParts]
dateParts = [DateParts]
dateparts
   , dateCirca :: Bool
dateCirca = Bool
circa
   , dateSeason :: Maybe Int
dateSeason = Maybe Int
season
   , dateLiteral :: Maybe Text
dateLiteral = Maybe Text
literal })
  Maybe Date
rawdate
 where
  dateparts :: [DateParts]
dateparts = case Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"date-parts" Map Text MetaValue
m of
                Just (MetaList [MetaValue]
xs) ->
                  (MetaValue -> Maybe DateParts) -> [MetaValue] -> [DateParts]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MetaValue -> Maybe DateParts
metaValueToDateParts [MetaValue]
xs
                Just MetaValue
_ -> []
                Maybe MetaValue
Nothing ->
                  Maybe DateParts -> [DateParts]
forall a. Maybe a -> [a]
maybeToList (Maybe DateParts -> [DateParts]) -> Maybe DateParts -> [DateParts]
forall a b. (a -> b) -> a -> b
$ MetaValue -> Maybe DateParts
metaValueToDateParts (Map Text MetaValue -> MetaValue
MetaMap Map Text MetaValue
m)
  circa :: Bool
circa = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$
            Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"circa" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Bool) -> Maybe Bool
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Bool
metaValueToBool
  season :: Maybe Int
season = Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"season" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Int
metaValueToInt
  literal :: Maybe Text
literal = Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"literal" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText
  rawdate :: Maybe Date
rawdate = Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"raw" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText Maybe Text -> (Text -> Maybe Date) -> Maybe Date
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Date
rawDateEDTF
metaValueToDate (MetaList [MetaValue]
xs) =
  Date{ dateParts :: [DateParts]
dateParts = (MetaValue -> Maybe DateParts) -> [MetaValue] -> [DateParts]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MetaValue -> Maybe DateParts
metaValueToDateParts [MetaValue]
xs
      , dateCirca :: Bool
dateCirca = Bool
False
      , dateSeason :: Maybe Int
dateSeason = Maybe Int
forall a. Maybe a
Nothing
      , dateLiteral :: Maybe Text
dateLiteral = Maybe Text
forall a. Maybe a
Nothing }
metaValueToDate MetaValue
x =
  Date -> Maybe Date -> Date
forall a. a -> Maybe a -> a
fromMaybe Date
emptyDate (Maybe Date -> Date) -> Maybe Date -> Date
forall a b. (a -> b) -> a -> b
$ MetaValue -> Maybe Text
metaValueToText MetaValue
x Maybe Text -> (Text -> Maybe Date) -> Maybe Date
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Date
rawDateEDTF


metaValueToInt :: MetaValue -> Maybe Int
metaValueToInt :: MetaValue -> Maybe Int
metaValueToInt MetaValue
x = MetaValue -> Maybe Text
metaValueToText MetaValue
x Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

metaValueToDateParts :: MetaValue -> Maybe DateParts
metaValueToDateParts :: MetaValue -> Maybe DateParts
metaValueToDateParts (MetaList [MetaValue]
xs) =
  DateParts -> Maybe DateParts
forall a. a -> Maybe a
Just (DateParts -> Maybe DateParts) -> DateParts -> Maybe DateParts
forall a b. (a -> b) -> a -> b
$ [Int] -> DateParts
DateParts ([Int] -> DateParts) -> [Int] -> DateParts
forall a b. (a -> b) -> a -> b
$ (MetaValue -> Int) -> [MetaValue] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> (MetaValue -> Maybe Int) -> MetaValue -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaValue -> Maybe Int
metaValueToInt) [MetaValue]
xs
metaValueToDateParts (MetaMap Map Text MetaValue
m) =
  case (Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"year" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Int
metaValueToInt,
        ((Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"month" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Int
metaValueToInt)
          Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
20) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"season" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Int
metaValueToInt))),
        Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"day" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Int
metaValueToInt) of
    (Just Int
y, Just Int
mo, Just Int
d)  -> DateParts -> Maybe DateParts
forall a. a -> Maybe a
Just (DateParts -> Maybe DateParts) -> DateParts -> Maybe DateParts
forall a b. (a -> b) -> a -> b
$ [Int] -> DateParts
DateParts [Int
y, Int
mo, Int
d]
    (Just Int
y, Just Int
mo, Maybe Int
Nothing) -> DateParts -> Maybe DateParts
forall a. a -> Maybe a
Just (DateParts -> Maybe DateParts) -> DateParts -> Maybe DateParts
forall a b. (a -> b) -> a -> b
$ [Int] -> DateParts
DateParts [Int
y, Int
mo]
    (Just Int
y, Maybe Int
Nothing, Maybe Int
_)       -> DateParts -> Maybe DateParts
forall a. a -> Maybe a
Just (DateParts -> Maybe DateParts) -> DateParts -> Maybe DateParts
forall a b. (a -> b) -> a -> b
$ [Int] -> DateParts
DateParts [Int
y]
    (Maybe Int, Maybe Int, Maybe Int)
_                          -> Maybe DateParts
forall a. Maybe a
Nothing
metaValueToDateParts MetaValue
_ = Maybe DateParts
forall a. Maybe a
Nothing

emptyDate :: Date
emptyDate :: Date
emptyDate = Date { dateParts :: [DateParts]
dateParts = []
                 , dateCirca :: Bool
dateCirca = Bool
False
                 , dateSeason :: Maybe Int
dateSeason = Maybe Int
forall a. Maybe a
Nothing
                 , dateLiteral :: Maybe Text
dateLiteral = Maybe Text
forall a. Maybe a
Nothing }

metaValueToNames :: MetaValue -> [Name]
metaValueToNames :: MetaValue -> [Name]
metaValueToNames (MetaList [MetaValue]
xs) = (MetaValue -> Maybe Name) -> [MetaValue] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MetaValue -> Maybe Name
metaValueToName [MetaValue]
xs
metaValueToNames MetaValue
x = Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Maybe Name -> [Name]) -> Maybe Name -> [Name]
forall a b. (a -> b) -> a -> b
$ MetaValue -> Maybe Name
metaValueToName MetaValue
x

metaValueToName :: MetaValue -> Maybe Name
metaValueToName :: MetaValue -> Maybe Name
metaValueToName (MetaMap Map Text MetaValue
m) = Name -> Name
extractParticles (Name -> Name) -> Maybe Name -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Name -> Maybe Name
forall a. a -> Maybe a
Just Name
    { nameFamily :: Maybe Text
nameFamily = Maybe Text
family
    , nameGiven :: Maybe Text
nameGiven = Maybe Text
given
    , nameDroppingParticle :: Maybe Text
nameDroppingParticle = Maybe Text
dropping
    , nameNonDroppingParticle :: Maybe Text
nameNonDroppingParticle = Maybe Text
nondropping
    , nameSuffix :: Maybe Text
nameSuffix = Maybe Text
suffix
    , nameCommaSuffix :: Bool
nameCommaSuffix = Bool
commasuffix
    , nameStaticOrdering :: Bool
nameStaticOrdering = Bool
staticordering
    , nameLiteral :: Maybe Text
nameLiteral = Maybe Text
literal
    }
 where
  family :: Maybe Text
family = Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"family" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText
  given :: Maybe Text
given  = Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"given" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText
  dropping :: Maybe Text
dropping = Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"dropping-particle" Map Text MetaValue
m
                Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText
  nondropping :: Maybe Text
nondropping = Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"non-dropping-particle" Map Text MetaValue
m
                Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText
  suffix :: Maybe Text
suffix = Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"suffix" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText
  commasuffix :: Bool
commasuffix = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"comma-suffix" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Bool) -> Maybe Bool
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Bool
metaValueToBool
  staticordering :: Bool
staticordering = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"static-ordering" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Bool) -> Maybe Bool
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Bool
metaValueToBool
  literal :: Maybe Text
literal = Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"literal" Map Text MetaValue
m Maybe MetaValue -> (MetaValue -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
metaValueToText
metaValueToName MetaValue
x = Name -> Name
extractParticles (Name -> Name) -> Maybe Name -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  case MetaValue -> Maybe Text
metaValueToText MetaValue
x of
    Maybe Text
Nothing -> Maybe Name
forall a. Maybe a
Nothing
    Just Text
lit -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
                     { nameFamily :: Maybe Text
nameFamily = Maybe Text
forall a. Maybe a
Nothing
                     , nameGiven :: Maybe Text
nameGiven = Maybe Text
forall a. Maybe a
Nothing
                     , nameDroppingParticle :: Maybe Text
nameDroppingParticle = Maybe Text
forall a. Maybe a
Nothing
                     , nameNonDroppingParticle :: Maybe Text
nameNonDroppingParticle = Maybe Text
forall a. Maybe a
Nothing
                     , nameSuffix :: Maybe Text
nameSuffix = Maybe Text
forall a. Maybe a
Nothing
                     , nameCommaSuffix :: Bool
nameCommaSuffix = Bool
False
                     , nameStaticOrdering :: Bool
nameStaticOrdering = Bool
False
                     , nameLiteral :: Maybe Text
nameLiteral = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lit }

dateVariables :: Set.Set Text
dateVariables :: Set Text
dateVariables = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
  [ Text
"accessed", Text
"container", Text
"event-date", Text
"issued",
    Text
"original-date", Text
"submitted" ]

nameVariables :: Set.Set Text
nameVariables :: Set Text
nameVariables = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
  [ Text
"author", Text
"collection-editor", Text
"composer",
    Text
"container-author", Text
"director", Text
"editor",
    Text
"editorial-director", Text
"illustrator",
    Text
"interviewer", Text
"original-author",
    Text
"recipient", Text
"reviewed-author",
    Text
"translator" ]

normalizeKey :: Text -> Text
normalizeKey :: Text -> Text
normalizeKey Text
k =
  case Text -> Text
T.toLower Text
k of
    Text
"doi"   -> Text
"DOI"
    Text
"isbn"  -> Text
"ISBN"
    Text
"issn"  -> Text
"ISSN"
    Text
"pmcid" -> Text
"PMCID"
    Text
"pmid"  -> Text
"PMID"
    Text
"url"   -> Text
"URL"
    Text
x       -> Text
x