<commit_before>{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
module Yesod.Form.Functions
    ( -- * Running in Form monad
      newFormIdent
    , askParams
    , askFiles
      -- * Applicative/Monadic conversion
    , formToAForm
    , aFormToForm
      -- * Fields to Forms
    , mreq
    , mopt
    , areq
    , aopt
      -- * Run a form
    , runFormPost
    , runFormPostNoNonce
    , runFormGet
      -- * Rendering
    , FormRender
    , renderTable
    , renderDivs
    ) where

import Yesod.Form.Types
import Data.Text (Text, pack)
import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST)
import Control.Monad.Trans.Class (lift)
import Control.Monad (liftM)
import Text.Blaze (Html)
import Yesod.Handler (GHandler, GGHandler, getRequest, runRequestBody)
import Yesod.Widget (GGWidget, whamlet)
import Yesod.Request (reqNonce, reqWaiRequest, reqGetParams)
import Network.Wai (requestMethod)
import Text.Hamlet.NonPoly (html)
import Data.Monoid (mempty)

#if __GLASGOW_HASKELL__ >= 700
#define WHAMLET whamlet
#define HTML html
#else
#define HTML $html
#define WHAMLET $whamlet
#endif

-- | Get a unique identifier.
newFormIdent :: Monad m => Form 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 :: Monad m => Form m (FormResult a, xml) -> AForm ([xml] -> [xml]) m a
formToAForm form = AForm $ \env ints -> do
    ((a, xml), ints', enc) <- runRWST form env ints
    return (a, (:) xml, ints', enc)

aFormToForm :: Monad m => AForm xml m a -> Form m (FormResult a, xml)
aFormToForm (AForm aform) = do
    ints <- get
    env <- ask
    (a, xml, ints', enc) <- lift $ aform env ints
    put ints'
    tell enc
    return (a, xml)

askParams :: Monad m => Form m (Maybe Env)
askParams = liftM (liftM fst) ask

askFiles :: Monad m => Form m (Maybe FileEnv)
askFiles = liftM (liftM snd) ask

mreq :: Monad m => Field xml a -> Maybe a -> Form m (FormResult a, xml)
mreq = undefined

mopt :: Monad m => Field xml a -> Maybe (Maybe a) -> Form m (FormResult (Maybe a), xml)
mopt = undefined

areq :: Monad m => Field xml a -> Maybe a -> AForm ([xml] -> [xml]) m a
areq a b = formToAForm $ mreq a b

aopt :: Monad m => Field xml a -> Maybe (Maybe a) -> AForm ([xml] -> [xml]) m (Maybe a)
aopt a b = formToAForm $ mopt a b<commit_msg>mreq and mopt<commit_after>{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Yesod.Form.Functions
    ( -- * Running in Form monad
      newFormIdent
    , askParams
    , askFiles
      -- * Applicative/Monadic conversion
    , formToAForm
    , aFormToForm
      -- * Fields to Forms
    , mreq
    , mopt
    , areq
    , aopt
      -- * Run a form
    , runFormPost
    , runFormPostNoNonce
    , runFormGet
      -- * Rendering
    , FormRender
    , renderTable
    , renderDivs
    ) where

import Yesod.Form.Types
import Data.Text (Text, pack)
import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST)
import Control.Monad.Trans.Class (lift)
import Control.Monad (liftM, join)
import Text.Blaze (Html, toHtml)
import Yesod.Handler (GHandler, GGHandler, getRequest, runRequestBody)
import Yesod.Widget (GGWidget, whamlet)
import Yesod.Request (reqNonce, reqWaiRequest, reqGetParams)
import Network.Wai (requestMethod)
import Text.Hamlet.NonPoly (html)
import Data.Monoid (mempty)
import Data.Maybe (fromMaybe)

#if __GLASGOW_HASKELL__ >= 700
#define WHAMLET whamlet
#define HTML html
#else
#define HTML $html
#define WHAMLET $whamlet
#endif

-- | Get a unique identifier.
newFormIdent :: Monad m => Form 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 :: Monad m => Form m (FormResult a, xml) -> AForm ([xml] -> [xml]) m a
formToAForm form = AForm $ \env ints -> do
    ((a, xml), ints', enc) <- runRWST form env ints
    return (a, (:) xml, ints', enc)

aFormToForm :: Monad m => AForm xml m a -> Form m (FormResult a, xml)
aFormToForm (AForm aform) = do
    ints <- get
    env <- ask
    (a, xml, ints', enc) <- lift $ aform env ints
    put ints'
    tell enc
    return (a, xml)

askParams :: Monad m => Form m (Maybe Env)
askParams = liftM (liftM fst) ask

askFiles :: Monad m => Form m (Maybe FileEnv)
askFiles = liftM (liftM snd) ask

mreq :: Monad m => Field xml a -> FieldSettings -> Maybe a -> Form m (FormResult a, FieldView xml)
mreq field fs mdef = mhelper field fs mdef (FormFailure ["Value is required"]) FormSuccess True -- TRANS

mopt :: Monad m => Field xml a -> FieldSettings -> Maybe (Maybe a) -> Form m (FormResult (Maybe a), FieldView xml)
mopt field fs mdef = mhelper field fs (join mdef) (FormSuccess Nothing) (FormSuccess . Just) False

mhelper :: Monad m
        => Field xml a
        -> FieldSettings
        -> Maybe a
        -> FormResult b -- ^ on missing
        -> (a -> FormResult b) -- ^ on success
        -> Bool -- ^ is it required?
        -> Form m (FormResult b, FieldView xml)
mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
    mp <- askParams
    name <- maybe newFormIdent return fsName
    theId <- maybe newFormIdent return fsId -- FIXME use widget ident for this
    let (res, val) =
            case mp of
                Nothing -> (FormMissing, maybe "" fieldRender mdef)
                Just p ->
                    case fromMaybe "" $ lookup name p of
                        "" -> (onMissing, "") -- TRANS
                        x -> (either (FormFailure . return) onFound $ fieldParse x, x)
    return (res, FieldView
        { fvLabel = fsLabel
        , fvTooltip = fsTooltip
        , fvId = theId
        , fvInput = fieldView theId name val isReq
        , fvErrors =
            case res of
                FormFailure [e] -> Just $ toHtml e
                _ -> Nothing
        , fvRequired = isReq
        })

areq :: Monad m => Field xml a -> FieldSettings -> Maybe a -> AForm ([FieldView xml] -> [FieldView xml]) m a
areq a b = formToAForm . mreq a b

aopt :: Monad m => Field xml a -> FieldSettings -> Maybe (Maybe a) -> AForm ([FieldView xml] -> [FieldView xml]) m (Maybe a)
aopt a b = formToAForm . mopt a b
{'fraction_non_alphanumeric': 0.1175283341096103, 'fraction_numerical': 0.0015525539512498058, 'mean_word_length': 2.592861126603458, 'pattern_counts': {'":': 0, '<': 16, '<?xml version=': 0, '>': 69, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 40}, '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': '2229122', 'n_tokens_mistral': 2245, 'n_tokens_neox': 2180, 'n_words': 767}