<commit_before>{-# OPTIONS_GHC -O0 #-}
{-# LANGUAGE TupleSections, OverloadedStrings, ExistentialQuantification #-}
module Handler.Admin.Board where

import           Import
import qualified Data.Text         as T
import           Handler.Delete    (deletePosts)
import           Utils.YobaMarkup  (doYobaMarkup)
import           Handler.Admin.Modlog (addModlogEntry) 
-------------------------------------------------------------------------------------------------------------
getManageBoardsR :: ManageBoardAction -> Text -> Handler Html
getManageBoardsR action board = do
  maybeBoard  <- runDB $ selectFirst [BoardName ==. board] []
  groups      <- map ((\x -> (x,x)) . groupName . entityVal) <$> runDB (selectList ([]::[Filter Group]) [])
  bCategories <- map (id &&& id) <$> getConfig configBoardCategories
  (formWidget, _) <- generateFormPost $ updateBoardForm maybeBoard action bCategories groups -- oops, ignored formEnctype
  boards          <- runDB $ selectList ([]::[Filter Board]) []
  defaultLayout $ do
    setUltDestCurrent
    defaultTitleMsg MsgBoardManagement
    $(widgetFile "admin/boards")
-------------------------------------------------------------------------------------------------------------    
updateBoardForm :: Maybe (Entity Board) -> -- ^ Selected board
                  ManageBoardAction    -> -- ^ What you are going to do
                  [(Text,Text)]        -> -- ^ Board categories
                  [(Text,Text)]        -> -- ^ User groups
                  Html                 -> -- ^ Extra
                  MForm Handler (FormResult BoardConfigurationForm, Widget)
updateBoardForm board action bCategories groups extra = do
  msgrender   <- getMessageRender
  let helper :: forall a. (Board -> a) -> a -> Maybe (Maybe a)
      helper g defaultValue
        | action == NewBoard = Just $ Just defaultValue
        | otherwise         = (Just . g . entityVal) <$> board
      -----------------------------------------------------------------------------
      bool2Text True  = Just $ Just "Enable"
      bool2Text False = Just $ Just "Disable"
      bool2Text :: Bool -> Maybe (Maybe Text)
      -----------------------------------------------------------------------------
      helper' g defaultValue
        | action == NewBoard = Just $ Just defaultValue
        | otherwise         = maybe Nothing (bool2Text . g . entityVal) board
      onoff     = map (first msgrender) [(MsgEnable,"Enable"),(MsgDisable,"Disable")]
      onoff     :: [(Text, Text)]
      onoffreq  = map (first msgrender) [(MsgEnable,"Enabled"),(MsgDisable,"Disabled"),(MsgRequired,"Required")]
      onoffreq  :: [(Text, Text)]
      -----------------------------------------------------------------------------
      helper'' :: forall a. (Board -> a) -> Maybe a
      helper'' g = (g . entityVal) <$> board
      
  (nameRes             , nameView             ) <- mopt textField     "" (helper boardName "")
  (titleRes            , titleView            ) <- mopt textField     "" (helper boardTitle "")
  (summaryRes          , summaryView          ) <- mopt textField     "" (helper boardSummary "")
  (bumpLimitRes        , bumpLimitView        ) <- mopt intField      "" (helper boardBumpLimit 500)
  (numberFilesRes      , numberFilesView      ) <- mopt intField      "" (helper boardNumberFiles 10)
  (allowedTypesRes     , allowedTypesView     ) <- mopt textField     "" (helper (pack . unwords . boardAllowedTypes) "jpg jpeg png gif webm swf rar zip 7z mp3 flaac ogv txt")
  (defaultNameRes      , defaultNameView      ) <- mopt textField     "" (helper boardDefaultName "Anonymous")
  (maxMsgLengthRes     , maxMsgLengthView     ) <- mopt intField      "" (helper boardMaxMsgLength 20000)
  (thumbSizeRes        , thumbSizeView        ) <- mopt intField      "" (helper boardThumbSize 200)
  (threadsPerPageRes   , threadsPerPageView   ) <- mopt intField      "" (helper boardThreadsPerPage 10)
  (previewsPerThreadRes, previewsPerThreadView) <- mopt intField      "" (helper boardPreviewsPerThread 5)
  (threadLimitRes      , threadLimitView      ) <- mopt intField      "" (helper boardThreadLimit (-1))
  (categoryRes         , categoryView         ) <- mopt (selectFieldList bCategories) "" (helper'' boardCategory)
  (opFileRes           , opFileView           ) <- mopt (selectFieldList onoffreq) "" (helper boardOpFile "Enabled")
  (replyFileRes        , replyFileView        ) <- mopt (selectFieldList onoffreq) "" (helper boardReplyFile "Enabled")
  (isHiddenRes         , isHiddenView         ) <- mopt (selectFieldList onoff) "" (helper'  boardHidden "Disable")
  (enableCaptchaRes    , enableCaptchaView    ) <- mopt (selectFieldList onoff) "" (helper'  boardEnableCaptcha "Disable")
  (viewAccessRes       , viewAccessView       ) <- mopt (multiSelectFieldList groups) "" (helper'' boardViewAccess)
  (replyAccessRes      , replyAccessView      ) <- mopt (multiSelectFieldList groups) "" (helper'' boardReplyAccess)
  (threadAccessRes     , threadAccessView     ) <- mopt (multiSelectFieldList groups) "" (helper'' boardThreadAccess)
  (opModerationRes     , opModerationView     ) <- mopt (selectFieldList onoff) "" (helper'  boardOpModeration "Enable")
  (extraRulesRes       , extraRulesView       ) <- mopt textareaField     "" (helper (Textarea . T.intercalate ";" . boardExtraRules) (Textarea ""))
  (enableGeoIpRes      , enableGeoIpView      ) <- mopt (selectFieldList onoff) "" (helper'  boardEnableGeoIp "Disable")
  (opEditingRes        , opEditingView        ) <- mopt (selectFieldList onoff) "" (helper'  boardOpEditing "Enable")
  (postEditingRes      , postEditingView      ) <- mopt (selectFieldList onoff) "" (helper'  boardPostEditing "Enable")
  (showEditHistoryRes  , showEditHistoryView  ) <- mopt (selectFieldList onoff) "" (helper'  boardShowEditHistory "Enable")
  (showPostDateRes     , showPostDateView     ) <- mopt (selectFieldList onoff) "" (helper'  boardShowPostDate "Enable")
  (enableForcedAnonRes , enableForcedAnonView ) <- mopt (selectFieldList onoff) "" (helper' boardEnableForcedAnon "Disable")
  (requiredThreadTitleRes, requiredThreadTitleView ) <- mopt (selectFieldList onoff) "" (helper' boardRequiredThreadTitle "Disable")
  (enablePMRes         , enablePMView         ) <- mopt (selectFieldList onoff) "" (helper' boardEnablePM "Disable")
  (indexRes            , indexView            ) <- mopt intField      "" (helper boardIndex 0)
  let result = BoardConfigurationForm <$><commit_msg>Update Board.hs<commit_after>{-# OPTIONS_GHC -O0 #-}
{-# LANGUAGE TupleSections, OverloadedStrings, ExistentialQuantification #-}
module Handler.Admin.Board where

import           Import
import qualified Data.Text         as T
import           Handler.Delete    (deletePosts)
import           Utils.YobaMarkup  (doYobaMarkup)
import           Handler.Admin.Modlog (addModlogEntry) 
-------------------------------------------------------------------------------------------------------------
getManageBoardsR :: ManageBoardAction -> Text -> Handler Html
getManageBoardsR action board = do
  maybeBoard  <- runDB $ selectFirst [BoardName ==. board] []
  groups      <- map ((\x -> (x,x)) . groupName . entityVal) <$> runDB (selectList ([]::[Filter Group]) [])
  bCategories <- map (id &&& id) <$> getConfig configBoardCategories
  (formWidget, _) <- generateFormPost $ updateBoardForm maybeBoard action bCategories groups -- oops, ignored formEnctype
  boards          <- runDB $ selectList ([]::[Filter Board]) []
  defaultLayout $ do
    setUltDestCurrent
    defaultTitleMsg MsgBoardManagement
    $(widgetFile "admin/boards")
-------------------------------------------------------------------------------------------------------------    
updateBoardForm :: Maybe (Entity Board) -> -- ^ Selected board
                  ManageBoardAction    -> -- ^ What you are going to do
                  [(Text,Text)]        -> -- ^ Board categories
                  [(Text,Text)]        -> -- ^ User groups
                  Html                 -> -- ^ Extra
                  MForm Handler (FormResult BoardConfigurationForm, Widget)
updateBoardForm board action bCategories groups extra = do
  msgrender   <- getMessageRender
  let helper :: forall a. (Board -> a) -> a -> Maybe (Maybe a)
      helper g defaultValue
        | action == NewBoard = Just $ Just defaultValue
        | otherwise         = (Just . g . entityVal) <$> board
      -----------------------------------------------------------------------------
      bool2Text True  = Just $ Just "Enable"
      bool2Text False = Just $ Just "Disable"
      bool2Text :: Bool -> Maybe (Maybe Text)
      -----------------------------------------------------------------------------
      helper' g defaultValue
        | action == NewBoard = Just $ Just defaultValue
        | otherwise         = maybe Nothing (bool2Text . g . entityVal) board
      onoff     = map (first msgrender) [(MsgEnable,"Enable"),(MsgDisable,"Disable")]
      onoff     :: [(Text, Text)]
      onoffreq  = map (first msgrender) [(MsgEnable,"Enabled"),(MsgDisable,"Disabled"),(MsgRequired,"Required")]
      onoffreq  :: [(Text, Text)]
      -----------------------------------------------------------------------------
      helper'' :: forall a. (Board -> a) -> Maybe a
      helper'' g = (g . entityVal) <$> board
      
  (nameRes             , nameView             ) <- mopt textField     "" (helper boardName "")
  (titleRes            , titleView            ) <- mopt textField     "" (helper boardTitle "")
  (summaryRes          , summaryView          ) <- mopt textField     "" (helper boardSummary "")
  (bumpLimitRes        , bumpLimitView        ) <- mopt intField      "" (helper boardBumpLimit 500)
  (numberFilesRes      , numberFilesView      ) <- mopt intField      "" (helper boardNumberFiles 10)
  (allowedTypesRes     , allowedTypesView     ) <- mopt textField     "" (helper (pack . unwords . boardAllowedTypes) "jpg jpeg png gif webm swf rar zip 7z mp3 flac ogv txt")
  (defaultNameRes      , defaultNameView      ) <- mopt textField     "" (helper boardDefaultName "Anonymous")
  (maxMsgLengthRes     , maxMsgLengthView     ) <- mopt intField      "" (helper boardMaxMsgLength 20000)
  (thumbSizeRes        , thumbSizeView        ) <- mopt intField      "" (helper boardThumbSize 200)
  (threadsPerPageRes   , threadsPerPageView   ) <- mopt intField      "" (helper boardThreadsPerPage 10)
  (previewsPerThreadRes, previewsPerThreadView) <- mopt intField      "" (helper boardPreviewsPerThread 5)
  (threadLimitRes      , threadLimitView      ) <- mopt intField      "" (helper boardThreadLimit (-1))
  (categoryRes         , categoryView         ) <- mopt (selectFieldList bCategories) "" (helper'' boardCategory)
  (opFileRes           , opFileView           ) <- mopt (selectFieldList onoffreq) "" (helper boardOpFile "Enabled")
  (replyFileRes        , replyFileView        ) <- mopt (selectFieldList onoffreq) "" (helper boardReplyFile "Enabled")
  (isHiddenRes         , isHiddenView         ) <- mopt (selectFieldList onoff) "" (helper'  boardHidden "Disable")
  (enableCaptchaRes    , enableCaptchaView    ) <- mopt (selectFieldList onoff) "" (helper'  boardEnableCaptcha "Disable")
  (viewAccessRes       , viewAccessView       ) <- mopt (multiSelectFieldList groups) "" (helper'' boardViewAccess)
  (replyAccessRes      , replyAccessView      ) <- mopt (multiSelectFieldList groups) "" (helper'' boardReplyAccess)
  (threadAccessRes     , threadAccessView     ) <- mopt (multiSelectFieldList groups) "" (helper'' boardThreadAccess)
  (opModerationRes     , opModerationView     ) <- mopt (selectFieldList onoff) "" (helper'  boardOpModeration "Enable")
  (extraRulesRes       , extraRulesView       ) <- mopt textareaField     "" (helper (Textarea . T.intercalate ";" . boardExtraRules) (Textarea ""))
  (enableGeoIpRes      , enableGeoIpView      ) <- mopt (selectFieldList onoff) "" (helper'  boardEnableGeoIp "Disable")
  (opEditingRes        , opEditingView        ) <- mopt (selectFieldList onoff) "" (helper'  boardOpEditing "Enable")
  (postEditingRes      , postEditingView      ) <- mopt (selectFieldList onoff) "" (helper'  boardPostEditing "Enable")
  (showEditHistoryRes  , showEditHistoryView  ) <- mopt (selectFieldList onoff) "" (helper'  boardShowEditHistory "Enable")
  (showPostDateRes     , showPostDateView     ) <- mopt (selectFieldList onoff) "" (helper'  boardShowPostDate "Enable")
  (enableForcedAnonRes , enableForcedAnonView ) <- mopt (selectFieldList onoff) "" (helper' boardEnableForcedAnon "Disable")
  (requiredThreadTitleRes, requiredThreadTitleView ) <- mopt (selectFieldList onoff) "" (helper' boardRequiredThreadTitle "Disable")
  (enablePMRes         , enablePMView         ) <- mopt (selectFieldList onoff) "" (helper' boardEnablePM "Disable")
  (indexRes            , indexView            ) <- mopt intField      "" (helper boardIndex 0)
  let result = BoardConfigurationForm <$>
{'fraction_non_alphanumeric': 0.17374874681884783, 'fraction_numerical': 0.00385594200663222, 'mean_word_length': 2.14680902693521, 'pattern_counts': {'":': 0, '<': 87, '<?xml version=': 0, '>': 41, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2187799', 'n_tokens_mistral': 3556, 'n_tokens_neox': 3383, 'n_words': 881}