acms/frontend/app/Form/Internal.hs

module Form.Internal
  ( Form (..),
    mapValues,
    runForm,
    optional,
  )
where

import Data.Text qualified as T
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 i =
  form_ [onSubmit (either (\_ -> Left i) (Right) (form.fill i))] $
    (fmap Left <$> form.view i)
      <> [button_ [type_ "submit"] [text "submit"]]

class IsEmpty i where
  isEmpty :: i -> Bool

instance IsEmpty T.Text where
  isEmpty = T.null . T.strip

optional :: (IsEmpty i) => Form i o -> Form i (Maybe o)
optional form =
  Form
    { view = \i -> form.view i,
      fill = \i -> if isEmpty i then Right Nothing else Just <$> form.fill i
    }