{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{- |
   Module      : Text.Pandoc.Lua.Marshaling.CommonState
   Copyright   : © 2012-2021 John MacFarlane
                 © 2017-2021 Albert Krewinkel
   License     : GNU GPL, version 2 or above
   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Instances to marshal (push) and unmarshal (peek) the common state.
-}
module Text.Pandoc.Lua.Marshaling.CommonState () where

import Foreign.Lua (Lua, Peekable, Pushable)
import Foreign.Lua.Types.Peekable (reportValueOnFailure)
import Foreign.Lua.Userdata (ensureUserdataMetatable, pushAnyWithMetatable,
                             toAnyWithName)
import Text.Pandoc.Class (CommonState (..))
import Text.Pandoc.Logging (LogMessage, showLogMessage)
import Text.Pandoc.Lua.Marshaling.AnyValue (AnyValue (..))

import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil

-- | Name used by Lua for the @CommonState@ type.
commonStateTypeName :: String
commonStateTypeName :: String
commonStateTypeName = String
"Pandoc CommonState"

instance Peekable CommonState where
  peek :: StackIndex -> Lua CommonState
peek StackIndex
idx = String
-> (StackIndex -> Lua (Maybe CommonState))
-> StackIndex
-> Lua CommonState
forall a.
String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
reportValueOnFailure String
commonStateTypeName
             (StackIndex -> String -> Lua (Maybe CommonState)
forall a. StackIndex -> String -> Lua (Maybe a)
`toAnyWithName` String
commonStateTypeName) StackIndex
idx

instance Pushable CommonState where
  push :: CommonState -> Lua ()
push CommonState
st = Lua () -> CommonState -> Lua ()
forall a. Lua () -> a -> Lua ()
pushAnyWithMetatable Lua ()
pushCommonStateMetatable CommonState
st
   where
    pushCommonStateMetatable :: Lua ()
pushCommonStateMetatable = String -> Lua () -> Lua ()
ensureUserdataMetatable String
commonStateTypeName (Lua () -> Lua ()) -> Lua () -> Lua ()
forall a b. (a -> b) -> a -> b
$ do
      String -> (CommonState -> AnyValue -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction String
"__index" CommonState -> AnyValue -> Lua NumResults
indexCommonState
      String -> (CommonState -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction String
"__pairs" CommonState -> Lua NumResults
pairsCommonState

indexCommonState :: CommonState -> AnyValue -> Lua Lua.NumResults
indexCommonState :: CommonState -> AnyValue -> Lua NumResults
indexCommonState CommonState
st (AnyValue StackIndex
idx) = StackIndex -> Lua Type
Lua.ltype StackIndex
idx Lua Type -> (Type -> Lua NumResults) -> Lua NumResults
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
Lua.TypeString -> NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (StackIndex -> Lua Text
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx Lua Text -> (Text -> Lua ()) -> Lua ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Lua ()
pushField)
  Type
_ -> NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lua ()
Lua.pushnil
 where
  pushField :: Text.Text -> Lua ()
  pushField :: Text -> Lua ()
pushField Text
name = case Text
-> [(Text, CommonState -> Lua ())] -> Maybe (CommonState -> Lua ())
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
name [(Text, CommonState -> Lua ())]
commonStateFields of
    Just CommonState -> Lua ()
pushValue -> CommonState -> Lua ()
pushValue CommonState
st
    Maybe (CommonState -> Lua ())
Nothing -> Lua ()
Lua.pushnil

pairsCommonState :: CommonState -> Lua Lua.NumResults
pairsCommonState :: CommonState -> Lua NumResults
pairsCommonState CommonState
st = do
  (AnyValue -> AnyValue -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => a -> Lua ()
Lua.pushHaskellFunction AnyValue -> AnyValue -> Lua NumResults
nextFn
  Lua ()
Lua.pushnil
  Lua ()
Lua.pushnil
  NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
3
 where
  nextFn :: AnyValue -> AnyValue -> Lua Lua.NumResults
  nextFn :: AnyValue -> AnyValue -> Lua NumResults
nextFn AnyValue
_ (AnyValue StackIndex
idx) =
    StackIndex -> Lua Type
Lua.ltype StackIndex
idx Lua Type -> (Type -> Lua NumResults) -> Lua NumResults
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Type
Lua.TypeNil -> case [(Text, CommonState -> Lua ())]
commonStateFields of
        []  -> NumResults
2 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Lua ()
Lua.pushnil Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lua ()
Lua.pushnil)
        (Text
key, CommonState -> Lua ()
pushValue):[(Text, CommonState -> Lua ())]
_ -> NumResults
2 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Text
key Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CommonState -> Lua ()
pushValue CommonState
st)
      Type
Lua.TypeString -> do
        Text
key <- StackIndex -> Lua Text
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
        case [(Text, CommonState -> Lua ())] -> [(Text, CommonState -> Lua ())]
forall a. [a] -> [a]
tail ([(Text, CommonState -> Lua ())]
 -> [(Text, CommonState -> Lua ())])
-> [(Text, CommonState -> Lua ())]
-> [(Text, CommonState -> Lua ())]
forall a b. (a -> b) -> a -> b
$ ((Text, CommonState -> Lua ()) -> Bool)
-> [(Text, CommonState -> Lua ())]
-> [(Text, CommonState -> Lua ())]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
key) (Text -> Bool)
-> ((Text, CommonState -> Lua ()) -> Text)
-> (Text, CommonState -> Lua ())
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, CommonState -> Lua ()) -> Text
forall a b. (a, b) -> a
fst) [(Text, CommonState -> Lua ())]
commonStateFields of
          []                     -> NumResults
