1 files changed, 102 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Lua/Marshaling/CommonState.hs b/src/Text/Pandoc/Lua/Marshaling/CommonState.hs
new file mode 100644
index 000000000..eed1500ec
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Marshaling/CommonState.hs
@@ -0,0 +1,102 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE LambdaCase           #-}
+{-# LANGUAGE NoImplicitPrelude    #-}
+{- |
+   Module      : Text.Pandoc.Lua.Marshaling.CommonState
+   Copyright   : © 2012-2019 John MacFarlane
+                 © 2017-2019 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 Prelude
+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 Foreign.Lua as Lua
+import qualified Text.Pandoc.Lua.Util as LuaUtil
+
+-- | Name used by Lua for the @CommonState@ type.
+commonStateTypeName :: String
+commonStateTypeName = "Pandoc CommonState"
+
+instance Peekable CommonState where
+  peek idx = reportValueOnFailure commonStateTypeName
+             (`toAnyWithName` commonStateTypeName) idx
+
+instance Pushable CommonState where
+  push st = pushAnyWithMetatable pushCommonStateMetatable st
+   where
+    pushCommonStateMetatable = ensureUserdataMetatable commonStateTypeName $ do
+      LuaUtil.addFunction "__index" indexCommonState
+      LuaUtil.addFunction "__pairs" pairsCommonState
+
+indexCommonState :: CommonState -> AnyValue -> Lua Lua.NumResults
+indexCommonState st (AnyValue idx) = Lua.ltype idx >>= \case
+  Lua.TypeString -> 1 <$ (Lua.peek idx >>= pushField)
+  _ -> 1 <$ Lua.pushnil
+ where
+  pushField :: String -> Lua ()
+  pushField name = case lookup name commonStateFields of
+    Just pushValue -> pushValue st
+    Nothing -> Lua.pushnil
+
+pairsCommonState :: CommonState -> Lua Lua.NumResults
+pairsCommonState st = do
+  Lua.pushHaskellFunction nextFn
+  Lua.pushnil
+  Lua.pushnil
+  return 3
+ where
+  nextFn :: AnyValue -> AnyValue -> Lua Lua.NumResults
+  nextFn _ (AnyValue idx) =
+    Lua.ltype idx >>= \case
+      Lua.TypeNil -> case commonStateFields of
+        []  -> 2 <$ (Lua.pushnil *> Lua.pushnil)
+        (key, pushValue):_ -> 2 <$ (Lua.push key *> pushValue st)
+      Lua.TypeString -> do
+        key <- Lua.peek idx
+        case tail $ dropWhile ((/= key) . fst) commonStateFields of
+          []                     -> 2 <$ (Lua.pushnil *> Lua.pushnil)
+          (nextKey, pushValue):_ -> 2 <$ (Lua.push nextKey *> pushValue st)
+      _ -> 2 <$ (Lua.pushnil *> Lua.pushnil)
+
+commonStateFields :: [(String, CommonState -> Lua ())]
+commonStateFields =
+  [ ("input_files", Lua.push . stInputFiles)
+  , ("output_file", Lua.push . Lua.Optional . stOutputFile)
+  , ("log", Lua.push . stLog)
+  , ("request_headers", Lua.push . Map.fromList . stRequestHeaders)
+  , ("resource_path", Lua.push . stResourcePath)
+  , ("source_url", Lua.push . Lua.Optional . stSourceURL)
+  , ("user_data_dir", Lua.push . Lua.Optional . stUserDataDir)
+  , ("trace", Lua.push . stTrace)
+  , ("verbosity", Lua.push . show . stVerbosity)
+  ]
+
+-- | Name used by Lua for the @CommonState@ type.
+logMessageTypeName :: String
+logMessageTypeName = "Pandoc LogMessage"
+
+instance Peekable LogMessage where
+  peek idx = reportValueOnFailure logMessageTypeName
+             (`toAnyWithName` logMessageTypeName) idx
+
+instance Pushable LogMessage where
+  push msg = pushAnyWithMetatable pushLogMessageMetatable msg
+   where
+    pushLogMessageMetatable = ensureUserdataMetatable logMessageTypeName $
+      LuaUtil.addFunction "__tostring" tostringLogMessage
+
+tostringLogMessage :: LogMessage -> Lua String
+tostringLogMessage = return . showLogMessage