<commit_before>{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
module Yesod.Form.MassInput
    ( inputList
    , massDivs
    , massTable
    ) where

import Yesod.Form.Types
import Yesod.Form.Functions
import Yesod.Form.Fields (boolField, FormMessage)
import Yesod.Widget (GGWidget, whamlet)
import Yesod.Message (RenderMessage)
import Yesod.Handler (newIdent, GGHandler)
import Text.Blaze (Html)
import Control.Monad.Trans.Class (lift)
import Data.Text (pack, Text)
import Control.Monad.Trans.RWS (get, put, ask)
import Data.Maybe (fromMaybe, catMaybes)
import Data.Text.Read (decimal)
import Control.Monad (liftM)
import Data.Either (partitionEithers)
import Data.Traversable (sequenceA)

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

down 0 = return ()
down i | i < 0 = error "called down with a negative number"
down i = do
    is <- get
    put $ IntCons 0 is
    down $ i - 1

up 0 = return ()
up i | i < 0 = error "called down with a negative number"
up i = do
    is <- get
    case is of
        IntSingle _ -> error "up on IntSingle"
        IntCons _ is' -> put is' >> newFormIdent >> return ()
    up $ i - 1

inputList :: (Monad mo, m ~ GGHandler sub master mo, xml ~ GGWidget master (GGHandler sub master mo) (), RenderMessage master FormMessage)
          => Html
          -> ([[FieldView xml]] -> xml)
          -> (Maybe a -> AForm ([FieldView xml] -> [FieldView xml]) master m a)
          -> (Maybe [a] -> AForm ([FieldView xml] -> [FieldView xml]) master m [a])
inputList label fixXml single mdef = formToAForm $ do
    theId <- lift newIdent
    down 1
    --countName <- newFormIdent
    let countName = "count"
    addName <- newFormIdent
    (menv, _, _) <- ask
    let readInt t =
            case decimal t of
                Right (i, "") -> Just i
                _ -> Nothing
    let vals =
            case menv of
                Nothing -> map Just $ fromMaybe [] mdef
                Just (env, _) ->
                    let toAdd = maybe False (const True) $ lookup addName env
                        count' = fromMaybe 0 $ lookup countName env >>= readInt
                        count = (if toAdd then 1 else 0) + count'
                     in replicate count Nothing
    let count = length vals
    (res, xmls, views) <- liftM fixme $ mapM (withDelete . single) vals
    up 1
    return (res, FieldView
        { fvLabel = label
        , fvTooltip = Nothing
        , fvId = pack theId
        , fvInput = [WHAMLET|
^{fixXml views}
<p>
    $forall xml <- xmls
        ^{xml}
    <input .count type=hidden name=#{countName} value=#{count}>
    <input type=checkbox name=#{addName}><commit_msg>Minor tweak<commit_after>{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
module Yesod.Form.MassInput
    ( inputList
    , massDivs
    , massTable
    ) where

import Yesod.Form.Types
import Yesod.Form.Functions
import Yesod.Form.Fields (boolField, FormMessage)
import Yesod.Widget (GGWidget, whamlet)
import Yesod.Message (RenderMessage)
import Yesod.Handler (newIdent, GGHandler)
import Text.Blaze (Html)
import Control.Monad.Trans.Class (lift)
import Data.Text (pack, Text)
import Control.Monad.Trans.RWS (get, put, ask)
import Data.Maybe (fromMaybe, catMaybes)
import Data.Text.Read (decimal)
import Control.Monad (liftM)
import Data.Either (partitionEithers)
import Data.Traversable (sequenceA)

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

down 0 = return ()
down i | i < 0 = error "called down with a negative number"
down i = do
    is <- get
    put $ IntCons 0 is
    down $ i - 1

up 0 = return ()
up i | i < 0 = error "called down with a negative number"
up i = do
    is <- get
    case is of
        IntSingle _ -> error "up on IntSingle"
        IntCons _ is' -> put is' >> newFormIdent >> return ()
    up $ i - 1

inputList :: (Monad mo, m ~ GGHandler sub master mo, xml ~ GGWidget master (GGHandler sub master mo) (), RenderMessage master FormMessage)
          => Html
          -> ([[FieldView xml]] -> xml)
          -> (Maybe a -> AForm ([FieldView xml] -> [FieldView xml]) master m a)
          -> (Maybe [a] -> AForm ([FieldView xml] -> [FieldView xml]) master m [a])
inputList label fixXml single mdef = formToAForm $ do
    theId <- lift newIdent
    down 1
    countName <- newFormIdent
    addName <- newFormIdent
    (menv, _, _) <- ask
    let readInt t =
            case decimal t of
                Right (i, "") -> Just i
                _ -> Nothing
    let vals =
            case menv of
                Nothing -> map Just $ fromMaybe [] mdef
                Just (env, _) ->
                    let toAdd = maybe False (const True) $ lookup addName env
                        count' = fromMaybe 0 $ lookup countName env >>= readInt
                        count = (if toAdd then 1 else 0) + count'
                     in replicate count Nothing
    let count = length vals
    (res, xmls, views) <- liftM fixme $ mapM (withDelete . single) vals
    up 1
    return (res, FieldView
        { fvLabel = label
        , fvTooltip = Nothing
        , fvId = pack theId
        , fvInput = [WHAMLET|
^{fixXml views}
<p>
    $forall xml <- xmls
        ^{xml}
    <input .count type=hidden name=#{countName} value=#{count}>
    <input type=checkbox name=#{addName}>
{'fraction_non_alphanumeric': 0.11037803138373752, 'fraction_numerical': 0.005349500713266762, 'mean_word_length': 2.370793269230769, 'pattern_counts': {'":': 0, '<': 29, '<?xml version=': 0, '>': 53, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 22}, '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': '5488309', 'n_tokens_mistral': 1844, 'n_tokens_neox': 1758, 'n_words': 603}