2 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Lua ()
Lua.pushnil Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lua ()
Lua.pushnil)
          (Text
nextKey, CommonState -> Lua ()
pushValue):[(Text, CommonState -> Lua ())]
_ -> NumResults
2 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Text
nextKey Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CommonState -> Lua ()
pushValue CommonState
st)
      Type
_ -> NumResults
2 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Lua ()
Lua.pushnil Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lua ()
Lua.pushnil)

commonStateFields :: [(Text.Text, CommonState -> Lua ())]
commonStateFields :: [(Text, CommonState -> Lua ())]
commonStateFields =
  [ (Text
"input_files", [String] -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push ([String] -> Lua ())
-> (CommonState -> [String]) -> CommonState -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> [String]
stInputFiles)
  , (Text
"output_file", Optional String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Optional String -> Lua ())
-> (CommonState -> Optional String) -> CommonState -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Optional String
forall a. Maybe a -> Optional a
Lua.Optional (Maybe String -> Optional String)
-> (CommonState -> Maybe String) -> CommonState -> Optional String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> Maybe String
stOutputFile)
  , (Text
"log", [LogMessage] -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push ([LogMessage] -> Lua ())
-> (CommonState -> [LogMessage]) -> CommonState -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> [LogMessage]
stLog)
  , (Text
"request_headers", Map Text Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Map Text Text -> Lua ())
-> (CommonState -> Map Text Text) -> CommonState -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> (CommonState -> [(Text, Text)]) -> CommonState -> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> [(Text, Text)]
stRequestHeaders)
  , (Text
"resource_path", [String] -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push ([String] -> Lua ())
-> (CommonState -> [String]) -> CommonState -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> [String]
stResourcePath)
  , (Text
"source_url", Optional Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Optional Text -> Lua ())
-> (CommonState -> Optional Text) -> CommonState -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Optional Text
forall a. Maybe a -> Optional a
Lua.Optional (Maybe Text -> Optional Text)
-> (CommonState -> Maybe Text) -> CommonState -> Optional Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> Maybe Text
stSourceURL)
  , (Text
"user_data_dir", Optional String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Optional String -> Lua ())
-> (CommonState -> Optional String) -> CommonState -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Optional String
forall a. Maybe a -> Optional a
Lua.Optional (Maybe String -> Optional String)
-> (CommonState -> Maybe String) -> CommonState -> Optional String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> Maybe String
stUserDataDir)
  , (Text
"trace", Bool -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Bool -> Lua ()) -> (CommonState -> Bool) -> CommonState -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> Bool
stTrace)
  , (Text
"verbosity", String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (String -> Lua ())
-> (CommonState -> String) -> CommonState -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> String
forall a. Show a => a -> String
show (Verbosity -> String)
-> (CommonState -> Verbosity) -> CommonState -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> Verbosity
stVerbosity)
  ]

-- | Name used by Lua for the @CommonState@ type.
logMessageTypeName :: String
logMessageTypeName :: String
logMessageTypeName = String
"Pandoc LogMessage"

instance Peekable LogMessage where
  peek :: StackIndex -> Lua LogMessage
peek StackIndex
idx = String
-> (StackIndex -> Lua (Maybe LogMessage))
-> StackIndex
-> Lua LogMessage
forall a.
String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
reportValueOnFailure String
logMessageTypeName
             (StackIndex -> String -> Lua (Maybe LogMessage)
forall a. StackIndex -> String -> Lua (Maybe a)
`toAnyWithName` String
logMessageTypeName) StackIndex
idx

instance Pushable LogMessage where
  push :: LogMessage -> Lua ()
push LogMessage
msg = Lua () -> LogMessage -> Lua ()
forall a. Lua () -> a -> Lua ()
pushAnyWithMetatable Lua ()
pushLogMessageMetatable LogMessage
msg
   where
    pushLogMessageMetatable :: Lua ()
pushLogMessageMetatable = String -> Lua () -> Lua ()
ensureUserdataMetatable String
logMessageTypeName (Lua () -> Lua ()) -> Lua () -> Lua ()
forall a b. (a -> b) -> a -> b
$
      String -> (LogMessage -> Lua Text) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction String
"__tostring" LogMessage -> Lua Text
tostringLogMessage

tostringLogMessage :: LogMessage -> Lua Text.Text
tostringLogMessage :: LogMessage -> Lua Text
tostringLogMessage = Text -> Lua Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Lua Text)
-> (LogMessage -> Text) -> LogMessage -> Lua Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage -> Text
showLogMessage