-- | Useful library of expansions.
module Ondim.Extra.Expansions where

import Data.List qualified as L
import Data.Map qualified as Map
import Ondim
import Ondim.Debug

missingArgErr :: Text -> Ondim s a
missingArgErr :: forall s a. Text -> Ondim s a
missingArgErr Text
key = Text -> Ondim s a
forall s a. HasCallStack => Text -> Ondim s a
throwTemplateError (Text -> Ondim s a) -> Text -> Ondim s a
forall a b. (a -> b) -> a -> b
$ Text
"Missing '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' argument."

ensureAttr ::
  Text ->
  [Attribute] ->
  Ondim s Text
ensureAttr :: forall s. Text -> [Attribute] -> Ondim s Text
ensureAttr Text
key [Attribute]
attrs = Ondim s Text
-> (Text -> Ondim s Text) -> Maybe Text -> Ondim s Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Ondim s Text
forall s a. Text -> Ondim s a
missingArgErr Text
key) Text -> Ondim s Text
forall a. a -> Ondim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Attribute] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
key [Attribute]
attrs)

lookupAttr' ::
  (OndimNode t) =>
  Text ->
  t ->
  Ondim s Text
lookupAttr' :: forall t s. OndimNode t => Text -> t -> Ondim s Text
lookupAttr' Text
key t
node = Text -> [Attribute] -> Ondim s Text
forall s. Text -> [Attribute] -> Ondim s Text
ensureAttr Text
key ([Attribute] -> Ondim s Text)
-> Ondim s [Attribute] -> Ondim s Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< t -> Ondim s [Attribute]
forall s. t -> Ondim s [Attribute]
forall t s. OndimNode t => t -> Ondim s [Attribute]
attributes t
node

ensureSingleAttr ::
  Text ->
  [Attribute] ->
  Ondim s Text
ensureSingleAttr :: forall s. Text -> [Attribute] -> Ondim s Text
ensureSingleAttr Text
key [Attribute]
attrs =
  Ondim s Text
-> (Text -> Ondim s Text) -> Maybe Text -> Ondim s Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Ondim s Text
forall s a. Text -> Ondim s a
missingArgErr Text
key) Text -> Ondim s Text
forall a. a -> Ondim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Ondim s Text) -> Maybe Text -> Ondim s Text
forall a b. (a -> b) -> a -> b
$
    Text -> [Attribute] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
key [Attribute]
attrs Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NonEmpty Attribute -> Text) -> [Attribute] -> Maybe Text
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty (Attribute -> Text
forall a b. (a, b) -> a
fst (Attribute -> Text)
-> (NonEmpty Attribute -> Attribute) -> NonEmpty Attribute -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Attribute -> Attribute
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head) [Attribute]
attrs

lookupSingleAttr' ::
  (OndimNode t) =>
  Text ->
  t ->
  Ondim s Text
lookupSingleAttr' :: forall t s. OndimNode t => Text -> t -> Ondim s Text
lookupSingleAttr' Text
key t
node = Text -> [Attribute] -> Ondim s Text
forall s. Text -> [Attribute] -> Ondim s Text
ensureSingleAttr Text
key ([Attribute] -> Ondim s Text)
-> Ondim s [Attribute] -> Ondim s Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< t -> Ondim s [Attribute]
forall s. t -> Ondim s [Attribute]
forall t s. OndimNode t => t -> Ondim s [Attribute]
attributes t
node

identifiesAs :: (OndimNode t) => Text -> t -> Bool
identifiesAs :: forall t. OndimNode t => Text -> t -> Bool
identifiesAs Text
n = (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe Text -> Bool) -> (t -> Maybe Text) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe Text
forall t. OndimNode t => t -> Maybe Text
identify

-- * Lists

listExp ::
  (a -> NamespaceItem s) ->
  [a] ->
  NamespaceMap s
listExp :: forall a s. (a -> NamespaceItem s) -> [a] -> NamespaceMap s
listExp a -> NamespaceItem s
f [a]
list = do
  Text
