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

  , AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) 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 = DocumentedTypeWithList e Attr Void -> Attr -> LuaE e ()
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD DocumentedTypeWithList e Attr Void
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 = 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 [(Text, Text)]) -> Peek e [(Text, Text)]
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
TypeUserdata -> DocumentedTypeWithList e [(Text, Text)] Void
-> Peeker e [(Text, Text)]
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD DocumentedTypeWithList e [(Text, Text)] Void
forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList StackIndex
idx
  Type
TypeTable    -> LuaE e Int -> Peek e Int
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Int
forall e. StackIndex -> LuaE e Int
rawlen StackIndex
idx) Peek e Int
-> (Int -> Peek e [(Text, Text)]) -> Peek e [(Text, Text)]
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
    Int
0 -> Peeker e Text -> Peeker e Text -> Peeker e [(Text, Text)]
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs Peeker e Text
forall e. Peeker e Text
peekText Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx
    Int
_ -> Peeker e (Text, Text) -> Peeker e [(Text, Text)]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList (Peeker e Text -> Peeker e Text -> Peeker e (Text, Text)
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Text
forall e. Peeker e Text
peekText Peeker e Text
forall e. Peeker e Text
peekText) StackIndex
idx
  Type
_            -> ByteString -> Peek e [(Text, Text)]
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 = DocumentedTypeWithList e [(Text, Text)] Void
-> [(Text, Text)] -> LuaE e ()
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD DocumentedTypeWithList e [(Text, Text)] Void
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 = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) [(Text, Text)]]
-> DocumentedType e [(Text, Text)]
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"AttributeList"
  [ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Maybe [(Text, Text)] -> Maybe [(Text, Text)] -> LuaE e Bool)
-> HsFnPrecursor
     e (Maybe [(Text, Text)] -> Maybe [(Text, Text)] -> LuaE e Bool)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure2 (\a b -> Just True == ((==) <$> a <*> b))
    HsFnPrecursor
  e (Maybe [(Text, Text)] -> Maybe [(Text, Text)] -> LuaE e Bool)
