{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Ditto.Lucid.Unnamed where
import Data.Foldable (traverse_, fold)
import Data.Monoid ((<>), mconcat, mempty)
import Data.Text (Text)
import Ditto.Backend
import Ditto.Core
import Ditto.Generalized as G
import Ditto.Lucid
import Ditto.Result (FormId, Result (Ok), unitRange)
import Lucid
import Web.PathPieces
import qualified Data.Text as T
import qualified Text.Read
foldTraverse_ :: (Foldable t, Applicative f, Monoid (f b)) => (a -> t (f b)) -> t a -> f ()
foldTraverse_ f = traverse_ (fold . f)
inputText
:: (Monad m, FormError error, PathPiece text, Applicative f)
=> (input -> Either error text)
-> text
-> Form m input error (HtmlT f ()) text
inputText getInput initialValue = G.input getInput inputField initialValue
where
inputField i a = input_ [type_ "text", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]
inputPassword
:: (Monad m, FormError error, PathPiece text, Applicative f)
=> (input -> Either error text)
-> text
-> Form m input error (HtmlT f ()) text
inputPassword getInput initialValue = G.input getInput inputField initialValue
where
inputField i a = input_ [type_ "password", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]
inputSubmit
:: (Monad m, FormError error, PathPiece text, Applicative f)
=> (input -> Either error text)
-> text
-> Form m input error (HtmlT f ()) (Maybe text)
inputSubmit getInput initialValue = G.inputMaybe getInput inputField initialValue
where
inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]
inputReset
:: (Monad m, FormError error, PathPiece text, Applicative f)
=> text
-> Form m input error (HtmlT f ()) ()
inputReset lbl = G.inputNoData inputField lbl
where
inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]
inputHidden
:: (Monad m, FormError error, PathPiece text, Applicative f)
=> (input -> Either error text)
-> text
-> Form m input error (HtmlT f ()) text
inputHidden getInput initialValue = G.input getInput inputField initialValue
where
inputField i a = input_ [type_ "hidden", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]
inputButton
:: (Monad m, FormError error, PathPiece text, Applicative f)
=> text
-> Form m input error (HtmlT f ()) ()
inputButton label = G.inputNoData inputField label
where
inputField i a = input_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]
textarea
:: (Monad m, FormError error, ToHtml text, Monad f)
=> (input -> Either error text)
-> Int -- ^ cols
-> Int -- ^ rows
-> text -- ^ initial text
-> Form m input error (HtmlT f ()) text
textarea getInput cols rows initialValue = G.input getInput textareaView initialValue
where
textareaView i txt =
textarea_
[ rows_ (toPathPiece rows)
, cols_ (toPathPiece cols)
, id_ (toPathPiece i)
, name_ (toPathPiece i)
] $
toHtml txt
-- | Create an @\@ element
--
-- This control may succeed even if the user does not actually select a file to upload. In that case the uploaded name will likely be \"\" and the file contents will be empty as well.
inputFile
:: (Monad m, FormError error, FormInput input, ErrorInputType error ~ input, Applicative f)
=> Form m input error (HtmlT f ()) (FileType input)
inputFile = G.inputFile fileView
where
fileView i = input_ [type_ "file", id_ (toPathPiece i), name_ (toPathPiece i)]
-- | Create a @\