{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
   Module      : Text.Pandoc.Lua.Marshaling.ReaderOptions
   Copyright   : © 2012-2022 John MacFarlane
                 © 2017-2022 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Marshal citeproc 'Reference' values.
-}
module Text.Pandoc.Lua.Marshal.Reference
  ( pushReference
  ) where

import Citeproc.Types
  ( Date (..), DateParts (..), ItemId (..), Name (..), Reference (..)
  , Val (..), Variable, fromVariable
  )
import Control.Monad (forM_)
import HsLua hiding (Name, Reference, pushName, peekName)
import Text.Pandoc.Builder (Inlines, toList)
import Text.Pandoc.Lua.Marshal.Inline (pushInlines)
import Text.Pandoc.Lua.Marshal.List (pushPandocList)

import qualified Data.Map as Map
import qualified HsLua

-- | Pushes a ReaderOptions value as userdata object.
pushReference :: LuaError e => Pusher e (Reference Inlines)
pushReference :: forall e. LuaError e => Pusher e (Reference Inlines)
pushReference Reference Inlines
reference = do
  [(Name, Reference Inlines -> LuaE e ())]
-> Reference Inlines -> LuaE e ()
forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable [ (Name
"id", Pusher e ItemId
forall e. Pusher e ItemId
pushItemId Pusher e ItemId
-> (Reference Inlines -> ItemId) -> Reference Inlines -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference Inlines -> ItemId
forall a. Reference a -> ItemId
referenceId)
              , (Name
"type", Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text
-> (Reference Inlines -> Text) -> Reference Inlines -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference Inlines -> Text
forall a. Reference a -> Text
referenceType)
              ]
              Reference Inlines
reference
  [(Variable, Val Inlines)]
