61 lines
1.2 KiB
Haskell
61 lines
1.2 KiB
Haskell
module Form.Internal
|
|
( Form (..),
|
|
mapValues,
|
|
runForm,
|
|
)
|
|
where
|
|
|
|
import Miso
|
|
|
|
data Form i o = Form
|
|
{ view :: i -> [View i],
|
|
fill :: i -> Either String o
|
|
}
|
|
|
|
instance Functor (Form i) where
|
|
fmap f (Form {view, fill}) =
|
|
Form
|
|
{ fill = fmap f . fill,
|
|
..
|
|
}
|
|
|
|
instance Applicative (Form i) where
|
|
pure x =
|
|
Form
|
|
{ view = const [],
|
|
fill = const (Right x)
|
|
}
|
|
|
|
f <*> x =
|
|
Form
|
|
{ view = liftA2 (<>) f.view x.view,
|
|
fill = \i -> ($) <$> f.fill i <*> x.fill i
|
|
}
|
|
|
|
instance Monad (Form i) where
|
|
form >>= mkForm =
|
|
Form
|
|
{ view = \i ->
|
|
form.view i
|
|
<> case form.fill i of
|
|
Right x -> (mkForm x).view i
|
|
Left _ -> [],
|
|
fill = \i -> case form.fill i of
|
|
Right x -> (mkForm x).fill i
|
|
Left e -> Left e
|
|
}
|
|
|
|
mapValues :: (i' -> i) -> (i -> i' -> i') -> Form i o -> Form i' o
|
|
mapValues get set (Form {view, fill}) =
|
|
Form
|
|
{ view = \i -> fmap (flip set i) <$> view (get i),
|
|
fill = fill . get
|
|
}
|
|
|
|
runForm :: Form i o -> i -> View (Either i o)
|
|
runForm (Form {view}) i =
|
|
div_ [] $
|
|
(fmap Left <$> view i)
|
|
<> [ button_ [type_ "submit"] [text "submit"]
|
|
]
|