"size" Text -> Text -> NamespaceMap s
forall m. HasCallStack => Text -> Text -> NamespaceMap m
#@ Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
list
  Bool -> NamespaceMap s -> NamespaceMap s
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
list) (NamespaceMap s -> NamespaceMap s)
-> NamespaceMap s -> NamespaceMap s
forall a b. (a -> b) -> a -> b
$ Text
"nonempty" Text -> Text -> NamespaceMap s
forall m. HasCallStack => Text -> Text -> NamespaceMap m
#@ Text
"true"
  Text
"list" Text -> PolyExpansion s -> NamespaceMap s
forall m. HasCallStack => Text -> PolyExpansion m -> NamespaceMap m
#* (a -> NamespaceItem s) -> [a] -> Expansion s a
forall a t s.
OndimNode t =>
(a -> NamespaceItem s) -> [a] -> Expansion s t
listList a -> NamespaceItem s
f [a]
list
  Maybe a -> (a -> NamespaceMap s) -> NamespaceMap s
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust ((NonEmpty a -> a) -> [a] -> Maybe a
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty a -> a
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head [a]
list) ((Text
"head" Text -> NamespaceItem s -> NamespaceMap s
forall m. Text -> NamespaceItem m -> NamespaceMap m
#:) (NamespaceItem s -> NamespaceMap s)
-> (a -> NamespaceItem s) -> a -> NamespaceMap s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NamespaceItem s
f)

listList ::
  forall a t s.
  (OndimNode t) =>
  (a -> NamespaceItem s) ->
  [a] ->
  Expansion s t
listList :: forall a t s.
OndimNode t =>
(a -> NamespaceItem s) -> [a] -> Expansion s t
listList a -> NamespaceItem s
f [a]
list t
node = do
  alias <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"this" (Maybe Text -> Text) -> Ondim s (Maybe Text) -> Ondim s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> t -> Ondim s (Maybe Text)
forall t s. OndimNode t => Text -> t -> Ondim s (Maybe Text)
lookupAttr Text
"as" t
node
  expansion <- do
    expName <- lookupAttr "with" node
    case expName of
      Just Text
name -> do
        exps <- Text -> Ondim s (Either OndimFailure (Expansion s t))
forall t s.
OndimNode t =>
Text -> Ondim s (Either OndimFailure (Expansion s t))
getExpansion Text
name
        either (throwExpFailure @t name) return exps
      Maybe Text
Nothing -> Expansion s t -> Ondim s (Expansion s t)
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return Expansion s t
forall t s. OndimNode t => Expansion s t
expandChildren
  intercalateWith <- lookupAttr "intercalate" node
  let inter a
txt
        | Just a -> [a]
cast <- Maybe (a -> [a])
forall a b. (OndimNode a, OndimNode b) => Maybe (a -> [b])
ondimCast = [a] -> [[a]] -> [a]
forall a. [a] -> [[a]] -> [a]
intercalate (a -> [a]
cast a
txt)
        | Bool
otherwise = [[a]] -> [a]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
      join' = ([[t]] -> [t])
-> (Text -> [[t]] -> [t]) -> Maybe Text -> [[t]] -> [t]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [[t]] -> [t]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Text -> [[t]] -> [t]
forall {a} {a}. (OndimNode a, OndimNode a) => a -> [[a]] -> [a]
inter Maybe Text
intercalateWith
  withSomeExpansion alias Nothing $
    join' <$> forM list \a
el ->
      Expansion s t
expansion t
node
        Ondim s [t] -> NamespaceMap s -> Ondim s [t]
forall s a. Ondim s a -> NamespaceMap s -> Ondim s a
`binding` do Text
alias Text -> NamespaceItem s -> NamespaceMap s
forall m. Text -> NamespaceItem m -> NamespaceMap m
#: a -> NamespaceItem s
f a
el

-- * Assocs and maps

assocsExp ::
  (v -> NamespaceItem s) ->
  [(Text, v)] ->
  NamespaceMap s
assocsExp :: forall v s. (v -> NamespaceItem s) -> [(Text, v)] -> NamespaceMap s
assocsExp v -> NamespaceItem s
vf [(Text, v)]
obj = do
  Text
"size" Text -> Text -> NamespaceMap s
forall m. HasCallStack => Text -> Text -> NamespaceMap m
#@ Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [(Text, v)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, v)]
obj
  Bool -> NamespaceMap s -> NamespaceMap s
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Text, v)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, v)]
obj) (NamespaceMap s -> NamespaceMap s)
-> NamespaceMap s -> NamespaceMap s
forall a b. (a -> b) -> a -> b
$ Text
"nonempty" Text -> Text -> NamespaceMap s
forall m. HasCallStack => Text -> Text -> NamespaceMap m
#@ Text
"true"
  Text