-> ((Variable, Val Inlines) -> LuaE e ()) -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Variable (Val Inlines) -> [(Variable, Val Inlines)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Variable (Val Inlines) -> [(Variable, Val Inlines)])
-> Map Variable (Val Inlines) -> [(Variable, 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
reference) (((Variable, Val Inlines) -> LuaE e ()) -> LuaE e ())
-> ((Variable, Val Inlines) -> LuaE e ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \(Variable
var, Val Inlines
val) -> do
    Pusher e Variable
forall e. Pusher e Variable
pushVariable Variable
var
    Pusher e (Val Inlines)
forall e. LuaError e => Pusher e (Val Inlines)
pushVal Val Inlines
val
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)

-- | Pushes an 'ItemId' as a string.
pushItemId :: Pusher e ItemId
pushItemId :: forall e. Pusher e ItemId
pushItemId = Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> (ItemId -> Text) -> ItemId -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemId -> Text
unItemId

-- | Pushes a person's 'Name' as a table.
pushName :: LuaError e => Pusher e Name
pushName :: forall e. LuaError e => Pusher e Name
pushName = [(Name, Name -> LuaE e ())] -> Name -> LuaE e ()
forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
  [ (Name
"family"                , Maybe Text -> LuaE e ()
forall {e}. Maybe Text -> LuaE e ()
pushTextOrNil (Maybe Text -> LuaE e ())
-> (Name -> Maybe Text) -> Name -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Maybe Text
nameFamily)
  , (Name
"given"                 , Maybe Text -> LuaE e ()
forall {e}. Maybe Text -> LuaE e ()
pushTextOrNil (Maybe Text -> LuaE e ())
-> (Name -> Maybe Text) -> Name -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Maybe Text
nameGiven)
  , (Name
"dropping-particle"     , Maybe Text -> LuaE e ()
forall {e}. Maybe Text -> LuaE e ()
pushTextOrNil (Maybe Text -> LuaE e ())
-> (Name -> Maybe Text) -> Name -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Maybe Text
nameDroppingParticle)
  , (Name
"non-dropping-particle" , Maybe Text -> LuaE e ()
forall {e}. Maybe Text -> LuaE e ()
pushTextOrNil (Maybe Text -> LuaE e ())
-> (Name -> Maybe Text) -> Name -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Maybe Text
nameNonDroppingParticle)
  , (Name
"suffix"                , Maybe Text -> LuaE e ()
forall {e}. Maybe Text -> LuaE e ()
pushTextOrNil (Maybe Text -> LuaE e ())
-> (Name -> Maybe Text) -> Name -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Maybe Text
nameSuffix)
  , (Name
"literal"               , Maybe Text -> LuaE e ()
forall {e}. Maybe Text -> LuaE e ()
pushTextOrNil (Maybe Text -> LuaE e ())
-> (Name -> Maybe Text) -> Name -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Maybe Text
nameLiteral)
  , (Name
"comma-suffix"          , Pusher e Bool
forall e. Pusher e Bool
pushBoolOrNil Pusher e Bool -> (Name -> Bool) -> Name -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Bool
nameCommaSuffix)
  , (Name
"static-ordering"       , Pusher e Bool
forall e. Pusher e Bool
pushBoolOrNil Pusher e Bool -> (Name -> Bool) -> Name -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Bool
nameStaticOrdering)
  ]
  where
    pushTextOrNil :: Maybe Text -> LuaE e ()
pushTextOrNil = \case
      Maybe Text
Nothing -> LuaE e ()
forall e. LuaE e ()
pushnil
      Just Text
xs -> Pusher e Text
forall e. Pusher e Text
pushText Text
xs

-- | Pushes a boolean, but uses @nil@ instead of @false@; table fields
-- are not set unless the value is true.
pushBoolOrNil :: Pusher e Bool
pushBoolOrNil :: forall e. Pusher e Bool
pushBoolOrNil = \case
  Bool
False -> LuaE e ()
forall e. LuaE e ()
pushnil
  Bool
True  -> Bool -> LuaE e ()
forall e. Pusher e Bool
pushBool Bool
True

-- | Pushes a 'Variable' as string.
pushVariable :: Pusher e Variable
pushVariable :: forall e. Pusher e Variable
pushVariable = Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> (Variable -> Text) -> Variable -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Text
fromVariable

-- | Pushes a 'Val', i.e., a variable value.
pushVal :: LuaError e => Pusher e (Val Inlines)
pushVal :: forall e. LuaError e => Pusher e (Val Inlines)
pushVal = \case
  TextVal Text
t -> Pusher e Text
forall e. Pusher e Text
pushText Text
t
  FancyVal Inlines
inlns -> Pusher e [Inline]
forall e. LuaError e => Pusher e [Inline]
pushInlines Pusher e [Inline] -> Pusher e [Inline]
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
inlns
  NumVal Int
i       -> Int -> LuaE e ()
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral Int
i
  NamesVal [Name]
names -> Pusher e Name -> Pusher e [Name]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Name
forall e. LuaError e => Pusher e Name
pushName [Name]
names
  DateVal Date
date   -> Pusher e Date
forall e. LuaError e => Pusher e Date
pushDate Date
date

-- | Pushes a 'Date' as table.
pushDate :: LuaError e => Pusher e Date
pushDate :: forall e. LuaError e => Pusher e Date
pushDate = [(Name, Date -> LuaE e ())] -> Date -> LuaE e ()
forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
  [ (Name
"date-parts", Pusher e DateParts -> Pusher e [DateParts]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e DateParts
forall {e}. LuaError e => DateParts -> LuaE e ()
pushDateParts Pusher e [DateParts] -> (Date -> [DateParts]) -> Date -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> [DateParts]
dateParts)
  , (Name
"circa", Pusher e Bool
forall e. Pusher e Bool
pushBoolOrNil Pusher e Bool -> (Date -> Bool) -> Date -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Bool
dateCirca)
  , (Name
"season", LuaE e () -> (Int -> LuaE e ()) -> Maybe Int -> LuaE e ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE e ()
forall e. LuaE e ()
pushnil Int -> LuaE e ()
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral (Maybe Int -> LuaE e ())
-> (Date -> Maybe Int) -> Date -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Maybe Int
dateSeason)
  , (Name
"literal", LuaE e () -> (Text -> LuaE e ()) -> Maybe Text -> LuaE e ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE e ()
forall e. LuaE e ()
pushnil Text -> LuaE e ()
forall e. Pusher e Text
pushText (Maybe Text -> LuaE e ())
-> (Date -> Maybe Text) -> Date -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Maybe Text
dateLiteral)
  ]
 where
   -- date parts are lists of Int values
   pushDateParts :: DateParts -> LuaE e ()
pushDateParts (DateParts [Int]
dp) = Pusher e Int -> Pusher e [Int]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral [Int]
dp

-- | Helper funtion to push an object as a table.
pushAsTable :: LuaError e
            => [(HsLua.Name, a -> LuaE e ())]
            -> a -> LuaE e ()
pushAsTable :: forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable [(Name, a -> LuaE e ())]
props a
obj = do
  Int -> Int -> LuaE e ()
forall e. Int -> Int -> LuaE e ()
createtable Int
0 ([(Name, a -> LuaE e ())] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Name, a -> LuaE e ())]
props)
  [(Name, a -> LuaE e ())]
-> ((Name, a -> LuaE e ()) -> LuaE e ()) -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Name, a -> LuaE e ())]
props (((Name, a -> LuaE e ()) -> LuaE e ()) -> LuaE e ())
-> ((Name, a -> LuaE e ()) -> LuaE e ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \(Name
name, a -> LuaE e ()
pushValue) -> do
    Name -> LuaE e ()
forall e. Name -> LuaE e ()
HsLua.pushName Name
name
    a -> LuaE e ()
pushValue a
obj
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)