{-# 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 = "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 :: Text.Text -> 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 :: [(Text.Text, 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 Text.Text tostringLogMessage = return . showLogMessage