{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TupleSections        #-}
{-# LANGUAGE TypeApplications     #-}
{- |
Module      : Text.Pandoc.Lua.Marshal.Attr
Copyright   : © 2017-2021 Albert Krewinkel, John MacFarlane
License     : MIT

Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Helpers to make pandoc's Attr elements usable in Lua, and to get objects
back into Haskell.
-}
module Text.Pandoc.Lua.Marshal.Attr
  ( typeAttr
  , peekAttr
  , pushAttr
  , typeAttributeList
  , pushAttributeList
  , peekAttributeList
  , mkAttr
  , mkAttributeList
  ) where

import Control.Applicative ((<|>), optional)
import Control.Monad ((<$!>))
import Data.Aeson (encode)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import HsLua
import HsLua.Marshalling.Peekers (peekIndexRaw)
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
import Safe (atMay)
import Text.Pandoc.Definition (Attr, nullAttr)

import qualified Data.Text as T

-- | Attr object type.
typeAttr :: LuaError e => DocumentedType e Attr
typeAttr :: forall e. LuaError e => DocumentedType e Attr
typeAttr = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Attr"
  [ forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Attr
peekAttr) TypeSpec
"a" Text
"Attr" Text
""
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Attr
peekAttr) TypeSpec
"b" Text
"Attr" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. Pusher e Bool
pushBool TypeSpec
"boolean" Text
"whether the two are equal"
  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Attr
peekAttr TypeSpec
"Attr" Text
"attr" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. String -> LuaE e ()
pushString TypeSpec
"string" Text
"native Haskell representation"
  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation (Name -> Operation
CustomOperation Name
"__tojson") forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure encode
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e Attr
typeAttr Text
"self" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. Pusher e ByteString
pushLazyByteString TypeSpec
"string" Text
"JSON representation"
  ]
  [ forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"identifier" Text
"element identifier"
      (forall e. Pusher e Text
pushText, \(Text
ident,[Text]
_,[(Text, Text)]
_) -> Text
ident)
      (forall e. Peeker e Text
peekText, \(Text
_,[Text]
cls,[(Text, Text)]
kv) -> (,[Text]
cls,[(Text, Text)]
kv))
  , forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"classes" Text
"element classes"
      (forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList forall e. Pusher e Text
pushText, \(Text
_,[Text]
classes,[(Text, Text)]
_) -> [Text]
classes)
      (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. Peeker e Text
peekText, \(Text
ident,[Text]
_,[(Text, Text)]
kv) -> (Text
ident,,[(Text, Text)]
kv))
  , forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"attributes" Text
"various element attributes"
      (forall e. LuaError e => Pusher e [(Text, Text)]
pushAttributeList, \(Text
_,[Text]
_,[(Text, Text)]
attribs) -> [(Text, Text)]
attribs)
      (forall e. LuaError e => Peeker e [(Text, Text)]
peekAttributeList, \(Text
ident,[Text]
cls,[(Text, Text)]
_) -> (Text
ident,[Text]
cls,))
  , forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"clone"
    ### return
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Attr
peekAttr TypeSpec
"attr" Text
"Attr" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Attr
pushAttr TypeSpec
"Attr" Text
"new Attr element"
  , forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"tag" Text
"element type tag (always 'Attr')"
      (forall e. Pusher e Text
pushText, forall a b. a -> b -> a
const Text
"Attr")

  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"t" Text
"alias for `tag`" [AliasIndex
"tag"]
  ]

-- | Pushes an 'Attr' value as @Attr@ userdata object.
pushAttr :: LuaError e => Pusher e Attr
pushAttr :: forall e. LuaError e => Pusher e Attr
pushAttr = forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e Attr
typeAttr

-- | Retrieves an associated list of attributes from a table or an
-- @AttributeList@ userdata object.
peekAttributeList :: LuaError e => Peeker e [(Text,Text)]
peekAttributeList :: forall e. LuaError e => Peeker e [(Text, Text)]
peekAttributeList 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
TypeUserdata -> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList StackIndex
idx
  Type
TypeTable    -> forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Int
rawlen StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Int
0 -> forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs forall e. Peeker e Text
peekText forall e. Peeker e Text
peekText StackIndex
idx
    Int
_ -> forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList (forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair forall e. Peeker e Text
peekText forall e. Peeker e Text
peekText) StackIndex
idx
  Type
