<commit_before>{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
module Yesod.Form.Functions
    ( -- * Running in MForm monad
      newFormIdent
    , askParams
    , askFiles
      -- * Applicative/Monadic conversion
    , formToAForm
    , aFormToForm
    , mFormToWForm
    , wFormToAForm
    , wFormToMForm
      -- * Fields to Forms
    , wreq
    , wopt
    , mreq
    , mreqMsg
    , mopt
    , areq
    , aopt
      -- * Run a form
    , runFormPost
    , runFormPostNoToken
    , runFormGet
      -- * Generate a blank form
    , generateFormPost
    , generateFormGet'
    , generateFormGet
      -- * More than one form on a handler
    , identifyForm
      -- * Rendering
    , FormRender
    , renderTable
    , renderDivs
    , renderDivsNoLabels
    , renderBootstrap
    , renderBootstrap2
      -- * Validation
    , check
    , checkBool
    , checkM
    , checkMMap
    , customErrorMessage
      -- * Utilities
    , fieldSettingsLabel
    , parseHelper
    , parseHelperGen
    , convertField
    , addClass
    , removeClass
    ) where

import Yesod.Form.Types
import Data.Text (Text, pack)
import qualified Data.Text as T
import Control.Arrow (second)
import Control.Monad.Trans.Class
import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST, local, mapRWST)
import Control.Monad.Trans.Writer (runWriterT, writer)
import Control.Monad (liftM, join)
import Data.Byteable (constEqBytes)
import Text.Blaze (Markup, toMarkup)
#define Html Markup
#define toHtml toMarkup
import Yesod.Core
import Network.Wai (requestMethod)
import Data.Monoid (mempty, (<>))
import Data.Maybe (listToMaybe, fromMaybe)
import qualified Data.Map as Map
import qualified Data.Text.Encoding as TE
import Control.Arrow (first)

-- | Get a unique identifier.
newFormIdent :: Monad m => MForm m Text
newFormIdent = do
    i <- get
    let i' = incrInts i
    put i'
    return $ pack $ 'f' : show i'
  where
    incrInts (IntSingle i) = IntSingle $ i + 1
    incrInts (IntCons i is) = (i + 1) `IntCons` is

formToAForm :: (HandlerSite m ~ site, Monad m)
            => MForm m (FormResult a, [FieldView site])
            -> AForm m a
