{-|
Module      : Handler.Utils.Delete
Description : Generic deletion from database after confirmation

`postDeleteR`, `getDeleteR`, and `deleteR` provide handlers for calling
`deleteCascade` on a `Set` of Record-`Key`s after asking for confirmation, which
currently entails asking the user to copy a text, which is dependent on the
records to be deleted (i.e. a comma-separated list of user names), into a
`Textarea`.
-}
module Handler.Utils.Delete
  ( DeleteRoute(..)
  , deleteR
  , postDeleteR, getDeleteR
  ) where

import Import
import Handler.Utils.Form

import qualified Data.Text as Text
import qualified Data.Set as Set

import qualified Data.CaseInsensitive as CI

import Data.Char (isAlphaNum)

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect)
import qualified Database.Esqueleto.Internal.Language as E (From)


data DeleteRoute record = forall tables infoExpr info. (E.SqlSelect infoExpr info, E.From E.SqlQuery E.SqlExpr SqlBackend tables) => DeleteRoute
  { drRecords :: Set (Key record) -- ^ Records to be deleted
  , drGetInfo :: tables -> E.SqlQuery infoExpr -- ^ SQL-Query to get necessary information to render identifing information about records to the user (`drRenderRecord`, `drRecordConfirmString`); @tables@ is an arbitrary join, see `E.from`; @infoExpr@ gets converted to @info@ by esqueleto
  , drUnjoin :: tables -> E.SqlExpr (Entity record) -- ^ `E.SqlExpr` of @Key record@ extracted from @tables@, `deleteR` restricts `drGetInfo` to `drRecords` automatically
  , drRenderRecord :: info -> ReaderT SqlBackend (HandlerT UniWorX IO) Widget -- ^ Present a single record, to be deleted, to the user for inspection prior to deletion
  , drRecordConfirmString :: info -> ReaderT SqlBackend (HandlerT UniWorX IO) Text -- ^ Text for the user to copy to confirm deletion; should probably contain all information from `drRenderRecord` so user gets prompted to think about what they're deleting
  , drCaption
  , drSuccessMessage :: SomeMessage UniWorX
  , drAbort
  , drSuccess :: SomeRoute UniWorX
  , drDelete :: forall a. Key record -> DB a -> DB a
  }

confirmForm :: ( MonadHandler m, HandlerSite m ~ UniWorX )
           => Text -- ^ Confirmation string
           -> AForm m Bool
confirmForm confirmString = flip traverseAForm aform $ \(inpConfirmStr, BtnDelete) -> if
  | ((==) `on` map (CI.mk . filter isAlphaNum) . Text.words) confirmString inpConfirmStr
    -> return $ pure True
  | otherwise
    -> formFailure [MsgDeleteConfirmationWrong]
  where
    aform = (,)
        <$> areq confirmField (fslI MsgDeleteConfirmation) Nothing
        <*> disambiguateButtons (combinedButtonFieldF "")
    confirmField
      | multiple  = convertField unTextarea Textarea textareaField
      | otherwise = textField
    multiple = length (filter (not . Text.null . Text.strip) $ Text.lines confirmString) > 1

confirmForm' :: PersistEntity record => Set (Key record) -> Text -> Form Bool
confirmForm' drRecords confirmString = addDeleteTargets . identifyForm FIDDelete . renderAForm FormStandard $ confirmForm confirmString
  where
    addDeleteTargets :: Form a -> Form a
    addDeleteTargets form csrf = do
      (_, fvTargets) <- mreq secretJsonField ("" & addName (toPathPiece PostDeleteTarget)) (Just drRecords)
      over _2 (mappend $ fvInput fvTargets) <$> form csrf


postDeleteR :: ( DeleteCascade record SqlBackend )
            => (Set (Key record) -> DeleteRoute record) -- ^ Construct `DeleteRoute` based on incoming record keys
            -> Handler ()
-- | Perform deletion
postDeleteR mkRoute = do
  drResult <- fmap (fmap mkRoute) . runInputPost . iopt secretJsonField $ toPathPiece PostDeleteTarget

  void . for drResult $ \DeleteRoute{..} -> do
    confirmString <- fmap Text.unlines . runDB $ mapM drRecordConfirmString <=< E.select . E.from $ \t -> drGetInfo t <* E.where_ (drUnjoin t E.^. persistIdField `E.in_` E.valList (Set.toList drRecords))

    ((confirmRes, _), _) <- runFormPost $ confirmForm' drRecords confirmString

    formResult confirmRes $ \case
      True -> do
        runDB $ do
          forM_ drRecords $ \k -> drDelete k $ deleteCascade k
          addMessageI Success drSuccessMessage
        redirect drSuccess
      False ->
        redirect drAbort


getDeleteR :: (DeleteCascade record SqlBackend) => DeleteRoute record -> Handler a
getDeleteR DeleteRoute{..} = do
  targets <- runDB $ mapM (\i -> (,) <$> drRenderRecord i <*> drRecordConfirmString i) <=< E.select . E.from $ \t -> drGetInfo t <* E.where_ (drUnjoin t E.^. persistIdField `E.in_` E.valList (Set.toList drRecords))

  let confirmString = Text.unlines $ view _2 <$> targets

  (deleteFormWdgt, deleteFormEnctype) <- generateFormPost $ confirmForm' drRecords confirmString

  Just targetRoute <- getCurrentRoute
  let deleteForm = wrapForm deleteFormWdgt def
        { formAction = Just $ SomeRoute targetRoute
        , formEncoding = deleteFormEnctype
        , formSubmit = FormNoSubmit
        }

  sendResponse =<<
    defaultLayout $(widgetFile "widgets/delete-confirmation/delete-confirmation")



deleteR :: (DeleteCascade record SqlBackend) => DeleteRoute record -> Handler Html
deleteR dr = do
  postDeleteR $ \drRecords -> dr {drRecords}
  getDeleteR dr