module Halogen.VDom.Types
  ( VDom (..)
  , renderWidget
  , Graft (..)
  , runGraft
  , ElemName (..)
  , Namespace (..)
  , unNamespace
  )
where

import HPrelude

newtype ElemName = ElemName Text
  deriving (ElemName -> ElemName -> Bool
(ElemName -> ElemName -> Bool)
-> (ElemName -> ElemName -> Bool) -> Eq ElemName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElemName -> ElemName -> Bool
== :: ElemName -> ElemName -> Bool
$c/= :: ElemName -> ElemName -> Bool
/= :: ElemName -> ElemName -> Bool
Eq, Eq ElemName
Eq ElemName =>
(ElemName -> ElemName -> Ordering)
-> (ElemName -> ElemName -> Bool)
-> (ElemName -> ElemName -> Bool)
-> (ElemName -> ElemName -> Bool)
-> (ElemName -> ElemName -> Bool)
-> (ElemName -> ElemName -> ElemName)
-> (ElemName -> ElemName -> ElemName)
-> Ord ElemName
ElemName -> ElemName -> Bool
ElemName -> ElemName -> Ordering
ElemName -> ElemName -> ElemName
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 :: ElemName -> ElemName -> Ordering
compare :: ElemName -> ElemName -> Ordering
$c< :: ElemName -> ElemName -> Bool
< :: ElemName -> ElemName -> Bool
$c<= :: ElemName -> ElemName -> Bool
<= :: ElemName -> ElemName -> Bool
$c> :: ElemName -> ElemName -> Bool
> :: ElemName -> ElemName -> Bool
$c>= :: ElemName -> ElemName -> Bool
>= :: ElemName -> ElemName -> Bool
$cmax :: ElemName -> ElemName -> ElemName
max :: ElemName -> ElemName -> ElemName
$cmin :: ElemName -> ElemName -> ElemName
min :: ElemName -> ElemName -> ElemName
Ord, Int -> ElemName -> ShowS
[ElemName] -> ShowS
ElemName -> String
(Int -> ElemName -> ShowS)
-> (ElemName -> String) -> ([ElemName] -> ShowS) -> Show ElemName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElemName -> ShowS
showsPrec :: Int -> ElemName -> ShowS
$cshow :: ElemName -> String
show :: ElemName -> String
$cshowList :: [ElemName] -> ShowS
showList :: [ElemName] -> ShowS
Show, String -> ElemName
(String -> ElemName) -> IsString ElemName
forall a. (String -> a) -> IsString a
$cfromString :: String -> ElemName
fromString :: String -> ElemName
IsString)

newtype Namespace = Namespace Text
  deriving (Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
/= :: Namespace -> Namespace -> Bool
Eq, Eq Namespace
Eq Namespace =>
(Namespace -> Namespace -> Ordering)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Namespace)
-> (Namespace -> Namespace -> Namespace)
-> Ord Namespace
Namespace -> Namespace -> Bool
Namespace -> Namespace -> Ordering
Namespace -> Namespace -> Namespace
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 :: Namespace -> Namespace -> Ordering
compare :: Namespace -> Namespace -> Ordering
$c< :: Namespace -> Namespace -> Bool
< :: Namespace -> Namespace -> Bool
$c<= :: Namespace -> Namespace -> Bool
<= :: Namespace -> Namespace -> Bool
$c> :: Namespace -> Namespace -> Bool
> :: Namespace -> Namespace -> Bool
$c>= :: Namespace -> Namespace -> Bool
>= :: Namespace -> Namespace -> Bool
$cmax :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
min :: Namespace -> Namespace -> Namespace
Ord, Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
(Int -> Namespace -> ShowS)
-> (Namespace -> String)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Namespace -> ShowS
showsPrec :: Int -> Namespace -> ShowS
$cshow :: Namespace -> String
show :: Namespace -> String
$cshowList :: [Namespace] -> ShowS
showList :: [Namespace] -> ShowS
Show, String -> Namespace
(String -> Namespace) -> IsString Namespace
forall a. (String -> a) -> IsString a
$cfromString :: String -> Namespace
fromString :: String -> Namespace
IsString)

unNamespace :: Namespace -> Text
unNamespace :: Namespace -> Text
unNamespace (Namespace Text
ns) = Text
ns

data VDom a w
  = Text Text
  | Elem (Maybe Namespace) ElemName a [VDom a w]
  | Keyed (Maybe Namespace) ElemName a [(Text, VDom a w)]
  | Widget w
  | Grafted (Graft a w)
  deriving ((forall a b. (a -> b) -> VDom a a -> VDom a b)
-> (forall a b. a -> VDom a b -> VDom a a) -> Functor (VDom a)
forall a b. a -> VDom a b -> VDom a a
forall a b. (a -> b) -> VDom a a -> VDom a b
forall a a b. a -> VDom a b -> VDom a a
forall a a b. (a -> b) -> VDom a a -> VDom a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> VDom a a -> VDom a b
fmap :: forall a b. (a -> b) -> VDom a a -> VDom a b
$c<$ :: forall a a b. a -> VDom a b -> VDom a a
<$ :: forall a b. a -> VDom a b -> VDom a a
Functor)

instance Bifunctor VDom where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> VDom a c -> VDom b d
bimap a -> b
f c -> d
g = \case
    Text Text
s -> Text -> VDom b d
forall a w. Text -> VDom a w
Text Text
s
    Elem Maybe Namespace