"list" Text -> PolyExpansion s -> NamespaceMap s
forall m. HasCallStack => Text -> PolyExpansion m -> NamespaceMap m
#* ((Text, v) -> NamespaceItem s) -> [(Text, v)] -> Expansion s a
forall a t s.
OndimNode t =>
(a -> NamespaceItem s) -> [a] -> Expansion s t
listList (Text, v) -> NamespaceItem s
kv [(Text, v)]
obj
  Text
"keys" Text -> PolyExpansion s -> NamespaceMap s
forall m. HasCallStack => Text -> PolyExpansion m -> NamespaceMap m
#* (Text -> NamespaceItem s) -> [Text] -> Expansion s a
forall a t s.
OndimNode t =>
(a -> NamespaceItem s) -> [a] -> Expansion s t
listList Text -> NamespaceItem s
forall m. HasCallStack => Text -> NamespaceItem m
textData (((Text, v) -> Text) -> [(Text, v)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, v) -> Text
forall a b. (a, b) -> a
fst [(Text, v)]
obj)
  Text
"values" Text -> PolyExpansion s -> NamespaceMap s
forall m. HasCallStack => Text -> PolyExpansion m -> NamespaceMap m
#* (v -> NamespaceItem s) -> [v] -> Expansion s a
forall a t s.
OndimNode t =>
(a -> NamespaceItem s) -> [a] -> Expansion s t
listList v -> NamespaceItem s
vf (((Text, v) -> v) -> [(Text, v)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (Text, v) -> v
forall a b. (a, b) -> b
snd [(Text, v)]
obj)
  [(Text, v)] -> ((Text, v) -> NamespaceMap s) -> NamespaceMap s
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, v)]
obj (\(Text
k, v
v) -> Text
k Text -> NamespaceItem s -> NamespaceMap s
forall m. Text -> NamespaceItem m -> NamespaceMap m
#: v -> NamespaceItem s
vf v
v)
  where
    kv :: (Text, v) -> NamespaceItem s
kv (Text
k, v
v) =
      NamespaceMap s -> NamespaceItem s
forall m. NamespaceMap m -> NamespaceItem m
namespace do
        Text
"key" Text -> Text -> NamespaceMap s
forall m. HasCallStack => Text -> Text -> NamespaceMap m
#@ Text
k
        Text
"value" Text -> NamespaceItem s -> NamespaceMap s
forall m. Text -> NamespaceItem m -> NamespaceMap m
#: v -> NamespaceItem s
vf v
v

mapExp ::
  (v -> NamespaceItem s) ->
  Map Text v ->
  NamespaceMap s
mapExp :: forall v s. (v -> NamespaceItem s) -> Map Text v -> NamespaceMap s
mapExp v -> NamespaceItem s
vf Map Text v
obj = (v -> NamespaceItem s) -> [(Text, v)] -> NamespaceMap s
forall v s. (v -> NamespaceItem s) -> [(Text, v)] -> NamespaceMap s
assocsExp v -> NamespaceItem s
vf (Map Text v -> [(Text, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text v
obj)

-- * Booleans

ifElse ::
  (OndimNode t) =>
  Bool ->
  Expansion s t
ifElse :: forall t s. OndimNode t => Bool -> Expansion s t
ifElse Bool
cond t
node = do
  let els :: [t]
els = t -> [t]
forall t. OndimNode t => t -> [t]
children t
node
      yes :: [t]
yes = (t -> Bool) -> [t] -> [t]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (t -> Bool) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> t -> Bool
forall t. OndimNode t => Text -> t -> Bool
identifiesAs Text
"else") [t]
els
      no :: [t]
no =
        [t] -> (t -> [t]) -> Maybe t -> [t]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] t -> [t]
