    {-# LANGUAGE LambdaCase           #-}
    {-# LANGUAGE OverloadedStrings    #-}
    {-# LANGUAGE TupleSections        #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}
    {- |
       Module      : Text.Pandoc.Lua.Marshaling.Format
       Copyright   : © 2022-2024 Albert Krewinkel
       License     : GPL-2.0-or-later
       Maintainer  : Albert Krewinkel <albert+pandoc@tarleb.com>

    Marshaling functions and instance for format related types, including
    'Extensions' and 'ExtensionConfig'.
    -}
    module Text.Pandoc.Lua.Marshal.Format
      ( peekExtensions
      , pushExtensions
      , peekExtensionsConfig
      , pushExtensionsConfig
      , peekFlavoredFormat
      ) where

    import Control.Applicative ((<|>))
    import Control.Monad ((<$!>))
    import Data.Maybe (fromMaybe)
    import HsLua
    import Text.Pandoc.Error (PandocError (..))
    import Text.Pandoc.Extensions
      ( Extension, Extensions, extensionsFromList, extensionsToList
      , getDefaultExtensions, readExtension, showExtension )
    import Text.Pandoc.Format
      ( ExtensionsConfig (..), ExtensionsDiff (..), FlavoredFormat (..)
      , diffExtensions, parseFlavoredFormat)
    import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua))

    -- | Retrieves a single 'Extension' from the Lua stack.
    peekExtension :: LuaError e => Peeker e Extension
    peekExtension :: forall e. LuaError e => Peeker e Extension
    peekExtension StackIndex
    idx = do
      extString <- Peeker e String
    forall e. Peeker e String
    peekString StackIndex
    idx
      return $ readExtension extString
    {-# INLINE peekExtension #-}

    -- | Pushes an individual 'Extension' to the Lua stack.
    pushExtension :: LuaError e => Pusher e Extension
    pushExtension :: forall e. LuaError e => Pusher e Extension
    pushExtension = Pusher e Text
    forall e. Pusher e Text
    pushText Pusher e Text -> (Extension -> Text) -> Extension -> LuaE e ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Extension -> Text
    showExtension
    {-# INLINE pushExtension #-}

    -- | Retrieves an 'Extensions' set from the Lua stack.
    peekExtensions :: LuaError e => Peeker e Extensions
    peekExtensions :: forall e. LuaError e => Peeker e Extensions
    peekExtensions = ([Extension] -> Extensions)
    -> Peek e [Extension] -> Peek e Extensions
    forall a b. (a -> b) -> Peek e a -> Peek e b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Extension] -> Extensions
    extensionsFromList (Peek e [Extension] -> Peek e Extensions)
    -> (StackIndex -> Peek e [Extension])
    -> StackIndex
    -> Peek e Extensions
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Peeker e Extension -> StackIndex -> Peek e [Extension]
    forall a e. LuaError e => Peeker e a -> Peeker e [a]
    peekList Peeker e Extension
    forall e. LuaError e => Peeker e Extension
    peekExtension
    {-# INLINE peekExtensions #-}

    -- | Pushes a set of 'Extensions' to the top of the Lua stack.
    pushExtensions :: LuaError e => Pusher e Extensions
    pushExtensions :: forall e. LuaError e => Pusher e Extensions
    pushExtensions = Pusher e Extensions
    forall a e. (ToJSON a, LuaError e) => Pusher e a
    pushViaJSON
    {-# INLINE pushExtensions #-}

    instance Peekable Extensions where
      safepeek :: forall e. LuaError e => Peeker e Extensions
    safepeek = Peeker e Extensions
    forall e. LuaError e => Peeker e Extensions
    peekExtensions

    instance Pushable Extensions where
      push :: forall e. LuaError e => Pusher e Extensions
    push = Pusher e Extensions
    forall e. LuaError e => Pusher e Extensions
    pushExtensions

    -- | Retrieves an 'ExtensionsConfig' value from the Lua stack.
    peekExtensionsConfig :: LuaError e => Peeker e ExtensionsConfig
    peekExtensionsConfig :: forall e. LuaError e => Peeker e ExtensionsConfig
    peekExtensionsConfig StackIndex
    idx = do
      diff <- Peeker e ExtensionsDiff
    forall e. LuaError e => Peeker e ExtensionsDiff
    peekExtensionsDiff StackIndex
    idx
      return $ ExtensionsConfig
        { extsDefault   = extsToEnable diff
        , extsSupported = extsToEnable diff <> extsToDisable diff
        }

    -- | Pushes an 'ExtensionsConfig' value as a table with that maps
    -- extensions to their default enabled/disabled status.
    pushExtensionsConfig :: LuaError e => Pusher e ExtensionsConfig
    pushExtensionsConfig :: forall e. LuaError e => Pusher e ExtensionsConfig
    pushExtensionsConfig (ExtensionsConfig Extensions
    def Extensions
    supported) =
      Pusher e Extension -> Pusher e Bool -> Pusher e [(Extension, Bool)]
    forall e a b.
    LuaError e =>
    Pusher e a -> Pusher e b -> Pusher e [(a, b)]
    pushKeyValuePairs Pusher e Extension
    forall e. LuaError e => Pusher e Extension
    pushExtension Pusher e Bool
    forall e. Pusher e Bool
    pushBool Pusher e [(Extension, Bool)] -> Pusher e [(Extension, Bool)]
    forall a b. (a -> b) -> a -> b
    $
        (Extension -> (Extension, Bool))
    -> [Extension] -> [(Extension, Bool)]
    forall a b. (a -> b) -> [a] -> [b]
    map (,Bool
    False) (Extensions -> [Extension]
    extensionsToList Extensions
    supported) [(Extension, Bool)] -> [(Extension, Bool)] -> [(Extension, Bool)]
    forall a. [a] -> [a] -> [a]
    ++
        (Extension -> (Extension, Bool))
    -> [Extension] -> [(Extension, Bool)]
    forall a b. (a -> b) -> [a] -> [b]
    map (,Bool
    True)  (Extensions -> [Extension]
    extensionsToList Extensions
    def)

    instance Peekable ExtensionsConfig where
      safepeek :: forall e. LuaError e => Peeker e ExtensionsConfig
    safepeek = Peeker e ExtensionsConfig
    forall e. LuaError e => Peeker e ExtensionsConfig
    peekExtensionsConfig

    peekExtensionsDiff :: LuaError e => Peeker e ExtensionsDiff
    peekExtensionsDiff :: forall e. LuaError e => Peeker e ExtensionsDiff
    peekExtensionsDiff = Name
    -> (StackIndex -> LuaE e Bool)
    -> Peeker e ExtensionsDiff
    -> Peeker e ExtensionsDiff
    forall e a.
    Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
    typeChecked Name
    "table" StackIndex -> LuaE e Bool
    forall e. StackIndex -> LuaE e Bool
    istable (Peeker e ExtensionsDiff -> Peeker e ExtensionsDiff)
    -> Peeker e ExtensionsDiff -> Peeker e ExtensionsDiff
    forall a b. (a -> b) -> a -> b
    $ \StackIndex
    idx ->
          (do
              en <- Peeker e (Maybe Extensions) -> Name -> Peeker e (Maybe Extensions)
    forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
    peekFieldRaw (Peeker e (Maybe Extensions) -> Peeker e (Maybe Extensions)
    forall a e. Monoid a => Peeker e a -> Peeker e a
    emptyOr ((Extensions -> Maybe Extensions)
    -> Peek e Extensions -> Peek e (Maybe Extensions)
    forall a b. (a -> b) -> Peek e a -> Peek e b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Extensions -> Maybe Extensions
    forall a. a -> Maybe a
    Just (Peek e Extensions -> Peek e (Maybe Extensions))
    -> (StackIndex -> Peek e Extensions) -> Peeker e (Maybe Extensions)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackIndex -> Peek e Extensions
    forall e. LuaError e => Peeker e Extensions
    peekExtensions)) Name
    "enable" StackIndex
    idx
              di <- peekFieldRaw (emptyOr (fmap Just . peekExtensions)) "disable" idx
              if (en, di) == (Nothing, Nothing)
                then failPeek "At least on of  'enable' and 'disable' must be set"
                else return $
                     ExtensionsDiff (fromMaybe mempty en) (fromMaybe mempty di))
      Peek e ExtensionsDiff
    -> Peek e ExtensionsDiff -> Peek e ExtensionsDiff
    forall a. Peek e a -> Peek e a -> Peek e a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> -- two lists of extensions; the first is list assumed to contain those
          -- extensions to be enabled
          ((Extensions -> Extensions -> ExtensionsDiff)
    -> (Extensions, Extensions) -> ExtensionsDiff
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Extensions -> Extensions -> ExtensionsDiff
    ExtensionsDiff ((Extensions, Extensions) -> ExtensionsDiff)
    -> Peek e (Extensions, Extensions) -> Peek e ExtensionsDiff
    forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    <$!> (StackIndex -> Peek e Extensions)
    -> (StackIndex -> Peek e Extensions)
    -> Peeker e (Extensions, Extensions)
    forall e a b.
    LuaError e =>
    Peeker e a -> Peeker e b -> Peeker e (a, b)
    peekPair StackIndex -> Peek e Extensions
    forall e. LuaError e => Peeker e Extensions
    peekExtensions StackIndex -> Peek e Extensions
    forall e. LuaError e => Peeker e Extensions
    peekExtensions StackIndex
    idx)
      Peek e ExtensionsDiff
    -> Peek e ExtensionsDiff -> Peek e ExtensionsDiff
    forall a. Peek e a -> Peek e a -> Peek e a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (do
              let
              exts <- Peeker e Extension -> Peeker e Bool -> Peeker e [(Extension, Bool)]
    forall e a b.
    LuaError e =>
    Peeker e a -> Peeker e b -> Peeker e [(a, b)]
    peekKeyValuePairs Peeker e Extension
    forall e. LuaError e => Peeker e Extension
    peekExtension Peeker e Bool
    forall e. LuaError e => Peeker e Bool
    peekEnabled StackIndex
    idx
              let enabled  = [Extension] -> Extensions
    extensionsFromList ([Extension] -> Extensions)
    -> ([(Extension, Bool)] -> [Extension])
    -> [(Extension, Bool)]
    -> Extensions
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Extension, Bool) -> Extension)
    -> [(Extension, Bool)] -> [Extension]
    forall a b. (a -> b) -> [a] -> [b]
    map (Extension, Bool) -> Extension
    forall a b. (a, b) -> a
    fst ([(Extension, Bool)] -> Extensions)
    -> [(Extension, Bool)] -> Extensions
    forall a b. (a -> b) -> a -> b
    $ ((Extension, Bool) -> Bool)
    -> [(Extension, Bool)] -> [(Extension, Bool)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Extension, Bool) -> Bool
    forall a b. (a, b) -> b
    snd [(Extension, Bool)]
    exts
              let disabled = [Extension] -> Extensions
    extensionsFromList ([Extension] -> Extensions)
    -> ([(Extension, Bool)] -> [Extension])
    -> [(Extension, Bool)]
    -> Extensions
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Extension, Bool) -> Extension)
    -> [(Extension, Bool)] -> [Extension]
    forall a b. (a -> b) -> [a] -> [b]
    map (Extension, Bool) -> Extension
    forall a b. (a, b) -> a
    fst ([(Extension, Bool)] -> Extensions)
    -> [(Extension, Bool)] -> Extensions
    forall a b. (a -> b) -> a -> b
    $ ((Extension, Bool) -> Bool)
    -> [(Extension, Bool)] -> [(Extension, Bool)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((Extension, Bool) -> Bool) -> (Extension, Bool) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Extension, Bool) -> Bool
    forall a b. (a, b) -> b
    snd) [(Extension, Bool)]
    exts
              return $ ExtensionsDiff enabled disabled)

    -- | Retrieves the activation status of an extension. True or the string
    -- @'enable'@ for activated, False or 'disable' for disabled.
    peekEnabled :: LuaError e => Peeker e Bool
    peekEnabled :: forall e. LuaError e => Peeker e Bool
    peekEnabled StackIndex
    idx' = LuaE e Type -> Peek e Type
    forall e a. LuaE e a -> Peek e a
    liftLua (StackIndex -> LuaE e Type
    forall e. StackIndex -> LuaE e Type
    ltype StackIndex
    idx') Peek e Type -> (Type -> Peek e Bool) -> Peek e Bool
    forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
      Type
    TypeBoolean -> Peeker e Bool
    forall e. Peeker e Bool
    peekBool StackIndex
    idx'
      Type
    TypeString  -> Peeker e Text
    forall e. Peeker e Text
    peekText StackIndex
    idx' Peek e Text -> (Text -> Peek e Bool) -> Peek e Bool
    forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                       Text
    "disable" -> Bool -> Peek e Bool
    forall a. a -> Peek e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
                       Text
    "enable"  -> Bool -> Peek e Bool
    forall a. a -> Peek e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
                       Text
    _         -> ByteString -> Peek e Bool
    forall a e. ByteString -> Peek e a
    failPeek ByteString
    "expected 'disable' or 'enable'"
      Type
    _ -> ByteString -> Peek e Bool
    forall a e. ByteString -> Peek e a
    failPeek ByteString
    "expected boolean or string"

    -- | Retrieves a flavored format from the Lua stack.
    peekFlavoredFormat :: Peeker PandocError FlavoredFormat
    peekFlavoredFormat :: Peeker PandocError FlavoredFormat
    peekFlavoredFormat StackIndex
    idx = Name
    -> Peek PandocError FlavoredFormat
    -> Peek PandocError FlavoredFormat
    forall e a. Name -> Peek e a -> Peek e a
    retrieving Name
    "flavored format" (Peek PandocError FlavoredFormat
     -> Peek PandocError FlavoredFormat)
    -> Peek PandocError FlavoredFormat
    -> Peek PandocError FlavoredFormat
    forall a b. (a -> b) -> a -> b
    $
      LuaE PandocError Type -> Peek PandocError Type
    forall e a. LuaE e a -> Peek e a
    liftLua (StackIndex -> LuaE PandocError Type
    forall e. StackIndex -> LuaE e Type
    ltype StackIndex
    idx) Peek PandocError Type
    -> (Type -> Peek PandocError FlavoredFormat)
    -> Peek PandocError FlavoredFormat
    forall a b.
    Peek PandocError a
    -> (a -> Peek PandocError b) -> Peek PandocError b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
      Type
    TypeString -> Peeker PandocError Text
    forall e. Peeker e Text
    peekText StackIndex
    idx Peek PandocError Text
    -> (Text -> Peek PandocError FlavoredFormat)
    -> Peek PandocError FlavoredFormat
    forall a b.
    Peek PandocError a
    -> (a -> Peek PandocError b) -> Peek PandocError b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= LuaE PandocError FlavoredFormat -> Peek PandocError FlavoredFormat
    forall e a. LuaE e a -> Peek e a
    liftLua (LuaE PandocError FlavoredFormat
     -> Peek PandocError FlavoredFormat)
    -> (Text -> LuaE PandocError FlavoredFormat)
    -> Text
    -> Peek PandocError FlavoredFormat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PandocLua FlavoredFormat -> LuaE PandocError FlavoredFormat
    forall a. PandocLua a -> LuaE PandocError a
    unPandocLua (PandocLua FlavoredFormat -> LuaE PandocError FlavoredFormat)
    -> (Text -> PandocLua FlavoredFormat)
    -> Text
    -> LuaE PandocError FlavoredFormat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> PandocLua FlavoredFormat
    forall (m :: * -> *). PandocMonad m => Text -> m FlavoredFormat
    parseFlavoredFormat
      Type
    TypeTable -> do
        let diffFor :: Text -> StackIndex -> Peek e ExtensionsDiff
    diffFor Text
    format StackIndex
    idx' = StackIndex -> Peek e ExtensionsDiff
    forall e. LuaError e => Peeker e ExtensionsDiff
    peekExtensionsDiff StackIndex
    idx' Peek e ExtensionsDiff
    -> Peek e ExtensionsDiff -> Peek e ExtensionsDiff
    forall a. Peek e a -> Peek e a -> Peek e a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
              (Text -> Extensions
    getDefaultExtensions Text
    format Extensions -> Extensions -> ExtensionsDiff
    `diffExtensions`) (Extensions -> ExtensionsDiff)
    -> Peek e Extensions -> Peek e ExtensionsDiff
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
              (Name
    -> (StackIndex -> LuaE e Bool)
    -> Peeker e Extensions
    -> Peeker e Extensions
    forall e a.
    Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
    typeChecked Name
    "table" StackIndex -> LuaE e Bool
    forall e. StackIndex -> LuaE e Bool
    istable Peeker e Extensions
    forall e. LuaError e => Peeker e Extensions
    peekExtensions StackIndex
    idx')
        format   <- Peeker PandocError Text -> Name -> Peeker PandocError Text
    forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
    peekFieldRaw Peeker PandocError Text
    forall e. Peeker e Text
    peekText Name
    "format" StackIndex
    idx
        extsDiff <- peekFieldRaw (emptyOr (diffFor format)) "extensions" idx
        return (FlavoredFormat format extsDiff)
      Type
    _ -> ByteString -> Peek PandocError FlavoredFormat
    forall a e. ByteString -> Peek e a
    failPeek (ByteString -> Peek PandocError FlavoredFormat)
    -> Peek PandocError ByteString -> Peek PandocError FlavoredFormat
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Name -> StackIndex -> Peek PandocError ByteString
    forall e. Name -> StackIndex -> Peek e ByteString
    typeMismatchMessage Name
    "string or table" StackIndex
    idx

    -- | Returns 'mempty' if the given stack index is @nil@, and the result
    -- of the peeker otherwise.
    emptyOr :: Monoid a => Peeker e a -> Peeker e a
    emptyOr :: forall a e. Monoid a => Peeker e a -> Peeker e a
    emptyOr Peeker e a
    p StackIndex
    idx = do
      nil <- LuaE e Bool -> Peek e Bool
    forall e a. LuaE e a -> Peek e a
    liftLua (StackIndex -> LuaE e Bool
    forall e. StackIndex -> LuaE e Bool
    isnil StackIndex
    idx)
      if nil
        then pure mempty
        else p idx