{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FunctionalDependencies #-}

module Web.Hyperbole.HyperView where

import Data.Kind (Type)
import Data.Text
import Text.Read
import Web.Hyperbole.Route (Route (..), pathUrl)
import Web.View


-- | Associate a live id with a set of actions
class (Param id, Param (Action id)) => HyperView id where
  type Action id :: Type


viewId :: forall id ctx. (HyperView id) => id -> View id () -> View ctx ()
viewId :: forall id ctx. HyperView id => id -> View id () -> View ctx ()
viewId id
vid View id ()
vw = do
  Mod -> View ctx () -> View ctx ()
forall c. Mod -> View c () -> View c ()
el (Name -> Name -> Mod
att Name
"id" (id -> Name
forall a. Param a => a -> Name
toParam id
vid) Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod
flexCol)
    (View ctx () -> View ctx ()) -> View ctx () -> View ctx ()
forall a b. (a -> b) -> a -> b
$ id -> View id () -> View ctx ()
forall context c. context -> View context () -> View c ()
addContext id
vid View id ()
vw


button :: (HyperView id) => Action id -> Mod -> View id () -> View id ()
button :: forall id.
HyperView id =>
Action id -> Mod -> View id () -> View id ()
button Action id
a Mod
f View id ()
cd = do
  id
c <- View id id
forall context. View context context
context
  Name -> Mod -> View id () -> View id ()
forall c. Name -> Mod -> View c () -> View c ()
tag Name
"button" (Name -> Name -> Mod
att Name
"data-on-click" (Action id -> Name
forall a. Param a => a -> Name
toParam Action id
a) Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. id -> Mod
forall a. Param a => a -> Mod
dataTarget id
c Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod
f) View id ()
cd


onRequest :: View id () -> View id () -> View id ()
onRequest :: forall id. View id () -> View id () -> View id ()
onRequest View id ()
a View id ()
b = do
  Mod -> View id () -> View id ()
forall c. Mod -> View c () -> View c ()
el (Name -> Mod -> Mod
parent Name
"hyp-loading" Mod
flexCol Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod
hide) View id ()
a
  Mod -> View id () -> View id ()
forall c. Mod -> View c () -> View c ()
el (Name -> Mod -> Mod
parent Name
"hyp-loading" Mod
hide Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod
flexCol) View id ()
b


-- | Internal
dataTarget :: (Param a) => a -> Mod
dataTarget :: forall a. Param a => a -> Mod
dataTarget = Name -> Name -> Mod
att Name
"data-target" (Name -> Mod) -> (a -> Name) -> a -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Name
forall a. Param a => a -> Name
toParam


-- | Change the target of any code running inside, allowing actions to target other live views on the page
target :: (HyperView id) => id -> View id () -> View a ()
target :: forall id ctx. HyperView id => id -> View id () -> View ctx ()
target = id -> View id () -> View a ()
forall context c. context -> View context () -> View c ()
addContext


dropdown
  :: (HyperView id)
  => (opt -> action)
  -> (opt -> Bool)
  -> Mod
  -> View (Option opt id action) ()
  -> View id ()
dropdown :: forall id opt action.
HyperView id =>
(opt -> action)
-> (opt -> Bool)
-> Mod
-> View (Option opt id action) ()
-> View id ()
dropdown opt -> action
toAction opt -> Bool
isSel Mod
f View (Option opt id action) ()
options = do
  id
c <- View id id
forall context. View context context
context
  Name -> Mod -> View id () -> View id ()
forall c. Name -> Mod -> View c () -> View c ()
tag Name
"select" (Name -> Name -> Mod
att Name
"data-on-change" Name
"" Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. id -> Mod
forall a. Param a => a -> Mod
dataTarget id
c Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod
f) (View id () -> View id ()) -> View id () -> View id ()
forall a b. (a -> b) -> a -> b
$ do
    Option opt id action
-> View (Option opt id action) () -> View id ()
forall context c. context -> View context () -> View c ()
addContext ((opt -> action) -> (opt -> Bool) -> Option opt id action
forall {k} opt (id :: k) action.
(opt -> action) -> (opt -> Bool) -> Option opt id action
Option opt -> action
toAction opt -> Bool
isSel) View (Option opt id action) ()
options


option
  :: (HyperView id, Eq opt)
  => opt
  -> View (Option opt id (Action id)) ()
  -> View (Option opt id (Action id)) ()
option :: forall id opt.
(HyperView id, Eq opt) =>
opt
-> View (Option opt id (Action id)) ()
-> View (Option opt id (Action id)) ()
option opt
opt View (Option opt id (Action id)) ()
cnt = do
  Option opt id (Action id)
os <- View (Option opt id (Action id)) (Option opt id (Action id))
forall context. View context context
context
  Name
-> Mod
-> View (Option opt id (Action id)) ()
-> View (Option opt id (Action id)) ()
forall c. Name -> Mod -> View c () -> View c ()
tag Name
"option" (Name -> Name -> Mod
att Name
"value" (Action id -> Name
forall a. Param a => a -> Name
toParam (Option opt id (Action id)
os.toAction opt
opt)) Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Mod
selected (Option opt id (Action id)
os.selected opt
opt)) View (Option opt id (Action id)) ()
cnt


selected :: Bool -> Mod
selected :: Bool -> Mod
selected Bool
b = if Bool
b then Name -> Name -> Mod
att Name
"selected" Name
"true" else Mod
forall a. a -> a
id


data Option opt id action = Option
  { forall {k} opt (id :: k) action.
Option opt id action -> opt -> action
toAction :: opt -> action
  , forall {k} opt (id :: k) action.
Option opt id action -> opt -> Bool
selected :: opt -> Bool
  }


class Param a where
  -- not as flexible as FromHttpApiData, but derivable
  parseParam :: Text -> Maybe a
  default parseParam :: (Read a) => Text -> Maybe a
  parseParam = String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (Name -> String) -> Name -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
unpack


  toParam :: a -> Text
  default toParam :: (Show a) => a -> Text
  toParam = String -> Name
pack (String -> Name) -> (a -> String) -> a -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show


instance Param Integer
instance Param Float
instance Param Int
instance Param ()


instance Param Text where
  parseParam :: Name -> Maybe Name
parseParam = Name -> Maybe Name
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  toParam :: Name -> Name
toParam = Name -> Name
forall a. a -> a
id


link :: (Route a) => a -> Mod -> View c () -> View c ()
link :: forall a c. Route a => a -> Mod -> View c () -> View c ()
link a
r Mod
f View c ()
cnt = do
  let Url Name
u = Path -> Url
pathUrl (Path -> Url) -> (a -> Path) -> a -> Url
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Path
forall a. Route a => a -> Path
routePath (a -> Url) -> a -> Url
forall a b. (a -> b) -> a -> b
$ a
r
  Name -> Mod -> View c () -> View c ()
forall c. Name -> Mod -> View c () -> View c ()
tag Name
"a" (Name -> Name -> Mod
att Name
"href" Name
u Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod
f) View c ()
cnt