_            -> forall a e. ByteString -> Peek e a
failPeek ByteString
"unsupported type"

-- | Pushes an associated list of attributes as @AttributeList@ userdata
-- object.
pushAttributeList :: LuaError e => Pusher e [(Text, Text)]
pushAttributeList :: forall e. LuaError e => Pusher e [(Text, Text)]
pushAttributeList = forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList

-- | Constructor functions for 'AttributeList' elements.
typeAttributeList :: LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList :: forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"AttributeList"
  [ forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure2 (\a b -> Just True == ((==) <$> a <*> b))
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e [(Text, Text)]
peekAttributeList) TypeSpec
"a" Text
"any" Text
""
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e [(Text, Text)]
peekAttributeList) TypeSpec
"b" Text
"any" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. Pusher e Bool
pushBool TypeSpec
"boolean" Text
"whether the two are equal"

  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Index forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure2 lookupKey
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList Text
"t" Text
"attributes list"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. Peeker e (Maybe Key)
peekKey TypeSpec
"string|integer" Text
"key" Text
"lookup key"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e. LuaE e ()
pushnil forall e. LuaError e => Pusher e Attribute
pushAttribute) TypeSpec
"string|table"
          Text
"attribute value"

  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Newindex forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### setKey
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList Text
"t" Text
"attributes list"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. Peeker e (Maybe Key)
peekKey TypeSpec
"string|integer" Text
"key" Text
"lookup key"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Attribute
peekAttribute TypeSpec
"string|nil" Text
"value" Text
"new value")
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []

  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Len forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure length
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList Text
"t" Text
"attributes list"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral TypeSpec
"integer" Text
"number of attributes in list"

  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Pairs forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### pushIterator (\(k, v) -> 2 <$ pushText k <* pushText v)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList Text
"t" Text
"attributes list"
    forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"iterator triple"

  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList Text
"t" Text
"attributes list"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. String -> LuaE e ()
pushString TypeSpec
"string" Text
""
  ]
  []

data Key = StringKey Text | IntKey Int

peekKey :: Peeker e (Maybe Key)
peekKey :: forall e. Peeker e (Maybe Key)
peekKey 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
TypeNumber -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Key
IntKey forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a e. (Integral a, Read a) => Peeker e a
peekIntegral StackIndex
idx
  Type
TypeString -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Key
StringKey forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. Peeker e Text
peekText StackIndex
idx
  Type
_          -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

data Attribute
  = AttributePair (Text, Text)
  | AttributeValue Text

pushAttribute :: LuaError e => Pusher e Attribute
pushAttribute :: forall e. LuaError e => Pusher e Attribute
pushAttribute = \case
  (AttributePair (Text, Text)
kv) -> forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair forall e. Pusher e Text
pushText forall e. Pusher e Text
pushText (Text, Text)
kv
  (AttributeValue Text
v) -> forall e. Pusher e Text
pushText Text
v

-- | Retrieve an 'Attribute'.
peekAttribute :: LuaError e => Peeker e Attribute
peekAttribute :: forall e. LuaError e => Peeker e Attribute
peekAttribute StackIndex
idx = (Text -> Attribute
AttributeValue forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. Peeker e Text
peekText StackIndex
idx)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Text, Text) -> Attribute
AttributePair 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. Peeker e Text
peekText forall e. Peeker e Text
peekText StackIndex
idx)

lookupKey :: [(Text,Text)] -> Maybe Key -> Maybe Attribute
lookupKey :: [(Text, Text)] -> Maybe Key -> Maybe Attribute
lookupKey ![(Text, Text)]
kvs = \case
  Just (StringKey Text
str) -> Text -> Attribute
AttributeValue forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
str [(Text, Text)]
kvs
  Just (IntKey Int
n)      -> (Text, Text) -> Attribute
AttributePair forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a. [a] -> Int -> Maybe a
atMay [(Text, Text)]
kvs (Int
n forall a. Num a => a -> a -> a
- Int
1)
  Maybe Key
Nothing              -> forall a. Maybe a
Nothing

setKey :: forall e. LuaError e
       => [(Text, Text)] -> Maybe Key -> Maybe Attribute
       -> LuaE e ()