forall t. OndimNode t => t -> [t]
children (Maybe t -> [t]) -> Maybe t -> [t]
forall a b. (a -> b) -> a -> b
$
          (t -> Bool) -> [t] -> Maybe t
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> t -> Bool
forall t. OndimNode t => Text -> t -> Bool
identifiesAs Text
"else") [t]
els
  if Bool
cond
    then [t] -> Ondim s [t]
forall s. [t] -> Ondim s [t]
forall t s. Expansible t => t -> Ondim s t
expandSubs [t]
yes
    else [t] -> Ondim s [t]
forall s. [t] -> Ondim s [t]
forall t s. Expansible t => t -> Ondim s t
expandSubs [t]
no
{-# INLINEABLE ifElse #-}

-- * Text

switchWithDefault ::
  (OndimNode t) =>
  Maybe Text ->
  Expansion s t
switchWithDefault :: forall t s. OndimNode t => Maybe Text -> Expansion s t
switchWithDefault Maybe Text
tag t
node = do
  let els :: [t]
els = t -> [t]
forall t. OndimNode t => t -> [t]
children t
node
  match <- ((t -> Ondim s Bool) -> [t] -> Ondim s (Maybe t)
forall {t :: * -> *} {m :: * -> *} {a}.
(Foldable t, Monad m) =>
(a -> m Bool) -> t a -> m (Maybe a)
`findM` [t]
els) \t
x -> do
    if Text -> t -> Bool
forall t. OndimNode t => Text -> t -> Bool
identifiesAs Text
"case" t
x
      then do
        caseTag <- Text -> t -> Ondim s Text
forall t s. OndimNode t => Text -> t -> Ondim s Text
lookupSingleAttr' Text
"id" t
x
        return $ Just caseTag == tag
      else Bool -> Ondim s Bool
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  fromMaybe (pure []) do
    child <- match <|> find (identifiesAs "default") els
    pure $ expandChildren child
  where
    findM :: (a -> m Bool) -> t a -> m (Maybe a)
findM a -> m Bool
p = (a -> m (Maybe a) -> m (Maybe a))
-> m (Maybe a) -> t a -> m (Maybe a)
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> m Bool -> m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (a -> m Bool
p a
x) (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x)) (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)

renderExp ::
  forall a b s.
  ( HasCallStack,
    OndimNode a,
    OndimNode b
  ) =>
  (Text -> Either String b) ->
  Expansion s a
renderExp :: forall a b s.
(HasCallStack, OndimNode a, OndimNode b) =>
(Text -> Either String b) -> Expansion s a
renderExp Text -> Either String b
f a
node = do
  parsed <- Text -> Either String b
f (Text -> Either String b)
-> Ondim s Text -> Ondim s (Either String b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> a -> Ondim s Text
forall t s. OndimNode t => Text -> t -> Ondim s Text
lookupAttr' Text
"text" a
node
  either (throwTemplateError . toText) convert parsed
  where
    noRender :: Ondim s a
noRender = Text -> Ondim s a
forall s a. HasCallStack => Text -> Ondim s a
throwTemplateError Text
"source is missing cast to rendered!"
    noCast :: Ondim s a
noCast = Text -> Ondim s a
forall s a. HasCallStack => Text -> Ondim s a
throwTemplateError Text
"target is missing cast from text!"
    convert :: t -> Ondim s [b]
convert t
x = do
      case Maybe (t -> LByteString)
forall t. OndimNode t => Maybe (t -> LByteString)
renderNode of
        Just t -> LByteString
render ->
          case Maybe (Text -> [b])
forall a b. (OndimNode a, OndimNode b) => Maybe (a -> [b])
ondimCast of
            Just Text -> [b]
cast -> do
              x' <- t -> Ondim s t
forall s. t -> Ondim s t
forall t s. Expansible t => t -> Ondim s t
expandSubs t
x
              let t = forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 @Text (t -> LByteString
render t
x')
              return $ cast t
            Maybe (Text -> [b])
Nothing -> Ondim s [b]
forall {s} {a}. Ondim s a
noCast
        Maybe (t -> LByteString)
Nothing -> Ondim s [b]
forall {s} {a}. Ondim s a
noRender