{-# LANGUAGE DefaultSignatures #-}
module Web.Hyperbole.HyperView where
import Control.Applicative ((<|>))
import Control.Monad (guard)
import Data.Kind (Type)
import Data.Text (Text, pack, unpack)
import Data.Text qualified as T
import GHC.Generics
import Text.Read
import Web.Hyperbole.Route (Route (..), routeUrl)
import Web.View
class (Param id, Param (Action id)) => HyperView id where
type Action id :: Type
hyper :: forall id ctx. (HyperView id) => id -> View id () -> View ctx ()
hyper :: forall id ctx. HyperView id => id -> View id () -> View ctx ()
hyper 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
onLoad :: (HyperView id) => Action id -> DelayMs -> View id () -> View id ()
onLoad :: forall id.
HyperView id =>
Action id -> DelayMs -> View id () -> View id ()
onLoad Action id
a DelayMs
delay View id ()
initContent = do
id
c <- View id id
forall context. View context context
context
Mod -> View id () -> View id ()
forall c. Mod -> View c () -> View c ()
el (Name -> Name -> Mod
att Name
"data-on-load" (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
. Name -> Name -> Mod
att Name
"data-delay" (DelayMs -> Name
forall a. Param a => a -> Name
toParam DelayMs
delay) Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. id -> Mod
forall a. Param a => a -> Mod
dataTarget id
c) View id ()
initContent
type DelayMs = Int
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
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
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 id)
-> (opt -> Bool)
-> Mod
-> View (Option opt id (Action id)) ()
-> View id ()
dropdown :: forall id opt.
HyperView id =>
(opt -> Action id)
-> (opt -> Bool)
-> Mod
-> View (Option opt id (Action id)) ()
-> View id ()
dropdown opt -> Action id
toAction opt -> Bool
isSel Mod
f View (Option opt id (Action id)) ()
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 id)
-> View (Option opt id (Action id)) () -> View id ()
forall context c. context -> View context () -> View c ()
addContext ((opt -> Action id) -> (opt -> Bool) -> Option opt id (Action id)
forall {k} opt (id :: k) action.
(opt -> action) -> (opt -> Bool) -> Option opt id action
Option opt -> Action id
toAction opt -> Bool
isSel) View (Option opt id (Action id)) ()
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
toParam :: a -> Text
default toParam :: (Generic a, GParam (Rep a)) => a -> Text
toParam = Rep a Any -> Name
forall p. Rep a p -> Name
forall {k} (f :: k -> *) (p :: k). GParam f => f p -> Name
gToParam (Rep a Any -> Name) -> (a -> Rep a Any) -> a -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from
parseParam :: Text -> Maybe a
default parseParam :: (Generic a, GParam (Rep a)) => Text -> Maybe a
parseParam Name
t = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Maybe (Rep a Any) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe (Rep a Any)
forall p. Name -> Maybe (Rep a p)
forall {k} (f :: k -> *) (p :: k). GParam f => Name -> Maybe (f p)
gParseParam Name
t
class GParam f where
gToParam :: f p -> Text
gParseParam :: Text -> Maybe (f p)
instance (GParam f, GParam g) => GParam (f :*: g) where
gToParam :: forall (p :: k). (:*:) f g p -> Name
gToParam (f p
a :*: g p
b) = f p -> Name
forall (p :: k). f p -> Name
forall {k} (f :: k -> *) (p :: k). GParam f => f p -> Name
gToParam f p
a Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"-" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> g p -> Name
forall (p :: k). g p -> Name
forall {k} (f :: k -> *) (p :: k). GParam f => f p -> Name
gToParam g p
b
gParseParam :: forall (p :: k). Name -> Maybe ((:*:) f g p)
gParseParam Name
t = do
let (Name
at, Name
bt) = Name -> (Name, Name)
breakSegment Name
t
f p
a <- Name -> Maybe (f p)
forall (p :: k). Name -> Maybe (f p)
forall {k} (f :: k -> *) (p :: k). GParam f => Name -> Maybe (f p)
gParseParam Name
at
g p
b <- Name -> Maybe (g p)
forall (p :: k). Name -> Maybe (g p)
forall {k} (f :: k -> *) (p :: k). GParam f => Name -> Maybe (f p)
gParseParam Name
bt
(:*:) f g p -> Maybe ((:*:) f g p)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((:*:) f g p -> Maybe ((:*:) f g p))
-> (:*:) f g p -> Maybe ((:*:) f g p)
forall a b. (a -> b) -> a -> b
$ f p
a f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
b
instance (GParam f, GParam g) => GParam (f :+: g) where
gToParam :: forall (p :: k). (:+:) f g p -> Name
gToParam (L1 f p
a) = f p -> Name
forall (p :: k). f p -> Name
forall {k} (f :: k -> *) (p :: k). GParam f => f p -> Name
gToParam f p
a
gToParam (R1 g p
b) = g p -> Name
forall (p :: k). g p -> Name
forall {k} (f :: k -> *) (p :: k). GParam f => f p -> Name
gToParam g p
b
gParseParam :: forall (p :: k). Name -> Maybe ((:+:) f g p)
gParseParam Name
t = do
(f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f p -> (:+:) f g p) -> Maybe (f p) -> Maybe ((:+:) f g p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) (p :: k). GParam f => Name -> Maybe (f p)
forall (f :: k -> *) (p :: k). GParam f => Name -> Maybe (f p)
gParseParam @f Name
t) Maybe ((:+:) f g p) -> Maybe ((:+:) f g p) -> Maybe ((:+:) f g p)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g p -> (:+:) f g p) -> Maybe (g p) -> Maybe ((:+:) f g p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) (p :: k). GParam f => Name -> Maybe (f p)
forall (f :: k -> *) (p :: k). GParam f => Name -> Maybe (f p)
gParseParam @g Name
t)
instance (Datatype d, GParam f) => GParam (M1 D d f) where
gToParam :: forall (p :: k). M1 D d f p -> Name
gToParam (M1 f p
a) = f p -> Name
forall (p :: k). f p -> Name
forall {k} (f :: k -> *) (p :: k). GParam f => f p -> Name
gToParam f p
a
gParseParam :: forall (p :: k). Name -> Maybe (M1 D d f p)
gParseParam Name
t = f p -> M1 D d f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D d f p) -> Maybe (f p) -> Maybe (M1 D d f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe (f p)
forall (p :: k). Name -> Maybe (f p)
forall {k} (f :: k -> *) (p :: k). GParam f => Name -> Maybe (f p)
gParseParam Name
t
instance (Constructor c, GParam f) => GParam (M1 C c f) where
gToParam :: forall (p :: k). M1 C c f p -> Name
gToParam (M1 f p
a) =
let cn :: Name
cn = String -> Name
toSegment (M1 C c f Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t c f a -> String
conName (M1 C c f p
forall {p :: k}. M1 C c f p
forall a. HasCallStack => a
undefined :: M1 C c f p))
in case f p -> Name
forall (p :: k). f p -> Name
forall {k} (f :: k -> *) (p :: k). GParam f => f p -> Name
gToParam f p
a of
Name
"" -> Name
cn
Name
t -> Name
cn Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"-" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
t
gParseParam :: forall (p :: k). Name -> Maybe (M1 C c f p)
gParseParam Name
t = do
let (Name
c, Name
rest) = Name -> (Name, Name)
breakSegment Name
t
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
toSegment (M1 C c f Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t c f a -> String
conName (M1 C c f p
forall {p :: k}. M1 C c f p
forall a. HasCallStack => a
undefined :: M1 C c f p))
f p -> M1 C c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 C c f p) -> Maybe (f p) -> Maybe (M1 C c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe (f p)
forall (p :: k). Name -> Maybe (f p)
forall {k} (f :: k -> *) (p :: k). GParam f => Name -> Maybe (f p)
gParseParam Name
rest
instance GParam U1 where
gToParam :: forall (p :: k). U1 p -> Name
gToParam U1 p
_ = Name
""
gParseParam :: forall (p :: k). Name -> Maybe (U1 p)
gParseParam Name
_ = U1 p -> Maybe (U1 p)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
U1
instance (GParam f) => GParam (M1 S s f) where
gToParam :: forall (p :: k). M1 S s f p -> Name
gToParam (M1 f p
a) = f p -> Name
forall (p :: k). f p -> Name
forall {k} (f :: k -> *) (p :: k). GParam f => f p -> Name
gToParam f p
a
gParseParam :: forall (p :: k). Name -> Maybe (M1 S s f p)
gParseParam Name
t = f p -> M1 S s f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 S s f p) -> Maybe (f p) -> Maybe (M1 S s f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe (f p)
forall (p :: k). Name -> Maybe (f p)
forall {k} (f :: k -> *) (p :: k). GParam f => Name -> Maybe (f p)
gParseParam Name
t
instance GParam (K1 R Text) where
gToParam :: forall (p :: k). K1 R Name p -> Name
gToParam (K1 Name
t) = Name
t
gParseParam :: forall (p :: k). Name -> Maybe (K1 R Name p)
gParseParam Name
t = K1 R Name p -> Maybe (K1 R Name p)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (K1 R Name p -> Maybe (K1 R Name p))
-> K1 R Name p -> Maybe (K1 R Name p)
forall a b. (a -> b) -> a -> b
$ Name -> K1 R Name p
forall k i c (p :: k). c -> K1 i c p
K1 Name
t
instance GParam (K1 R String) where
gToParam :: forall (p :: k). K1 R String p -> Name
gToParam (K1 String
s) = String -> Name
pack String
s
gParseParam :: forall (p :: k). Name -> Maybe (K1 R String p)
gParseParam Name
t = K1 R String p -> Maybe (K1 R String p)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (K1 R String p -> Maybe (K1 R String p))
-> K1 R String p -> Maybe (K1 R String p)
forall a b. (a -> b) -> a -> b
$ String -> K1 R String p
forall k i c (p :: k). c -> K1 i c p
K1 (String -> K1 R String p) -> String -> K1 R String p
forall a b. (a -> b) -> a -> b
$ Name -> String
unpack Name
t
instance {-# OVERLAPPABLE #-} (Param a) => GParam (K1 R a) where
gToParam :: forall (p :: k). K1 R a p -> Name
gToParam (K1 a
a) = a -> Name
forall a. Param a => a -> Name
toParam a
a
gParseParam :: forall (p :: k). Name -> Maybe (K1 R a p)
gParseParam Name
t = a -> K1 R a p
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 R a p) -> Maybe a -> Maybe (K1 R a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe a
forall a. Param a => Name -> Maybe a
parseParam Name
t
breakSegment :: Text -> (Text, Text)
breakSegment :: Name -> (Name, Name)
breakSegment Name
t =
let (Name
start, Name
rest) = HasCallStack => Name -> Name -> (Name, Name)
Name -> Name -> (Name, Name)
T.breakOn Name
"-" Name
t
in (Name
start, DelayMs -> Name -> Name
T.drop DelayMs
1 Name
rest)
toSegment :: String -> Text
toSegment :: String -> Name
toSegment = Name -> Name
T.toLower (Name -> Name) -> (String -> Name) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
pack
instance (Param a) => Param (Maybe a) where
toParam :: Maybe a -> Name
toParam Maybe a
Nothing = Name
""
toParam (Just a
a) = a -> Name
forall a. Param a => a -> Name
toParam a
a
parseParam :: Name -> Maybe (Maybe a)
parseParam Name
"" = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
parseParam Name
t = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (Maybe a -> Maybe (Maybe a)) -> Maybe a -> Maybe (Maybe a)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe a
forall a. Param a => Name -> Maybe a
parseParam Name
t
instance Param Integer where
toParam :: Integer -> Name
toParam = String -> Name
pack (String -> Name) -> (Integer -> String) -> Integer -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show
parseParam :: Name -> Maybe Integer
parseParam = String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer)
-> (Name -> String) -> Name -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
unpack
instance Param Float where
toParam :: Float -> Name
toParam = String -> Name
pack (String -> Name) -> (Float -> String) -> Float -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> String
forall a. Show a => a -> String
show
parseParam :: Name -> Maybe Float
parseParam = String -> Maybe Float
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Float) -> (Name -> String) -> Name -> Maybe Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
unpack
instance Param Int where
toParam :: DelayMs -> Name
toParam = String -> Name
pack (String -> Name) -> (DelayMs -> String) -> DelayMs -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DelayMs -> String
forall a. Show a => a -> String
show
parseParam :: Name -> Maybe DelayMs
parseParam = String -> Maybe DelayMs
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe DelayMs)
-> (Name -> String) -> Name -> Maybe DelayMs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
unpack
instance Param () where
toParam :: () -> Name
toParam = String -> Name
pack (String -> Name) -> (() -> String) -> () -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> String
forall a. Show a => a -> String
show
parseParam :: Name -> Maybe ()
parseParam = String -> Maybe ()
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe ()) -> (Name -> String) -> Name -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
unpack
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
route :: (Route a) => a -> Mod -> View c () -> View c ()
route :: forall a c. Route a => a -> Mod -> View c () -> View c ()
route a
r = Url -> Mod -> View c () -> View c ()
forall c. Url -> Mod -> View c () -> View c ()
link (a -> Url
forall a. Route a => a -> Url
routeUrl a
r)