setKey :: forall e.
LuaError e =>
[(Text, Text)] -> Maybe Key -> Maybe Attribute -> LuaE e ()
setKey [(Text, Text)]
kvs Maybe Key
mbKey Maybe Attribute
mbValue = case Maybe Key
mbKey of
  Just (StringKey Text
str) ->
    case forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((forall a. Eq a => a -> a -> Bool
== Text
str) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, Text)]
kvs of
      ([(Text, Text)]
prefix, (Text, Text)
_:[(Text, Text)]
suffix) -> case Maybe Attribute
mbValue of
        Maybe Attribute
Nothing -> [(Text, Text)] -> LuaE e ()
setNew forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
prefix forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
suffix
        Just (AttributeValue Text
value) -> [(Text, Text)] -> LuaE e ()
setNew forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
prefix forall a. [a] -> [a] -> [a]
++ (Text
str, Text
value)forall a. a -> [a] -> [a]
:[(Text, Text)]
suffix
        Maybe Attribute
_ -> forall e a. LuaError e => String -> LuaE e a
failLua String
"invalid attribute value"
      ([(Text, Text)], [(Text, Text)])
_  -> case Maybe Attribute
mbValue of
        Maybe Attribute
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (AttributeValue Text
value) -> [(Text, Text)] -> LuaE e ()
setNew ([(Text, Text)]
kvs forall a. [a] -> [a] -> [a]
++ [(Text
str, Text
value)])
        Maybe Attribute
_ -> forall e a. LuaError e => String -> LuaE e a
failLua String
"invalid attribute value"
  Just (IntKey Int
idx) ->
    case forall a. Int -> [a] -> ([a], [a])
splitAt (Int
idx forall a. Num a => a -> a -> a
- Int
1) [(Text, Text)]
kvs of
      ([(Text, Text)]
prefix, (Text
k,Text
_):[(Text, Text)]
suffix) -> [(Text, Text)] -> LuaE e ()
setNew forall a b. (a -> b) -> a -> b
$ case Maybe Attribute
mbValue of
        Maybe Attribute
Nothing -> [(Text, Text)]
prefix forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
suffix
        Just (AttributePair (Text, Text)
kv) -> [(Text, Text)]
prefix forall a. [a] -> [a] -> [a]
++ (Text, Text)
kv forall a. a -> [a] -> [a]
: [(Text, Text)]
suffix
        Just (AttributeValue Text
v) -> [(Text, Text)]
prefix forall a. [a] -> [a] -> [a]
++ (Text
k, Text
v) forall a. a -> [a] -> [a]
: [(Text, Text)]
suffix
      ([(Text, Text)]
prefix, []) -> case Maybe Attribute
mbValue of
        Maybe Attribute
Nothing -> [(Text, Text)] -> LuaE e ()
setNew [(Text, Text)]
prefix
        Just (AttributePair (Text, Text)
kv) -> [(Text, Text)] -> LuaE e ()
setNew forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
prefix forall a. [a] -> [a] -> [a]
++ [(Text, Text)
kv]
        Maybe Attribute
_ -> forall e a. LuaError e => String -> LuaE e a
failLua forall a b. (a -> b) -> a -> b
$ String
"trying to set an attribute key-value pair, "
             forall a. [a] -> [a] -> [a]
++ String
"but got a single string instead."

  Maybe Key
_  -> forall e a. LuaError e => String -> LuaE e a
failLua String
"invalid attribute key"
  where
    setNew :: [(Text, Text)] -> LuaE e ()
    setNew :: [(Text, Text)] -> LuaE e ()
setNew [(Text, Text)]
new =
      forall a e. StackIndex -> Name -> a -> LuaE e Bool
putuserdata (CInt -> StackIndex
nthBottom CInt
1) (forall e fn a itemtype. UDTypeWithList e fn a itemtype -> Name
udName @e forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList) [(Text, Text)]
new forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Bool
False -> forall e a. LuaError e => String -> LuaE e a
failLua String
"failed to modify attributes list"

-- | Retrieves an 'Attr' value from a string, a table, or an @Attr@
-- userdata object. A string is used as an identifier; a table is either
-- an HTML-like set of attributes, or a triple containing the
-- identifier, classes, and attributes.
peekAttr :: LuaError e => Peeker e Attr
peekAttr :: forall e. LuaError e => Peeker e Attr
peekAttr StackIndex
idx = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Attr" 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 (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. Peeker e Text
peekText StackIndex
idx -- treat string as ID
  Type
