module Heist.Extra.Splices.Tree (treeSplice) where

import Data.Map.Syntax ((##))
import Data.Tree (Tree (..))
import Heist qualified as H
import Heist.Interpreted qualified as HI
import Heist.Splices qualified as Heist

treeSplice ::
  forall a sortKey.
  (Ord sortKey) =>
  -- | How to sort children
  (NonEmpty a -> sortKey) ->
  -- | Input tree
  [Tree a] ->
  -- | How to render a (sub-)tree root
  (NonEmpty a -> [Tree a] -> H.Splices (HI.Splice Identity)) ->
  HI.Splice Identity
treeSplice :: forall a sortKey.
Ord sortKey =>
(NonEmpty a -> sortKey)
-> [Tree a]
-> (NonEmpty a -> [Tree a] -> Splices (Splice Identity))
-> Splice Identity
treeSplice =
  [a]
-> (NonEmpty a -> sortKey)
-> [Tree a]
-> (NonEmpty a -> [Tree a] -> Splices (Splice Identity))
-> Splice Identity
go []
  where
    go :: [a] -> (NonEmpty a -> sortKey) -> [Tree a] -> (NonEmpty a -> [Tree a] -> H.Splices (HI.Splice Identity)) -> HI.Splice Identity
    go :: [a]
-> (NonEmpty a -> sortKey)
-> [Tree a]
-> (NonEmpty a -> [Tree a] -> Splices (Splice Identity))
-> Splice Identity
go [a]
pars NonEmpty a -> sortKey
sortKey [Tree a]
trees NonEmpty a -> [Tree a] -> Splices (Splice Identity)
childSplice = do
      let extendPars :: a -> NonEmpty a
extendPars a
x = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall x. One x => OneItem x -> x
one a
x) (forall a. Semigroup a => a -> a -> a
<> forall x. One x => OneItem x -> x
one a
x) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [a]
pars
      forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (NonEmpty a -> sortKey
sortKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonEmpty a
extendPars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
rootLabel) [Tree a]
trees) forall a b. (a -> b) -> a -> b
$ \(Node a
lbl [Tree a]
children) -> do
        forall (n :: Type -> Type).
Monad n =>
Splices (Splice n) -> Splice n
HI.runChildrenWith forall a b. (a -> b) -> a -> b
$ do
          let herePath :: NonEmpty a
herePath = a -> NonEmpty a
extendPars a
lbl
          NonEmpty a -> [Tree a] -> Splices (Splice Identity)
childSplice NonEmpty a
herePath [Tree a]
children
          Text
"has-children" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type). Monad m => Bool -> Splice m
Heist.ifElseISplice (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [Tree a]
children)
          let childrenSorted :: [Tree a]
childrenSorted = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (NonEmpty a -> sortKey
sortKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty a
herePath <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
rootLabel) [Tree a]
children
          Text
"children"
            ## go (toList herePath) sortKey childrenSorted childSplice