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

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
  String
extString <- forall e. Peeker e String
peekString StackIndex
idx
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Extension
readExtension String
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 = forall e. Pusher e Text
pushText 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Extension] -> Extensions
extensionsFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList 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 = 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 = forall e. LuaError e => Peeker e Extensions
peekExtensions

instance Pushable Extensions where
  push :: forall e. LuaError e => Pusher e Extensions
push = 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
  ExtensionsDiff
diff <- forall e. LuaError e => Peeker e ExtensionsDiff
peekExtensionsDiff StackIndex
idx
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ExtensionsConfig
    { extsDefault :: Extensions
extsDefault   = ExtensionsDiff -> Extensions
extsToEnable ExtensionsDiff
diff
    , extsSupported :: Extensions
extsSupported = ExtensionsDiff -> Extensions
extsToEnable ExtensionsDiff
diff forall a. Semigroup a => a -> a -> a
<> ExtensionsDiff -> Extensions
extsToDisable ExtensionsDiff
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) =
  forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e [(a, b)]
pushKeyValuePairs forall e. LuaError e => Pusher e Extension
pushExtension forall e. Pusher e Bool
pushBool forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (,Bool
False) (Extensions -> [Extension]
extensionsToList Extensions
supported) forall a. [a] -> [a] -> [a]
++
    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 = forall e. LuaError e => Peeker e ExtensionsConfig
peekExtensionsConfig

peekExtensionsDiff :: LuaError e => Peeker e ExtensionsDiff
peekExtensionsDiff :: forall e. LuaError e => Peeker e ExtensionsDiff
peekExtensionsDiff = forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" forall e. StackIndex -> LuaE e Bool
istable forall a b. (a -> b) -> a -> b
$ \StackIndex
idx ->
      (do
          Maybe Extensions
en <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (forall a e. Monoid a => Peeker e a -> Peeker e a
emptyOr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Extensions
peekExtensions)) Name
"enable" StackIndex
idx
          Maybe Extensions
di <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (forall a e. Monoid a => Peeker e a -> Peeker e a
emptyOr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Extensions
peekExtensions)) Name
"disable" StackIndex
idx
          if (Maybe Extensions
en, Maybe Extensions
di) forall a. Eq a => a -> a -> Bool
== (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
            then forall a e. ByteString -> Peek e a
failPeek ByteString
"At least on of  'enable' and 'disable' must be set"
            else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                 Extensions -> Extensions -> ExtensionsDiff
ExtensionsDiff (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe Extensions
en) (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe Extensions
di))
  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
      (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Extensions -> Extensions -> ExtensionsDiff
ExtensionsDiff forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair forall e. LuaError e => Peeker e Extensions
peekExtensions forall e. LuaError e => Peeker e Extensions
peekExtensions StackIndex
idx)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
          let
          [(Extension, Bool)]
exts <- forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs forall e. LuaError e => Peeker e Extension
peekExtension forall e. LuaError e => Peeker e Bool
peekEnabled StackIndex
idx
          let enabled :: Extensions
enabled  = [Extension] -> Extensions
extensionsFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a, b) -> b
snd [(Extension, Bool)]
exts
          let disabled :: Extensions
disabled = [Extension] -> Extensions
extensionsFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Extension, Bool)]
exts
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Extensions -> Extensions -> ExtensionsDiff
ExtensionsDiff Extensions
enabled Extensions
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' = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeBoolean -> forall e. Peeker e Bool
peekBool StackIndex
idx'
  Type
TypeString  -> forall e. Peeker e Text
peekText StackIndex
idx' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                   Text
"disable" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                   Text
"enable"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
                   Text
_         -> forall a e. ByteString -> Peek e a
failPeek ByteString
"expected 'disable' or 'enable'"
  Type
_ -> 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 = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"flavored format" forall a b. (a -> b) -> a -> b
$
  forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeString -> forall e. Peeker e Text
peekText StackIndex
idx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e a. LuaE e a -> Peek e a
liftLua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PandocLua a -> LuaE PandocError a
unPandocLua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => Text -> m FlavoredFormat
parseFlavoredFormat
  Type
TypeTable -> do
    let diffFor :: Text -> StackIndex -> Peek e ExtensionsDiff
diffFor Text
format StackIndex
idx' = forall e. LuaError e => Peeker e ExtensionsDiff
peekExtensionsDiff StackIndex
idx' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          (Text -> Extensions
getDefaultExtensions Text
format Extensions -> Extensions -> ExtensionsDiff
`diffExtensions`) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          (forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" forall e. StackIndex -> LuaE e Bool
istable forall e. LuaError e => Peeker e Extensions
peekExtensions StackIndex
idx')
    Text
format   <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. Peeker e Text
peekText Name
"format" StackIndex
idx
    ExtensionsDiff
extsDiff <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (forall a e. Monoid a => Peeker e a -> Peeker e a
emptyOr (forall {e}.
LuaError e =>
Text -> StackIndex -> Peek e ExtensionsDiff
diffFor Text
format)) Name
"extensions" StackIndex
idx
    forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExtensionsDiff -> FlavoredFormat
FlavoredFormat Text
format ExtensionsDiff
extsDiff)
  Type
_ -> forall a e. ByteString -> Peek e a
failPeek forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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
  Bool
nil <- forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Bool
isnil StackIndex
idx)
  if Bool
nil
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    else Peeker e a
p StackIndex
idx