{-# 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


{- | HyperViews are interactive subsections of a 'Page'

Create an instance with a unique view id type and a sum type describing the actions the HyperView supports. The View Id can contain context (a database id, for example)

@
data Message = Message Int
  deriving (Generic, 'Param')

data MessageAction
  = Louder Text
  | ClearMessage
  deriving (Generic, 'Param')

instance HyperView Message where
  type Action Message = MessageAction
@
-}
class (Param id, Param (Action id)) => HyperView id where
  type Action id :: Type


{- | Embed HyperViews into the page, or nest them into other views

@
myPage :: ('Hyperbole' :> es) => 'Page' es 'Response'
myPage = do
  'handle' messages
  'load' $ do
    pure $ do
      'el_' "My Page"
      'hyper' (Message 1) $ messageView "Hello World"
      'hyper' (Message 2) $ do
        messageView "Another Message"
        'hyper' OtherView otherView
@

Views can only trigger actions that match their HyperView

@
messageView :: Text -> View Message ()
messageView m = do
  el_ (text m)
  button (Louder m) "Louder"

otherView :: View OtherView ()
otherView = do
  -- Type Error!
  button (Louder \"Hi\") id "Louder"
@
-}
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\> HTML tag which sends the action when pressed

> button SomeAction (border 1) "Click Me"
-}
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


{- | Send the action after N milliseconds. Can be used to implement lazy loading or polling

@
pollMessageView :: Text -> 'View' Message ()
pollMessageView m = do
  onLoad LoadMessage 1000 $ do
    'el' 'bold' "Current Message. Reloading in 1s"
    'el_' ('text' m)
@
-}
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


{- | Give visual feedback when an action is in-flight.

@
myView = do
  onRequest loadingIndicator $ do
    'el_' \"Loaded\"
  where
    loadingIndicator = 'el_' "Loading..."
@
-}
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


{- | Trigger actions for another view. They will update the view specified

> otherView :: View OtherView ()
> otherView = do
>   el_ "This is not a message view"
>   button OtherAction id "Do Something"
>
>   target (Message 2) $ do
>     el_ "Now we can trigger a MessageAction which will update our Message HyperView, not this one"
>     button ClearMessage id "Clear Message #2"
-}
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


{- | Type-safe dropdown. Sends (opt -> Action id) when selected. The selection predicate (opt -> Bool) controls which option is selected. See [Example.Contacts](https://github.com/seanhess/hyperbole/blob/main/example/Example/Contacts.hs)

@
data ContactsAction
  = Reload (Maybe Filter)
  | Delete Int
  deriving (Generic, Param)

allContactsView :: Maybe Filter -> View Contacts ()
allContactsView fil = do
  row (gap 10) $ do
    el (pad 10) "Filter: "
    dropdown Reload (== fil) id $ do
      option Nothing ""
      option (Just Active) "Active!"
      option (Just Inactive) "Inactive"
  ...
@
-}
dropdown
  :: (HyperView id)
  => (opt -> Action id)
  -> (opt -> Bool) -- check if selec
  -> 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


-- | An option for a 'dropdown'. First argument is passed to (opt -> Action id) in the 'dropdown', and to the selected predicate
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


-- | sets selected = true if the 'dropdown' predicate returns True
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


-- | The view context for an 'option'
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
  }


{- | Types that can be serialized. 'HyperView' requires this for both its view id and action

> data Message = Message Int
>   deriving (Generic, Param)
-}
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


  -- not as flexible as FromHttpApiData, but derivable
  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)


-- do we add the datatypename? no, the constructor name
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


-- instance {-# OVERLAPPABLE #-} (Show a, Read a) => GParam (K1 R a) where
--   gToParam (K1 a) = pack $ show a
--   gParseParam t = do
--     K1 <$> readMaybe (unpack 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 (GParam f) => GParam (M1 C c f) where
--   gForm = M1 gForm

-- where
--  toDouble '\'' = '\"'
--  toDouble c = c

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


{- | A hyperlink to another route

>>> route (User 100) id "View User"
<a href="/user/100">View User</a>
-}
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)