module Ondim.Targets.Whiskers.Instances where

import Data.Text qualified as T
import Data.Typeable (eqT, (:~:) (..))
import Ondim
import Ondim.Advanced
import Ondim.Debug

type WAttribute = (Text, [WNode])

instance Expansible [WAttribute] where
  expandSubs :: forall s. [WAttribute] -> Ondim s [WAttribute]
expandSubs = (WAttribute -> Ondim s [WAttribute])
-> [WAttribute] -> Ondim s [WAttribute]
forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM WAttribute -> Ondim s [WAttribute]
forall {a} {s}.
(OneItem a ~ WNode, One a, Expansible a) =>
(Text, a) -> Ondim s [(Text, a)]
go
    where
      go :: (Text, a) -> Ondim s [(Text, a)]
go (Text
k, a
v)
        | Just (Text
k', Char
'?') <- Text -> Maybe (Text, Char)
T.unsnoc Text
k =
            Text -> a -> Ondim s [(Text, a)]
forall {a} {s}.
(OneItem a ~ WNode, One a, Expansible a) =>
Text -> a -> Ondim s [(Text, a)]
expand Text
k' a
v
              Ondim s [(Text, a)]
-> (OndimFailure
    -> Text -> SomeTypeRep -> TraceData -> Ondim s [(Text, a)])
-> Ondim s [(Text, a)]
forall s a.
Ondim s a
-> (OndimFailure -> Text -> SomeTypeRep -> TraceData -> Ondim s a)
-> Ondim s a
`catchFailure` \OndimFailure
_ Text
_ SomeTypeRep
_ TraceData
_ -> [(Text, a)] -> Ondim s [(Text, a)]
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        | Bool
otherwise = Text -> a -> Ondim s [(Text, a)]
forall {a} {s}.
(OneItem a ~ WNode, One a, Expansible a) =>
Text -> a -> Ondim s [(Text, a)]
expand Text
k a
v
      expand :: Text -> a -> Ondim s [(Text, a)]
expand Text
k a
v
        | Just Text