formToAForm form = AForm $ \(site, langs) env ints -> do
    ((a, xmls), ints', enc) <- runRWST form (env, site, langs) ints
    return (a, (++) xmls, ints', enc)

aFormToForm :: (Monad m, HandlerSite m ~ site)
            => AForm m a
            -> MForm m (FormResult a, [FieldView site] -> [FieldView site])
aFormToForm (AForm aform) = do
    ints <- get
    (env, site, langs) <- ask
    (a, xml, ints', enc) <- lift $ aform (site, langs) env ints
    put ints'
    tell enc
    return (a, xml)

askParams :: Monad m => MForm m (Maybe Env)
askParams = do
    (x, _, _) <- ask
    return $ liftM fst x

askFiles :: Monad m => MForm m (Maybe FileEnv)
askFiles = do
    (x, _, _) <- ask
    return $ liftM snd x

-- | Converts a form field into monadic form 'WForm'. This field requires a
-- value and will return 'FormFailure' if left empty.
--
-- @since 1.4.14
wreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
     => Field m a           -- ^ form field
     -> FieldSettings site  -- ^ settings for this field
     -> Maybe a             -- ^ optional default value
     -> WForm m (FormResult a)
wreq f fs = mFormToWForm . mreq f fs

-- | Converts a form field into monadic form 'WForm'. This field is optional,
-- i.e.  if filled in, it returns 'Just a', if left empty, it returns
-- 'Nothing'.  Arguments are the same as for 'wreq' (apart from type of default
-- value).
--
-- @since 1.4.14
wopt :: (MonadHandler m, HandlerSite m ~ site)
     => Field m a           -- ^ form field
     -> FieldSettings site  -- ^ settings for this field
     -> Maybe (Maybe a)     -- ^ optional default value
     -> WForm m (FormResult (Maybe a))
wopt f fs = mFormToWForm . mopt f fs

-- | Converts a monadic form 'WForm' into an applicative form 'AForm'.
--
-- @since 1.4.14
wFormToAForm :: MonadHandler m
             => WForm m (FormResult a)  -- ^ input form
             -> AForm m a               -- ^ output form
wFormToAForm = formToAForm . wFormToMForm

-- | Converts a monadic form 'WForm' into another monadic form 'MForm'.
--
-- @since 1.4.14
wFormToMForm :: (MonadHandler m, HandlerSite m ~ site)
             => WForm m a                      -- ^ input form
             -> MForm m (a, [FieldView site])  -- ^ output form
wFormToMForm = mapRWST (fmap group . runWriterT)
  where
    group ((a, ints, enctype), views) = ((a, views), ints, enctype)

-- | Converts a monadic form 'MForm' into another monadic form 'WForm'.
--
-- @since 1.4.14
mFormToWForm :: (MonadHandler m, HandlerSite m ~ site)
             => MForm m (a, FieldView site)  -- ^ input form
             -> WForm m a                    -- ^ output form
mFormToWForm = mapRWST $ \f -> do
  ((a, view), ints, enctype) <- lift f
  writer ((a, ints, enctype), [view])

-- | Converts a form field into monadic form. This field requires a value
-- and will return 'FormFailure' if left empty.
mreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
     => Field m a           -- ^ form field
     -> FieldSettings site  -- ^ settings for this field
     -> Maybe a             -- ^ optional default value
     -> MForm m (FormResult a, FieldView site)
mreq field fs mdef = mhelper field fs mdef (\m l -> FormFailure [renderMessage m l MsgValueRequired]) FormSuccess True

-- | Same as @mreq@ but with your own message to be rendered in case the value<commit_msg>Implement mreq in terms of mreqMsg<commit_after>{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
module Yesod.Form.Functions
    ( -- * Running in MForm monad
      newFormIdent
    , askParams
    , askFiles
      -- * Applicative/Monadic conversion
    , formToAForm
    , aFormToForm
    , mFormToWForm
    , wFormToAForm
    , wFormToMForm
      -- * Fields to Forms
    , wreq
    , wopt
    , mreq
    , mreqMsg
    , mopt
    , areq
    , aopt
      -- * Run a form
    , runFormPost
    , runFormPostNoToken
    , runFormGet
      -- * Generate a blank form
    , generateFormPost
    , generateFormGet'
    , generateFormGet
      -- * More than one form on a handler
    , identifyForm
      -- * Rendering
    , FormRender
    , renderTable
    , renderDivs
    , renderDivsNoLabels
    , renderBootstrap
    , renderBootstrap2
      -- * Validation
    , check
    , checkBool
    , checkM
    , checkMMap
    , customErrorMessage
      -- * Utilities
    , fieldSettingsLabel
    , parseHelper
    , parseHelperGen
    , convertField
    , addClass
    , removeClass
    ) where

import Yesod.Form.Types
import Data.Text (Text, pack)
import qualified Data.Text as T
import Control.Arrow (second)
import Control.Monad.Trans.Class
import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST, local, mapRWST)
import Control.Monad.Trans.Writer (runWriterT, writer)
import Control.Monad (liftM, join)
import Data.Byteable (constEqBytes)
import Text.Blaze (Markup, toMarkup)
#define Html Markup
#define toHtml toMarkup
import Yesod.Core
import Network.Wai (requestMethod)
import Data.Monoid (mempty, (<>))
import Data.Maybe (listToMaybe, fromMaybe)
import qualified Data.Map as Map
import qualified Data.Text.Encoding as TE
import Control.Arrow (first)

-- | Get a unique identifier.
newFormIdent :: Monad m => MForm m Text
newFormIdent = do
    i <- get
    let i' = incrInts i
    put i'
    return $ pack $ 'f' : show i'
  where
    incrInts (IntSingle i) = IntSingle $ i + 1
    incrInts (IntCons i is) = (i + 1) `IntCons` is

formToAForm :: (HandlerSite m ~ site, Monad m)
            => MForm m (FormResult a, [FieldView site])
            -> AForm m a
formToAForm form = AForm $ \(site, langs) env ints -> do
    ((a, xmls), ints', enc) <- runRWST form (env, site, langs) ints
    return (a, (++) xmls, ints', enc)

aFormToForm :: (Monad m, HandlerSite m ~ site)
            => AForm m a
            -> MForm m (FormResult a, [FieldView site] -> [FieldView site])
aFormToForm (AForm aform) = do
    ints <- get
    (env, site, langs) <- ask
    (a, xml, ints', enc) <- lift $ aform (site, langs) env ints
    put ints'
    tell enc
    return (a, xml)

askParams :: Monad m => MForm m (Maybe Env)
askParams = do
    (x, _, _) <- ask
    return $ liftM fst x

askFiles :: Monad m => MForm m (Maybe FileEnv)
askFiles = do
    (x, _, _) <- ask
    return $ liftM snd x

-- | Converts a form field into monadic form 'WForm'. This field requires a
-- value and will return 'FormFailure' if left empty.
--
-- @since 1.4.14
wreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
     => Field m a           -- ^ form field
     -> FieldSettings site  -- ^ settings for this field
     -> Maybe a             -- ^ optional default value
     -> WForm m (FormResult a)
wreq f fs = mFormToWForm . mreq f fs

-- | Converts a form field into monadic form 'WForm'. This field is optional,
-- i.e.  if filled in, it returns 'Just a', if left empty, it returns
-- 'Nothing'.  Arguments are the same as for 'wreq' (apart from type of default
-- value).
--
-- @since 1.4.14
wopt :: (MonadHandler m, HandlerSite m ~ site)
     => Field m a           -- ^ form field
     -> FieldSettings site  -- ^ settings for this field
     -> Maybe (Maybe a)     -- ^ optional default value
     -> WForm m (FormResult (Maybe a))
wopt f fs = mFormToWForm . mopt f fs

-- | Converts a monadic form 'WForm' into an applicative form 'AForm'.
--
-- @since 1.4.14
wFormToAForm :: MonadHandler m
             => WForm m (FormResult a)  -- ^ input form
             -> AForm m a               -- ^ output form
wFormToAForm = formToAForm . wFormToMForm

-- | Converts a monadic form 'WForm' into another monadic form 'MForm'.
--
-- @since 1.4.14
wFormToMForm :: (MonadHandler m, HandlerSite m ~ site)
             => WForm m a                      -- ^ input form
             -> MForm m (a, [FieldView site])  -- ^ output form
wFormToMForm = mapRWST (fmap group . runWriterT)
  where
    group ((a, ints, enctype), views) = ((a, views), ints, enctype)

-- | Converts a monadic form 'MForm' into another monadic form 'WForm'.
--
-- @since 1.4.14
mFormToWForm :: (MonadHandler m, HandlerSite m ~ site)
             => MForm m (a, FieldView site)  -- ^ input form
             -> WForm m a                    -- ^ output form
mFormToWForm = mapRWST $ \f -> do
  ((a, view), ints, enctype) <- lift f
  writer ((a, ints, enctype), [view])

-- | Converts a form field into monadic form. This field requires a value
-- and will return 'FormFailure' if left empty.
mreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
     => Field m a           -- ^ form field
     -> FieldSettings site  -- ^ settings for this field
     -> Maybe a             -- ^ optional default value
     -> MForm m (FormResult a, FieldView site)
mreq field fs mdef = mreqMsg field fs MsgValueRequired mdef

-- | Same as @mreq@ but with your own message to be rendered in case the value
{'fraction_non_alphanumeric': 0.11217835741980965, 'fraction_numerical': 0.0040535777229467745, 'mean_word_length': 2.396887159533074, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 62, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 8}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1767148', 'n_tokens_mistral': 3793, 'n_tokens_neox': 3693, 'n_words': 1280}