{-# LANGUAGE 
    ScopedTypeVariables
  , TypeFamilies
#-}

-- | This module provides helper functions for HTML input elements. These helper functions are not specific to any particular web framework or html library.
--
-- For unnamed (enumerated) formlets, see @Ditto.Generalized.Unnamed@

module Ditto.Generalized.Named
  ( G.Choice(..)
  , input
  , inputMaybe
  , inputNoData
  , inputFile
  , inputMulti
  , inputChoice
  , inputList
  , label
  , errors
  , childErrors
  , withErrors
  , G.withChildErrors
  , ireq
  , iopt
  ) where

import Ditto.Backend
import Ditto.Core
import Ditto.Types
import Data.Text (Text)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Ditto.Generalized.Internal as G

-- | used for constructing elements like @\<input type=\"text\"\>@, which pure a single input value.
input :: (Environment m input, FormError input err) 
  => Text 
  -> (input -> Either err a) 
  -> (FormId -> a -> view) 
  -> a 
  -> Form m input err view a
input :: Text
-> (input -> Either err a)
-> (FormId -> a -> view)
-> a
-> Form m input err view a
input Text
name = FormState m FormId
-> (input -> Either err a)
-> (FormId -> a -> view)
-> a
-> Form m input err view a
forall (m :: * -> *) input err a view.
(Environment m input, FormError input err) =>
FormState m FormId
-> (input -> Either err a)
-> (FormId -> a -> view)
-> a
-> Form m input err view a
G.input (Text -> FormState m FormId
forall (m :: * -> *). Monad m => Text -> FormState m FormId
getNamedFormId Text
name)

-- | used for elements like @\<input type=\"submit\"\>@ which are not always present in the form submission data.
inputMaybe :: (Environment m input, FormError input err)
  => Text
  -> (input -> Either err a)
  -> (FormId -> Maybe a -> view)
  -> Maybe a
  -> Form m input err view (Maybe a)
inputMaybe :: Text
-> (input -> Either err a)
-> (FormId -> Maybe a -> view)
-> Maybe a
-> Form m input err view (Maybe a)
inputMaybe Text
name = FormState m FormId
-> (input -> Either err a)
-> (FormId -> Maybe a -> view)
-> Maybe a
-> Form m input err view (Maybe a)
forall (m :: * -> *) input err a view.
(Monad m, FormError input err, Environment m input) =>
FormState m FormId
-> (input -> Either err a)
-> (FormId -> Maybe a -> view)
-> Maybe a
-> Form m input err view (Maybe a)
G.inputMaybe (Text -> FormState m FormId
forall (m :: * -> *). Monad m => Text -> FormState m FormId
getNamedFormId Text
name)

-- | used for elements like @\<input type=\"reset\"\>@ which take a value, but are never present in the form data set.
inputNoData :: (Environment m input)
  => Text
  -> (FormId -> view)
  -> Form m input err view ()
inputNoData :: Text -> (FormId -> view) -> Form m input err view ()
inputNoData Text
name = FormState m FormId -> (FormId -> view) -> Form m input err view ()
forall (m :: * -> *) view input err.
Monad m =>
FormState m FormId -> (FormId -> view) -> Form m input err view ()
G.inputNoData (Text -> FormState m FormId
forall (m :: * -> *). Monad m => Text -> FormState m FormId
getNamedFormId Text
name)

-- | used for @\<input type=\"file\"\>@
inputFile :: forall m input err view ft. (Environment m input, FormInput input, FormError input err, ft ~ FileType input, Monoid ft)
  => Text
  -> (FormId -> view)
  -> Form m input err view (FileType input)
inputFile :: Text -> (FormId -> view) -> Form m input err view (FileType input)
inputFile Text
name = FormState m FormId
-> (FormId -> view) -> Form m input err view (FileType input)
forall (m :: * -> *) ft input err view.
(Monad m, FormInput input, FormError input err,
 Environment m input, ft ~ FileType input, Monoid ft) =>
FormState m FormId
-> (FormId -> view) -> Form m input err view (FileType input)
G.inputFile (Text -> FormState m FormId
forall (m :: * -> *). Monad m => Text -> FormState m FormId
getNamedFormId Text
name)

-- | used for groups of checkboxes, @\<select multiple=\"multiple\"\>@ boxes
inputMulti :: forall m input err view a lbl. (FormError input err, FormInput input, Environment m input, Eq a)
  => Text
  -> [(a, lbl)] -- ^ value, label, initially checked
  -> (input -> Either err [a])
  -> (FormId -> [G.Choice lbl a] -> view) -- ^ function which generates the view
  -> (a -> Bool) -- ^ isChecked/isSelected initially
  -> Form m input err view [a]
inputMulti :: Text
-> [(a, lbl)]
-> (input -> Either err [a])
-> (FormId -> [Choice lbl a] -> view)
-> (a -> Bool)
-> Form m input err view [a]
inputMulti Text
name = FormState m FormId
-> [(a, lbl)]
-> (input -> Either err [a])
-> (FormId -> [Choice lbl a] -> view)
-> (a -> Bool)
-> Form m input err view [a]
forall (m :: * -> *) input err view a lbl.
(FormError input err, FormInput input, Environment m input,
 Eq a) =>
FormState m FormId
-> [(a, lbl)]
-> (input -> Either err [a])
-> (FormId -> [Choice lbl a] -> view)
-> (a -> Bool)
-> Form m input err view [a]
G.inputMulti (Text -> FormState m FormId
forall (m :: * -> *). Monad m => Text -> FormState m FormId
getNamedFormId Text
name)

-- | radio buttons, single @\<select\>@ boxes
inputChoice :: forall a m err input lbl view. (FormError input err, FormInput input, Environment m input, Eq a, Monoid view)
  => Text
  -> (a -> Bool) -- ^ is default
  -> NonEmpty (a, lbl) -- ^ value, label
  -> (input -> Either err a)
  -> (FormId -> [G.Choice lbl a] -> view) -- ^ function which generates the view
  -> Form m input err view a
inputChoice :: Text
-> (a -> Bool)
-> NonEmpty (a, lbl)
-> (input -> Either err a)
-> (FormId -> [Choice lbl a] -> view)
-> Form m input err view a
inputChoice Text
name = FormState m FormId
-> (a -> Bool)
-> NonEmpty (a, lbl)
-> (input -> Either err a)
-> (FormId -> [Choice lbl a] -> view)
-> Form m input err view a
forall a (m :: * -> *) err input lbl view.
(FormError input err, FormInput input, Monad m, Eq a, Monoid view,
 Environment m input) =>
FormState m FormId
-> (a -> Bool)
-> NonEmpty (a, lbl)
-> (input -> Either err a)
-> (FormId -> [Choice lbl a] -> view)
-> Form m input err view a
G.inputChoice (Text -> FormState m FormId
forall (m :: * -> *). Monad m => Text -> FormState m FormId
getNamedFormId Text
name)

-- | this is necessary in order to basically map over the decoding function
inputList :: forall m input err a view. (Monad m, FormError input err, Environment m input)
  => Text
  -> (input -> m (Either err [a])) -- ^ decoding function for the list
  -> ([view] -> view) -- ^ how to concatenate views
  -> [a] -- ^ initial values
  -> view -- ^ view to generate in the fail case
  -> (a -> Form m input err view a)
  -> Form m input err view [a]
inputList :: Text
-> (input -> m (Either err [a]))
-> ([view] -> view)
-> [a]
-> view
-> (a -> Form m input err view a)
-> Form m input err view [a]
inputList Text
name = FormState m FormId
-> (input -> m (Either err [a]))
-> ([view] -> view)
-> [a]
-> view
-> (a -> Form m input err view a)
-> Form m input err view [a]
forall (m :: * -> *) input err a view view'.
(Monad m, FormError input err, Environment m input) =>
FormState m FormId
-> (input -> m (Either err [a]))
-> ([view] -> view')
-> [a]
-> view'
-> (a -> Form m input err view a)
-> Form m input err view' [a]
G.inputList (Text -> FormState m FormId
forall (m :: * -> *). Monad m => Text -> FormState m FormId
getNamedFormId Text
name)

-- | used to create @\<label\>@ elements
label :: Environment m input
  => Text
  -> (FormId -> view)
  -> Form m input err view ()
label :: Text -> (FormId -> view) -> Form m input err view ()
label Text
name = FormState m FormId -> (FormId -> view) -> Form m input err view ()
forall (m :: * -> *) view input err.
Monad m =>
FormState m FormId -> (FormId -> view) -> Form m input err view ()
G.label (Text -> FormState m FormId
forall (m :: * -> *). Monad m => Text -> FormState m FormId
getNamedFormId Text
name)

-- | used to add a list of err messages to a 'Form'
--
-- This function automatically takes care of extracting only the
-- errors that are relevent to the form element it is attached to via
-- '<*' or '*>'.
errors :: Environment m input
  => ([err] -> view) -- ^ function to convert the err messages into a view
  -> Form m input err view ()
errors :: ([err] -> view) -> Form m input err view ()
errors = ([err] -> view) -> Form m input err view ()
forall (m :: * -> *) err view input.
Monad m =>
([err] -> view) -> Form m input err view ()
G.errors

-- | similar to 'errors' but includes err messages from children of the form as well.
childErrors :: Environment m input
  => ([err] -> view)
  -> Form m input err view ()
childErrors :: ([err] -> view) -> Form m input err view ()
childErrors = ([err] -> view) -> Form m input err view ()
forall (m :: * -> *) err view input.
Monad m =>
([err] -> view) -> Form m input err view ()
G.childErrors

-- | modify the view of a form based on its errors
withErrors :: Environment m input
  => (view -> [err] -> view)
  -> Form m input err view a
  -> Form m input err view a
withErrors :: (view -> [err] -> view)
-> Form m input err view a -> Form m input err view a
withErrors = (view -> [err] -> view)
-> Form m input err view a -> Form m input err view a
forall (m :: * -> *) view err input a.
Monad m =>
(view -> [err] -> view)
-> Form m input err view a -> Form m input err view a
G.withErrors

-- | a @Form@ with no @view@
ireq :: forall m input view err a. (Monoid view, Environment m input, FormError input err)
  => Text 
  -> (input -> Either err a)
  -> a
  -> Form m input err view a
ireq :: Text -> (input -> Either err a) -> a -> Form m input err view a
ireq Text
name input -> Either err a
fromInput a
initialValue = (input -> m (Either err a))
-> m a
-> FormState m (View err view, Result err (Proved a))
-> Form m input err view a
forall (m :: * -> *) input err view a.
(input -> m (Either err a))
-> m a
-> FormState m (View err view, Result err (Proved a))
-> Form m input err view a
Form (Either err a -> m (Either err a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either err a -> m (Either err a))
-> (input -> Either err a) -> input -> m (Either err a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. input -> Either err a
fromInput) (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
initialValue) (FormState m (View err view, Result err (Proved a))
 -> Form m input err view a)
-> FormState m (View err view, Result err (Proved a))
-> Form m input err view a
forall a b. (a -> b) -> a -> b
$ do
  FormId
i <- Text -> FormState m FormId
forall (m :: * -> *). Monad m => Text -> FormState m FormId
getNamedFormId Text
name
  Value input
v <- FormId -> FormState m (Value input)
forall (m :: * -> *) input.
Environment m input =>
FormId -> FormState m (Value input)
getFormInput' FormId
i
  case Value input
v of
    Value input
Default -> (View err view, Result err (Proved a))
-> FormState m (View err view, Result err (Proved a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( View err view
forall a. Monoid a => a
mempty
      , Proved a -> Result err (Proved a)
forall e ok. ok -> Result e ok
Ok ( Proved :: forall a. FormRange -> a -> Proved a
Proved
          { pos :: FormRange
pos = FormId -> FormRange
unitRange FormId
i
          , unProved :: a
unProved = a
initialValue
          } )
      )
    Found input
inp -> case input -> Either err a
fromInput input
inp of
      Right a
a -> (View err view, Result err (Proved a))
-> FormState m (View err view, Result err (Proved a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( View err view
forall a. Monoid a => a
mempty
        , Proved a -> Result err (Proved a)
forall e ok. ok -> Result e ok
Ok ( Proved :: forall a. FormRange -> a -> Proved a
Proved
            { pos :: FormRange
pos = FormId -> FormRange
unitRange FormId
i
            , unProved :: a
unProved = a
a
            } )
        )
      Left err
err -> (View err view, Result err (Proved a))
-> FormState m (View err view, Result err (Proved a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( View err view
forall a. Monoid a => a
mempty
        , [(FormRange, err)] -> Result err (Proved a)
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormId -> FormRange
unitRange FormId
i, err
err)]
        )
    Value input
Missing -> (View err view, Result err (Proved a))
-> FormState m (View err view, Result err (Proved a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( View err view
forall a. Monoid a => a
mempty
      , [(FormRange, err)] -> Result err (Proved a)
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormId -> FormRange
unitRange FormId
i, CommonFormError input -> err
forall input err.
FormError input err =>
CommonFormError input -> err
commonFormError (FormId -> CommonFormError input
forall input. FormId -> CommonFormError input
InputMissing FormId
i :: CommonFormError input) :: err)]
      )

-- | an optional @Form@ with no @view@
iopt :: forall m input view err a. (Monoid view, Environment m input, FormError input err)
  => Text 
  -> (input -> Either err a)
  -> Maybe a
  -> Form m input err view (Maybe a)
iopt :: Text
-> (input -> Either err a)
-> Maybe a
-> Form m input err view (Maybe a)
iopt Text
name input -> Either err a
fromInput Maybe a
initialValue = (input -> m (Either err (Maybe a)))
-> m (Maybe a)
-> FormState m (View err view, Result err (Proved (Maybe a)))
-> Form m input err view (Maybe a)
forall (m :: * -> *) input err view a.
(input -> m (Either err a))
-> m a
-> FormState m (View err view, Result err (Proved a))
-> Form m input err view a
Form (Either err (Maybe a) -> m (Either err (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either err (Maybe a) -> m (Either err (Maybe a)))
-> (input -> Either err (Maybe a))
-> input
-> m (Either err (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a) -> Either err a -> Either err (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either err a -> Either err (Maybe a))
-> (input -> Either err a) -> input -> Either err (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. input -> Either err a
fromInput) (Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
initialValue) (FormState m (View err view, Result err (Proved (Maybe a)))
 -> Form m input err view (Maybe a))
-> FormState m (View err view, Result err (Proved (Maybe a)))
-> Form m input err view (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
  FormId
i <- Text -> FormState m FormId
forall (m :: * -> *). Monad m => Text -> FormState m FormId
getNamedFormId Text
name
  Value input
v <- FormId -> FormState m (Value input)
forall (m :: * -> *) input.
Environment m input =>
FormId -> FormState m (Value input)
getFormInput' FormId
i
  case Value input
v of
    Value input
Default -> (View err view, Result err (Proved (Maybe a)))
-> FormState m (View err view, Result err (Proved (Maybe a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( View err view
forall a. Monoid a => a
mempty
      , Proved (Maybe a) -> Result err (Proved (Maybe a))
forall e ok. ok -> Result e ok
Ok ( Proved :: forall a. FormRange -> a -> Proved a
Proved
          { pos :: FormRange
pos = FormId -> FormRange
unitRange FormId
i
          , unProved :: Maybe a
unProved = Maybe a
initialValue
          } )
      )
    Found input
inp -> case input -> Either err a
fromInput input
inp of
      Right a
a -> (View err view, Result err (Proved (Maybe a)))
-> FormState m (View err view, Result err (Proved (Maybe a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( View err view
forall a. Monoid a => a
mempty
        , Proved (Maybe a) -> Result err (Proved (Maybe a))
forall e ok. ok -> Result e ok
Ok ( Proved :: forall a. FormRange -> a -> Proved a
Proved
            { pos :: FormRange
pos = FormId -> FormRange
unitRange FormId
i
            , unProved :: Maybe a
unProved = a -> Maybe a
forall a. a -> Maybe a
Just a
a
            } )
        )
      Left err
err -> (View err view, Result err (Proved (Maybe a)))
-> FormState m (View err view, Result err (Proved (Maybe a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( View err view
forall a. Monoid a => a
mempty
        , [(FormRange, err)] -> Result err (Proved (Maybe a))
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormId -> FormRange
unitRange FormId
i, err
err)]
        )
    Value input
Missing -> (View err view, Result err (Proved (Maybe a)))
-> FormState m (View err view, Result err (Proved (Maybe a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( View err view
forall a. Monoid a => a
mempty
      , Proved (Maybe a) -> Result err (Proved (Maybe a))
forall e ok. ok -> Result e ok
Ok ( Proved :: forall a. FormRange -> a -> Proved a
Proved
          { pos :: FormRange
pos = FormId -> FormRange
unitRange FormId
i
          , unProved :: Maybe a
unProved = Maybe a
forall a. Maybe a
Nothing
          } )
      )