name <- Text -> Text -> Maybe Text
T.stripPrefix Text
"e:" Text
k =
            ((Text, Text) -> (Text, a)) -> [(Text, Text)] -> [(Text, a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> a) -> (Text, Text) -> (Text, a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (OneItem a -> a
WNode -> a
forall x. One x => OneItem x -> x
one (WNode -> a) -> (Text -> WNode) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> WNode
Textual)) ([(Text, Text)] -> [(Text, a)])
-> Ondim s [(Text, Text)] -> Ondim s [(Text, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Ondim s [(Text, Text)]
forall t s. OndimNode t => Text -> Ondim s [t]
callTemplate Text
name
        | Bool
otherwise = (Text, a) -> [(Text, a)]
OneItem [(Text, a)] -> [(Text, a)]
forall x. One x => OneItem x -> x
one ((Text, a) -> [(Text, a)]) -> (a -> (Text, a)) -> a -> [(Text, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
k,) (a -> [(Text, a)]) -> Ondim s a -> Ondim s [(Text, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Ondim s a
forall s. a -> Ondim s a
forall t s. Expansible t => t -> Ondim s t
expandSubs a
v

data WNode
  = Section !Text ![WAttribute] ![WNode]
  | Single !Text ![WAttribute]
  | Textual !Text
  deriving (WNode -> WNode -> Bool
(WNode -> WNode -> Bool) -> (WNode -> WNode -> Bool) -> Eq WNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WNode -> WNode -> Bool
== :: WNode -> WNode -> Bool
$c/= :: WNode -> WNode -> Bool
/= :: WNode -> WNode -> Bool
Eq, Eq WNode
Eq WNode =>
(WNode -> WNode -> Ordering)
-> (WNode -> WNode -> Bool)
-> (WNode -> WNode -> Bool)
-> (WNode -> WNode -> Bool)
-> (WNode -> WNode -> Bool)
-> (WNode -> WNode -> WNode)
-> (WNode -> WNode -> WNode)
-> Ord WNode
WNode -> WNode -> Bool
WNode -> WNode -> Ordering
WNode -> WNode -> WNode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WNode -> WNode -> Ordering
compare :: WNode -> WNode -> Ordering
$c< :: WNode -> WNode -> Bool
< :: WNode -> WNode -> Bool
$c<= :: WNode -> WNode -> Bool
<= :: WNode -> WNode -> Bool
$c> :: WNode -> WNode -> Bool
> :: WNode -> WNode -> Bool
$c>= :: WNode -> WNode -> Bool
>= :: WNode -> WNode -> Bool
$cmax :: WNode -> WNode -> WNode
max :: WNode -> WNode -> WNode
$cmin :: WNode -> WNode -> WNode
min :: WNode -> WNode -> WNode
Ord, Int -> WNode -> ShowS
[WNode] -> ShowS
WNode -> String
(Int -> WNode -> ShowS)
-> (WNode -> String) -> ([WNode] -> ShowS) -> Show WNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WNode -> ShowS
showsPrec :: Int -> WNode -> ShowS
$cshow :: WNode -> String
show :: WNode -> String
$cshowList :: [WNode] -> ShowS
showList :: [WNode] -> ShowS
Show, (forall x. WNode -> Rep WNode x)
-> (forall x. Rep WNode x -> WNode) -> Generic WNode
forall x. Rep WNode x -> WNode
forall x. WNode -> Rep WNode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WNode -> Rep WNode x
from :: forall x. WNode -> Rep WNode x
$cto :: forall x. Rep WNode x -> WNode
to :: forall x. Rep WNode x -> WNode
Generic, WNode -> ()
(WNode -> ()) -> NFData WNode
forall a. (a -> ()) -> NFData a
$crnf :: WNode -> ()
rnf :: WNode -> ()
NFData)

renderWhiskers :: (Foldable t) => t WNode -> Text
renderWhiskers :: forall (t :: * -> *). Foldable t => t WNode -> Text
renderWhiskers = (WNode -> Text) -> t WNode -> Text
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WNode -> Text
go
  where
    go :: WNode -> Text
go = \case
      Section Text
_ [WAttribute]
_ [WNode]
n -> (WNode -> Text) -> [WNode] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WNode -> Text
go [WNode]
n
      Textual Text
t -> Text
t
      Single {} -> Text
forall a. Monoid a => a
mempty

instance Expansible WNode where
  expandSubs :: forall s. WNode -> Ondim s WNode
expandSubs = \case
    Section Text
t [WAttribute]
a [WNode]
n -> Text -> [WAttribute] -> [WNode] -> WNode
Section Text
t ([WAttribute] -> [WNode] -> WNode)
-> Ondim s [WAttribute] -> Ondim s ([WNode] -> WNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WAttribute] -> Ondim s [WAttribute]
forall s. [WAttribute] -> Ondim s [WAttribute]
forall t s. Expansible t => t -> Ondim s t
expandSubs [WAttribute]
a Ondim s ([WNode] -> WNode) -> Ondim s [WNode] -> Ondim s WNode
forall a b. Ondim s (a -> b) -> Ondim s a -> Ondim s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [WNode] -> Ondim s [WNode]
forall s. [WNode] -> Ondim s [WNode]
forall t s. Expansible t => t -> Ondim s t
expandSubs [WNode]
n
    Single Text
t [WAttribute]
a -> Text -> [WAttribute] -> WNode
Single Text
t ([WAttribute] -> WNode) -> Ondim s [WAttribute] -> Ondim s WNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WAttribute] -> Ondim s [WAttribute]
forall s. [WAttribute] -> Ondim s [WAttribute]
forall t s. Expansible t => t -> Ondim s t
expandSubs [WAttribute]
a
    t :: WNode
t@Textual {} -> WNode -> Ondim s WNode
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return WNode
t

instance OndimNode WNode where
  children :: WNode -> [WNode]
children = \case
    Section Text
_ [WAttribute]
_ [WNode]
w -> [WNode]
w
    WNode
_ -> []
  attributes :: forall s. WNode -> Ondim s [(Text, Text)]
attributes = \case
    Section Text
_ [WAttribute]
a [WNode]
_ -> [WAttribute] -> Ondim s [(Text, Text)]
forall {g :: * -> *} {f :: * -> *} {t :: * -> *} {s}.
(Functor g, Functor f, Foldable t, Expansible (g (f (t WNode)))) =>
g (f (t WNode)) -> Ondim s (g (f Text))
f [WAttribute]
a
    Single Text
_ [WAttribute]
a -> [WAttribute] -> Ondim s [(Text, Text)]
forall {g :: * -> *} {f :: * -> *} {t :: * -> *} {s}.
(Functor g, Functor f, Foldable t, Expansible (g (f (t WNode)))) =>
g (f (t WNode)) -> Ondim s (g (f Text))
f [WAttribute]
a
    Textual {} -> [(Text, Text)] -> Ondim s [(Text, Text)]
forall a. a -> Ondim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    where
      f :: g (f (t WNode)) -> Ondim s (g (f Text))
f g (f (t WNode))
a = (t WNode -> Text) -> f (t WNode) -> f Text
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t WNode -> Text
forall (t :: * -> *). Foldable t => t WNode -> Text
renderWhiskers (f (t WNode) -> f Text)
-> Ondim s (g (f (t WNode))) -> Ondim s (g (f Text))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> g (f (t WNode)) -> Ondim s (g (f (t WNode)))
forall s. g (f (t WNode)) -> Ondim s (g (f (t WNode)))
forall t s. Expansible t => t -> Ondim s t
expandSubs g (f (t WNode))
a
  identify :: WNode -> Maybe Text
identify = \case
    Section Text
t [WAttribute]
_ [WNode]
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
    Single Text
t [WAttribute]
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
    WNode
_ -> Maybe Text
forall a. Maybe a
Nothing
  castFrom :: forall t. (OndimNode t) => Maybe (t -> [WNode])
  castFrom :: forall a. OndimNode a => Maybe (a -> [WNode])
castFrom
    | Just t :~: Text
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @t @Text = (t -> [WNode]) -> Maybe (t -> [WNode])
forall a. a -> Maybe a
Just ((t -> [WNode]) -> Maybe (t -> [WNode]))
-> (t -> [WNode]) -> Maybe (t -> [WNode])
forall a b. (a -> b) -> a -> b
$ OneItem [WNode] -> [WNode]
WNode -> [WNode]
forall x. One x => OneItem x -> x
one (WNode -> [WNode]) -> (t -> WNode) -> t -> [WNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> WNode
Text -> WNode
Textual
    | Just t -> Text
cast <- Maybe (t -> Text)
forall t. OndimNode t => Maybe (t -> Text)
nodeAsText = (t -> [WNode]) -> Maybe (t -> [WNode])
forall a. a -> Maybe a
Just ((t -> [WNode]) -> Maybe (t -> [WNode]))
-> (t -> [WNode]) -> Maybe (t -> [WNode])
forall a b. (a -> b) -> a -> b
$ OneItem [WNode] -> [WNode]
WNode -> [WNode]
forall x. One x => OneItem x -> x
one (WNode -> [WNode]) -> (t -> WNode) -> t -> [WNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> WNode
Textual (Text -> WNode) -> (t -> Text) -> t -> WNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Text
cast
    | Bool
otherwise = Maybe (t -> [WNode])
forall a. Maybe a
Nothing