module Heist.Extra.Splices.Pandoc.Attr where

import Data.Text qualified as T
import Text.Pandoc.Definition qualified as B

-- | Convert Pandoc attributes to XmlHtml attributes
rpAttr :: B.Attr -> [(Text, Text)]
rpAttr :: Attr -> [(Text, Text)]
rpAttr (Text
id', [Text]
classes, [(Text, Text)]
attrs) =
  let cls :: Text
cls = Text -> [Text] -> Text
T.intercalate Text
" " [Text]
classes
   in forall {a}. Monoid a => Text -> a -> a
unlessNull Text
id' [(Text
"id", Text
id')]
        forall a. Semigroup a => a -> a -> a
<> forall {a}. Monoid a => Text -> a -> a
unlessNull Text
cls [(Text
"class", Text
cls)]
        forall a. Semigroup a => a -> a -> a
<> forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Text
k, Text
v) -> forall {a}. Monoid a => Text -> a -> a
unlessNull Text
v forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [(Text
k, Text
v)]) [(Text, Text)]
attrs)
  where
    unlessNull :: Text -> a -> a
unlessNull Text
x a
f =
      if Text -> Bool
T.null Text
x then forall a. Monoid a => a
mempty else a
f

-- | Merge two XmlHtml attributes set
concatAttr :: B.Attr -> B.Attr -> B.Attr
concatAttr :: Attr -> Attr -> Attr
concatAttr (Text
id1, [Text]
cls1, [(Text, Text)]
attr1) (Text
id2, [Text]
cls2, [(Text, Text)]
attr2) =
  (forall {p}. (Eq p, IsString p) => p -> p -> p
pickNonNull Text
id1 Text
id2, [Text]
cls1 forall a. Semigroup a => a -> a -> a
<> [Text]
cls2, [(Text, Text)]
attr1 forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
attr2)
  where
    pickNonNull :: p -> p -> p
pickNonNull p
x p
"" = p
x
    pickNonNull p
"" p
x = p
x
    pickNonNull p
_ p
_ = p
""