TypeUserdata -> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e Attr
typeAttr StackIndex
idx
  Type
TypeTable -> forall e. LuaError e => Peeker e Attr
peekAttrTable StackIndex
idx
  Type
x -> forall e a. LuaE e a -> Peek e a
liftLua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. LuaError e => String -> LuaE e a
failLua forall a b. (a -> b) -> a -> b
$ String
"Cannot get Attr from " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Type
x

-- | Helper function which gets an Attr from a Lua table.
peekAttrTable :: LuaError e => Peeker e Attr
peekAttrTable :: forall e. LuaError e => Peeker e Attr
peekAttrTable StackIndex
idx = do
  Int
len' <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. StackIndex -> LuaE e Int
rawlen StackIndex
idx
  let peekClasses :: Peeker e [Text]
peekClasses = forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. Peeker e Text
peekText
  if Int
len' forall a. Ord a => a -> a -> Bool
> Int
0
    then do
      Text
ident <- forall e a. LuaError e => Integer -> Peeker e a -> Peeker e a
peekIndexRaw Integer
1 forall e. Peeker e Text
peekText StackIndex
idx
      [Text]
classes <- forall a. a -> Maybe a -> a
fromMaybe [] forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e a. LuaError e => Integer -> Peeker e a -> Peeker e a
peekIndexRaw Integer
2 Peeker e [Text]
peekClasses StackIndex
idx)
      [(Text, Text)]
attribs <- forall a. a -> Maybe a -> a
fromMaybe [] forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e a. LuaError e => Integer -> Peeker e a -> Peeker e a
peekIndexRaw Integer
3 forall e. LuaError e => Peeker e [(Text, Text)]
peekAttributeList StackIndex
idx)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
ident seq :: forall a b. a -> b -> b
`seq` [Text]
classes seq :: forall a b. a -> b -> b
`seq` [(Text, Text)]
attribs seq :: forall a b. a -> b -> b
`seq`
        (Text
ident, [Text]
classes, [(Text, Text)]
attribs)
    else forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"HTML-like attributes" forall a b. (a -> b) -> a -> b
$ do
      [(Text, Text)]
kvs <- forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs forall e. Peeker e Text
peekText forall e. Peeker e Text
peekText StackIndex
idx
      let ident :: Text
ident = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [(Text, Text)]
kvs
      let classes :: [Text]
classes = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [(Text, Text)]
kvs
      let attribs :: [(Text, Text)]
attribs = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"id", Text
"class"]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, Text)]
kvs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
ident seq :: forall a b. a -> b -> b
`seq` [Text]
classes seq :: forall a b. a -> b -> b
`seq` [(Text, Text)]
attribs seq :: forall a b. a -> b -> b
`seq`
        (Text
ident, [Text]
classes, [(Text, Text)]
attribs)

-- | Constructor for 'Attr'.
mkAttr :: LuaError e => DocumentedFunction e
mkAttr :: forall e. LuaError e => DocumentedFunction e
mkAttr = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Attr"
  ### (ltype (nthBottom 1) >>= \case
          TypeString -> forcePeek $ do
            mident <- optional (peekText (nthBottom 1))
            mclass <- optional (peekList peekText (nthBottom 2))
            mattribs <- optional (peekAttributeList (nthBottom 3))
            return ( fromMaybe "" mident
                   , fromMaybe [] mclass
                   , fromMaybe [] mattribs)
          TypeTable  -> forcePeek $ peekAttrTable (nthBottom 1)
          TypeUserdata -> forcePeek $ peekUD typeAttr (nthBottom 1) <|> do
            attrList <- peekUD typeAttributeList (nthBottom 1)
            return ("", [], attrList)
          TypeNil    -> pure nullAttr
          TypeNone   -> pure nullAttr
          x          -> failLua $ "Cannot create Attr from " ++ show x)
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Attr
pushAttr TypeSpec
"Attr" Text
"new Attr object"

-- | Constructor for 'AttributeList'.
mkAttributeList :: LuaError e => DocumentedFunction e
mkAttributeList :: forall e. LuaError e => DocumentedFunction e
mkAttributeList = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"AttributeList"
  ### return
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [(Text, Text)]
peekAttributeList TypeSpec
"table|AttributeList" Text
"attribs"
        Text
"an attribute list"
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList) TypeSpec
"AttributeList"
        Text
"new AttributeList object"