ns'm ElemName
en a
props [VDom a c]
children -> Maybe Namespace -> ElemName -> b -> [VDom b d] -> VDom b d
forall a w.
Maybe Namespace -> ElemName -> a -> [VDom a w] -> VDom a w
Elem Maybe Namespace
ns'm ElemName
en (a -> b
f a
props) ((VDom a c -> VDom b d) -> [VDom a c] -> [VDom b d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((a -> b) -> (c -> d) -> VDom a c -> VDom b d
forall a b c d. (a -> b) -> (c -> d) -> VDom a c -> VDom b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) [VDom a c]
children)
    Keyed Maybe Namespace
ns'm ElemName
en a
props [(Text, VDom a c)]
children -> Maybe Namespace -> ElemName -> b -> [(Text, VDom b d)] -> VDom b d
forall a w.
Maybe Namespace -> ElemName -> a -> [(Text, VDom a w)] -> VDom a w
Keyed Maybe Namespace
ns'm ElemName
en (a -> b
f a
props) (((Text, VDom a c) -> (Text, VDom b d))
-> [(Text, VDom a c)] -> [(Text, VDom b d)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((VDom a c -> VDom b d) -> (Text, VDom a c) -> (Text, VDom b d)
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 ((a -> b) -> (c -> d) -> VDom a c -> VDom b d
forall a b c d. (a -> b) -> (c -> d) -> VDom a c -> VDom b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g)) [(Text, VDom a c)]
children)
    Widget c
w -> d -> VDom b d
forall a w. w -> VDom a w
Widget (d -> VDom b d) -> d -> VDom b d
forall a b. (a -> b) -> a -> b
$ c -> d
g c
w
    Grafted Graft a c
graft -> Graft b d -> VDom b d
forall a w. Graft a w -> VDom a w
Grafted (Graft b d -> VDom b d) -> Graft b d -> VDom b d
forall a b. (a -> b) -> a -> b
$ (a -> b) -> (c -> d) -> Graft a c -> Graft b d
forall a b c d. (a -> b) -> (c -> d) -> Graft a c -> Graft b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g Graft a c
graft

data Graft a w = forall a' w'. Graft (a' -> a) (w' -> w) (VDom a' w')

deriving instance Functor (Graft a)

instance Bifunctor Graft where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Graft a c -> Graft b d
bimap a -> b
f c -> d
g (Graft a' -> a
fm w' -> c
wm VDom a' w'
v) = (a' -> b) -> (w' -> d) -> VDom a' w' -> Graft b d
forall a w a' w'. (a' -> a) -> (w' -> w) -> VDom a' w' -> Graft a w
Graft (a -> b
f (a -> b) -> (a' -> a) -> a' -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
fm) (c -> d
g (c -> d) -> (w' -> c) -> w' -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w' -> c
wm) VDom a' w'
v

runGraft :: Graft a w -> VDom a w
runGraft :: forall a w. Graft a w -> VDom a w
runGraft (Graft a' -> a
fm w' -> w
fw VDom a' w'
v) = (a' -> a) -> (w' -> w) -> VDom a' w' -> VDom a w
forall a b c d. (a -> b) -> (c -> d) -> VDom a c -> VDom b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a' -> a
fm w' -> w
fw VDom a' w'
v

renderWidget :: (a -> a') -> (w -> VDom a' w') -> VDom a w -> VDom a' w'
renderWidget :: forall a a' w w'.
(a -> a') -> (w -> VDom a' w') -> VDom a w -> VDom a' w'
renderWidget a -> a'
fm w -> VDom a' w'
injWidget = \case
  Text Text
txt -> Text -> VDom a' w'
forall a w. Text -> VDom a w
Text Text
txt
  Elem Maybe Namespace
ns'm ElemName
en a
props [VDom a w]
children ->
    Maybe Namespace -> ElemName -> a' -> [VDom a' w'] -> VDom a' w'
forall a w.
Maybe Namespace -> ElemName -> a -> [VDom a w] -> VDom a w
Elem Maybe Namespace
ns'm ElemName
en (a -> a'
fm a
props) ((VDom a w -> VDom a' w') -> [VDom a w] -> [VDom a' w']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((a -> a') -> (w -> VDom a' w') -> VDom a w -> VDom a' w'
forall a a' w w'.
(a -> a') -> (w -> VDom a' w') -> VDom a w -> VDom a' w'
renderWidget a -> a'
fm w -> VDom a' w'
injWidget) [VDom a w]
children)
  Keyed Maybe Namespace
ns'm ElemName
en a
props [(Text, VDom a w)]
children ->
    Maybe Namespace
-> ElemName -> a' -> [(Text, VDom a' w')] -> VDom a' w'
forall a w.
Maybe Namespace -> ElemName -> a -> [(Text, VDom a w)] -> VDom a w
Keyed Maybe Namespace
ns'm ElemName
en (a -> a'
fm a
props) (((Text, VDom a w) -> (Text, VDom a' w'))
-> [(Text, VDom a w)] -> [(Text, VDom a' w')]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((VDom a w -> VDom a' w') -> (Text, VDom a w) -> (Text, VDom a' w')
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 ((a -> a') -> (w -> VDom a' w') -> VDom a w -> VDom a' w'
forall a a' w w'.
(a -> a') -> (w -> VDom a' w') -> VDom a w -> VDom a' w'
renderWidget a -> a'
fm w -> VDom a' w'
injWidget)) [(Text, VDom a w)]
children)
  Widget w
w -> w -> VDom a' w'
injWidget w
w
  Grafted Graft a w
graft -> (a -> a') -> (w -> VDom a' w') -> VDom a w -> VDom a' w'
forall a a' w w'.
(a -> a') -> (w -> VDom a' w') -> VDom a w -> VDom a' w'
renderWidget a -> a'
fm w -> VDom a' w'
injWidget (Graft a w -> VDom a w
forall a w. Graft a w -> VDom a w
runGraft Graft a w
graft)