-> Parameter e (Maybe [(Text, Text)])
-> HsFnPrecursor e (Maybe [(Text, Text)] -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe [(Text, Text)])
-> TypeSpec -> Text -> Text -> Parameter e (Maybe [(Text, Text)])
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peek e [(Text, Text)] -> Peek e (Maybe [(Text, Text)])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e [(Text, Text)] -> Peek e (Maybe [(Text, Text)]))
-> (StackIndex -> Peek e [(Text, Text)])
-> Peeker e (Maybe [(Text, Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e [(Text, Text)]
forall e. LuaError e => Peeker e [(Text, Text)]
peekAttributeList) TypeSpec
"a" Text
"any" Text
""
    HsFnPrecursor e (Maybe [(Text, Text)] -> LuaE e Bool)
-> Parameter e (Maybe [(Text, Text)])
-> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe [(Text, Text)])
-> TypeSpec -> Text -> Text -> Parameter e (Maybe [(Text, Text)])
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peek e [(Text, Text)] -> Peek e (Maybe [(Text, Text)])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e [(Text, Text)] -> Peek e (Maybe [(Text, Text)]))
-> (StackIndex -> Peek e [(Text, Text)])
-> Peeker e (Maybe [(Text, Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e [(Text, Text)]
forall e. LuaError e => Peeker e [(Text, Text)]
peekAttributeList) TypeSpec
"b" Text
"any" Text
""
    HsFnPrecursor e (LuaE e Bool)
-> FunctionResults e Bool -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Bool -> TypeSpec -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool TypeSpec
"boolean" Text
"whether the two are equal"

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

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

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

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

  , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ ([(Text, Text)] -> LuaE e String)
-> HsFnPrecursor e ([(Text, Text)] -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    HsFnPrecursor e ([(Text, Text)] -> LuaE e String)
-> Parameter e [(Text, Text)] -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedType e [(Text, Text)]
-> Text -> Text -> Parameter e [(Text, Text)]
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e [(Text, Text)]
forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList Text
"t" Text
"attributes list"
    HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e String -> TypeSpec -> Text -> FunctionResults e String
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e String
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 = 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 (Maybe Key)) -> Peek e (Maybe Key)
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
TypeNumber -> Key -> Maybe Key
forall a. a -> Maybe a
Just (Key -> Maybe Key) -> (Int -> Key) -> Int -> Maybe Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Key
IntKey (Int -> Maybe Key) -> Peek e Int -> Peek e (Maybe Key)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral StackIndex
idx
  Type
TypeString -> Key -> Maybe Key
forall a. a -> Maybe a
Just (Key -> Maybe Key) -> (Text -> Key) -> Text -> Maybe Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Key
StringKey (Text -> Maybe Key) -> Peek e Text -> Peek e (Maybe Key)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx
  Type
_          -> Maybe Key -> Peek e (Maybe Key)
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Key
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) -> Pusher e Text -> Pusher e Text -> (Text, Text) -> LuaE e ()
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text
forall e. Pusher e Text
pushText (Text, Text)
kv
  (AttributeValue Text
v) -> Pusher e Text
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 (Text -> Attribute) -> Peek e Text -> Peek e Attribute
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx)
  Peek e Attribute -> Peek e Attribute -> Peek e Attribute
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Text, Text) -> Attribute
AttributePair ((Text, Text) -> Attribute)
-> Peek e (Text, Text) -> Peek e Attribute
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text -> Peeker e Text -> Peeker e (Text, Text)
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Text
forall e. Peeker e Text
peekText Peeker e Text
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 (Text -> Attribute) -> Maybe Text -> Maybe Attribute
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
str [(Text, Text)]
kvs
  Just (IntKey Int
n)      -> (Text, Text) -> Attribute
AttributePair ((Text, Text) -> Attribute)
-> Maybe (Text, Text) -> Maybe Attribute
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> [(Text, Text)] -> Int -> Maybe (Text, Text)
forall a. [a] -> Int -> Maybe a
atMay [(Text, Text)]
kvs (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  Maybe Key
Nothing              -> Maybe Attribute
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 ((Text, Text) -> Bool)
-> [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
str) (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
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 ([(Text, Text)] -> LuaE e ()) -> [(Text, Text)] -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
prefix [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
suffix
        Just (AttributeValue Text
value) -> [(Text, Text)] -> LuaE e ()
setNew ([(Text, Text)] -> LuaE e ()) -> [(Text, Text)] -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
prefix [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ (Text
str, Text
value)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
suffix
        Maybe Attribute
_ -> String -> LuaE e ()
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 -> () -> LuaE e ()
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (AttributeValue Text
value) -> [(Text, Text)] -> LuaE e ()
setNew ([(Text, Text)]
kvs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text
str, Text
value)])
        Maybe Attribute
_ -> String -> LuaE e ()
forall e a. LuaError e => String -> LuaE e a
failLua String
"invalid attribute value"
  Just (IntKey Int
idx) ->
    case Int -> [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
idx Int -> Int -> Int
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 ([(Text, Text)] -> LuaE e ()) -> [(Text, Text)] -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ case Maybe Attribute
mbValue of
        Maybe Attribute
Nothing -> [(Text, Text)]
prefix [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
suffix
        Just (AttributePair (Text, Text)
kv) -> [(Text, Text)]
prefix [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ (Text, Text)
kv (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
suffix
        Just (AttributeValue Text
v) -> [(Text, Text)]
prefix [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ (Text
k, Text
v) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
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 ([(Text, Text)] -> LuaE e ()) -> [(Text, Text)] -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
prefix [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)
kv]
        Maybe Attribute
_ -> String -> LuaE e ()
forall e a. LuaError e => String -> LuaE e a
failLua (String -> LuaE e ()) -> String -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ String
"trying to set an attribute key-value pair, "
             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"but got a single string instead."

  Maybe Key
_  -> String -> LuaE e ()
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 =
      StackIndex -> Name -> [(Text, Text)] -> LuaE e Bool
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 UDTypeWithList e (DocumentedFunction e) [(Text, Text)] Void
forall e. LuaError e => DocumentedType e [(Text, Text)]
typeAttributeList) [(Text, Text)]
new LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> () -> LuaE e ()
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Bool
False -> String -> LuaE e ()
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 = Name -> Peek e Attr -> Peek e Attr
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Attr" (Peek e Attr -> Peek e Attr) -> Peek e Attr -> Peek e Attr
forall a b. (a -> b) -> a -> b
$ 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 Attr) -> Peek e Attr
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
TypeString -> (,[],[]) (Text -> Attr) -> Peek e Text -> Peek e Attr
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx -- treat string as ID
  Type
TypeUserdata -> DocumentedTypeWithList e Attr Void -> Peeker e Attr
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD DocumentedTypeWithList e Attr Void
forall e. LuaError e => DocumentedType e Attr
typeAttr StackIndex
idx
  Type
TypeTable -> Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttrTable StackIndex
idx
  Type
x -> LuaE e Attr -> Peek e Attr
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Attr -> Peek e Attr)
-> (String -> LuaE e Attr) -> String -> Peek e Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LuaE e Attr
forall e a. LuaError e => String -> LuaE e a
failLua (String -> Peek e Attr) -> String -> Peek e Attr
forall a b. (a -> b) -> a -> b
$ String
"Cannot get Attr from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
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' <- LuaE e Int -> Peek e Int
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Int -> Peek e Int) -> LuaE e Int -> Peek e Int
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Int
forall e. StackIndex -> LuaE e Int
rawlen StackIndex
idx
  let peekClasses :: Peeker e [Text]
peekClasses = Peeker e Text -> Peeker e [Text]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Text
forall e. Peeker e Text
peekText
  if Int
len' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    then do
      Text
ident <- Integer -> Peeker e Text -> Peeker e Text
forall e a. LuaError e => Integer -> Peeker e a -> Peeker e a
peekIndexRaw Integer
1 Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx
      [Text]
classes <- [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Peek e (Maybe [Text]) -> Peek e [Text]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peek e [Text] -> Peek e (Maybe [Text])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Integer -> Peeker e [Text] -> Peeker e [Text]
forall e a. LuaError e => Integer -> Peeker e a -> Peeker e a
peekIndexRaw Integer
2 Peeker e [Text]
peekClasses StackIndex
idx)
      [(Text, Text)]
attribs <- [(Text, Text)] -> Maybe [(Text, Text)] -> [(Text, Text)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [(Text, Text)] -> [(Text, Text)])
-> Peek e (Maybe [(Text, Text)]) -> Peek e [(Text, Text)]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peek e [(Text, Text)] -> Peek e (Maybe [(Text, Text)])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Integer -> Peeker e [(Text, Text)] -> Peeker e [(Text, Text)]
forall e a. LuaError e => Integer -> Peeker e a -> Peeker e a
peekIndexRaw Integer
3 Peeker e [(Text, Text)]
forall e. LuaError e => Peeker e [(Text, Text)]
peekAttributeList StackIndex
idx)
      Attr -> Peek e Attr
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return (Attr -> Peek e Attr) -> Attr -> Peek e Attr
forall a b. (a -> b) -> a -> b
$ Text
ident Text -> Attr -> Attr
forall a b. a -> b -> b
`seq` [Text]
classes [Text] -> Attr -> Attr
forall a b. a -> b -> b
`seq` [(Text, Text)]
attribs [(Text, Text)] -> Attr -> Attr
forall a b. a -> b -> b
`seq`
        (Text
ident, [Text]
classes, [(Text, Text)]
attribs)
    else Name -> Peek e Attr -> Peek e Attr
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"HTML-like attributes" (Peek e Attr -> Peek e Attr) -> Peek e Attr -> Peek e Attr
forall a b. (a -> b) -> a -> b
$ do
      [(Text, Text)]
kvs <- Peeker e Text -> Peeker e Text -> Peeker e [(Text, Text)]
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs Peeker e Text
forall e. Peeker e Text
peekText Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx
      let ident :: Text
ident = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [(Text, Text)]
kvs
      let classes :: [Text]
classes = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [(Text, Text)]
kvs
      let attribs :: [(Text, Text)]
attribs = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"id", Text
"class"]) (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) [(Text, Text)]
kvs
      Attr -> Peek e Attr
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return (Attr -> Peek e Attr) -> Attr -> Peek e Attr
forall a b. (a -> b) -> a -> b
$ Text
ident Text -> Attr -> Attr
forall a b. a -> b -> b
`seq` [Text]
classes [Text] -> Attr -> Attr
forall a b. a -> b -> b
`seq` [(Text, Text)]
attribs [(Text, Text)] -> Attr -> Attr
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 = Name
-> (Maybe StackIndex
    -> Maybe StackIndex -> Maybe StackIndex -> LuaE e Attr)
-> HsFnPrecursor
     e
     (Maybe StackIndex
      -> Maybe StackIndex -> Maybe StackIndex -> LuaE e Attr)
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)
  HsFnPrecursor
  e
  (Maybe StackIndex
   -> Maybe StackIndex -> Maybe StackIndex -> LuaE e Attr)
-> Parameter e (Maybe StackIndex)
-> HsFnPrecursor
     e (Maybe StackIndex -> Maybe StackIndex -> LuaE e Attr)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e StackIndex -> Parameter e (Maybe StackIndex)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e StackIndex
-> TypeSpec -> Text -> Text -> Parameter e StackIndex
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e StackIndex
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSpec
"string|table|Attr" Text
"identifier" Text
"element identifier")
  HsFnPrecursor
  e (Maybe StackIndex -> Maybe StackIndex -> LuaE e Attr)
-> Parameter e (Maybe StackIndex)
-> HsFnPrecursor e (Maybe StackIndex -> LuaE e Attr)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e StackIndex -> Parameter e (Maybe StackIndex)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e StackIndex
-> TypeSpec -> Text -> Text -> Parameter e StackIndex
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e StackIndex
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSpec
"{string,...}" Text
"classes" Text
"element classes")
  HsFnPrecursor e (Maybe StackIndex -> LuaE e Attr)
-> Parameter e (Maybe StackIndex) -> HsFnPrecursor e (LuaE e Attr)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e StackIndex -> Parameter e (Maybe StackIndex)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e StackIndex
-> TypeSpec -> Text -> Text -> Parameter e StackIndex
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e StackIndex
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSpec
"table|AttributeList" Text
"attributes"
           Text
"table containing string keys and values")
  HsFnPrecursor e (LuaE e Attr)
-> FunctionResults e Attr -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Attr -> TypeSpec -> Text -> FunctionResults e Attr
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr TypeSpec
"Attr" Text
"new Attr object"
  #? "Create a new set of attributes"

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