<commit_before>{-# LANGUAGE QuasiQuotes         #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module LambdaCms.Media.Handler.MediaFile
       ( getMediaFileOverviewR
       , getMediaFileNewR
       , postMediaFileNewR
       , getMediaFileR
       , postMediaFileR
       , deleteMediaFileR
       , postMediaFileRenameR
       ) where

import LambdaCms.Media.Import
import qualified LambdaCms.Media.Message as Msg

import Text.Lucius (luciusFile)
import Data.Time (utctDay, getCurrentTime)
import Data.Text (pack, unpack)
import qualified Data.Text as T (split, concat)
import System.FilePath
import System.Directory

getMediaFileOverviewR :: MediaHandler Html
getMediaFileNewR      :: MediaHandler Html
postMediaFileNewR     :: MediaHandler Html
getMediaFileR         :: MediaFileId -> MediaHandler Html
postMediaFileR        :: MediaFileId -> MediaHandler Html
deleteMediaFileR      :: MediaFileId -> MediaHandler Html
postMediaFileRenameR  :: MediaFileId -> MediaHandler Html

getMediaFileOverviewR = do
  tp <- getRouteToParent
  y <- lift $ getYesod
  let sr = unpack $ staticRoot y
  (files :: [Entity MediaFile]) <- lift . runDB $ selectList [] []
  lift . adminLayout $ do
    setTitleI Msg.MediaOverview
    toWidget $(luciusFile "templates/media.lucius")
    $(whamletFile "templates/overview.hamlet")

getMediaFileNewR = do
  tp <- getRouteToParent
  (fWidget, enctype) <- lift $ generateFormPost uploadForm
  lift . adminLayout $ do
    setTitleI Msg.NewMedia
    $(whamletFile "templates/new.hamlet")

postMediaFileNewR = do
  ((results, fWidget), enctype) <- lift $ runFormPost uploadForm
  case results of
   FormSuccess (file, name, label, description) -> do
     ct <- liftIO getCurrentTime
     (location, ctype) <- upload file (unpack name)
     _ <- lift . runDB . insert $ MediaFile location ctype label description ct
     lift . setMessageI $ Msg.SaveSuccess label
     redirect MediaFileOverviewR
   _ -> do
     tp <- getRouteToParent
     lift . adminLayout $ do
       setTitleI Msg.NewMedia
       $(whamletFile "templates/new.hamlet")

getMediaFileR fileId = do
  tp <- getRouteToParent
  y <- lift $ getYesod
  let sr = unpack $ staticRoot y
  file <- lift . runDB $ get404 fileId
  (fWidget, enctype) <- lift . generateFormPost $ mediaFileForm file
  (rfWidget, rEnctype) <- lift . generateFormPost . renameForm $ mediaFileBaseName file
  lift . adminLayout $ do
    setTitle . toHtml $ mediaFileLabel file
    $(whamletFile "templates/edit.hamlet")

postMediaFileR fileId = do
  file <- lift . runDB $ get404 fileId
  ((results, fWidget), enctype) <- lift . runFormPost $ mediaFileForm file
  case results of
   FormSuccess mf -> do
     _ <- lift $ runDB $ update fileId [MediaFileLabel =. mediaFileLabel mf, MediaFileDescription =. mediaFileDescription mf]
     lift . setMessageI $ Msg.UpdateSuccess (mediaFileLabel mf)
     redirect $ MediaFileR fileId
   _ -> do
     tp <- getRouteToParent
     y <- lift $ getYesod
     let sr = unpack $ staticRoot y
     (rfWidget, rEnctype) <- lift . generateFormPost . renameForm $ mediaFileBaseName file
     lift . adminLayout $ do
       setTitle . toHtml $ mediaFileLabel file
       $(whamletFile "templates/edit.hamlet")

deleteMediaFileR fileId = do
  file <- lift . runDB $ get404 fileId
  isDeleted <- deleteMediaFile file fileId
  case isDeleted of
   True -> do
     lift . setMessageI $ Msg.DeleteSuccess (mediaFileLabel file)
     redirect MediaFileOverviewR
   False -> do
     lift . setMessageI $ Msg.DeleteFail (mediaFileLabel file)
     redirect $ MediaFileR fileId

postMediaFileRenameR fileId = do
  file <- lift . runDB $ get404 fileId
  ((results, rfWidget), rEnctype) <- lift . runFormPost . renameForm $ mediaFileBaseName file
  case results of
   FormSuccess nn
     | nn == (mediaFileBaseName file) -> do
         lift $ setMessageI Msg.RenameSuccess
         redirect $ MediaFileR fileId
     | otherwise -> do
         isRenamed <- renameMediaFile file fileId nn
         case isRenamed of
          True -> do
            lift $ setMessageI Msg.RenameSuccess
            redirect $ MediaFileR fileId
          False -> do
            lift $ setMessageI Msg.RenameFail
            redirect $ MediaFileR fileId
   _ -> do
     tp <- getRouteToParent
     y <- lift $ getYesod
     let sr = unpack $ staticRoot y
     (fWidget, enctype) <- lift . generateFormPost $ mediaFileForm file
     lift . adminLayout $ do
       setTitle . toHtml $ mediaFileLabel file
       $(whamletFile "templates/edit.hamlet")

uploadForm :: Form (FileInfo, Text, Text, Maybe Textarea)
uploadForm = renderBootstrap3 BootstrapBasicForm $ (,,,)
             <$> areq fileField (bfs Msg.Location) Nothing
             <*> areq textField (bfs Msg.NewFilename) Nothing
             <*> areq textField (bfs Msg.Label) Nothing
             <*> aopt textareaField (bfs Msg.Description) Nothing
             <*  bootstrapSubmit (BootstrapSubmit Msg.Upload " btn-success " [])

mediaFileForm :: MediaFile -> Form MediaFile
mediaFileForm mf = renderBootstrap3 BootstrapBasicForm $ MediaFile
                   <$> pure (mediaFileLocation mf)<commit_msg>Cleans up handlers<commit_after>{-# LANGUAGE QuasiQuotes         #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module LambdaCms.Media.Handler.MediaFile
       ( getMediaFileOverviewR
       , getMediaFileNewR
       , postMediaFileNewR
       , getMediaFileR
       , postMediaFileR
       , deleteMediaFileR
       , postMediaFileRenameR
       ) where

import LambdaCms.Media.Import
import qualified LambdaCms.Media.Message as Msg

import Text.Lucius (luciusFile)
import Data.Time (utctDay, getCurrentTime)
import Data.Text (pack, unpack)
import qualified Data.Text as T (split, concat)
import System.FilePath
import System.Directory

getMediaFileOverviewR :: MediaHandler Html
getMediaFileNewR      :: MediaHandler Html
postMediaFileNewR     :: MediaHandler Html
getMediaFileR         :: MediaFileId -> MediaHandler Html
postMediaFileR        :: MediaFileId -> MediaHandler Html
deleteMediaFileR      :: MediaFileId -> MediaHandler Html
postMediaFileRenameR  :: MediaFileId -> MediaHandler Html

getMediaFileOverviewR = do
  tp <- getRouteToParent
  lift $ do
    y <- getYesod
    let sr = unpack $ staticRoot y
    (files :: [Entity MediaFile]) <- runDB $ selectList [] []
    adminLayout $ do
      setTitleI Msg.MediaOverview
      toWidget $(luciusFile "templates/media.lucius")
      $(whamletFile "templates/overview.hamlet")

getMediaFileNewR = do
  tp <- getRouteToParent
  lift $ do
    (fWidget, enctype) <- generateFormPost uploadForm
    adminLayout $ do
      setTitleI Msg.NewMedia
      $(whamletFile "templates/new.hamlet")

postMediaFileNewR = do
  ((results, fWidget), enctype) <- lift $ runFormPost uploadForm
  case results of
   FormSuccess (file, name, label, description) -> do
     ct <- liftIO getCurrentTime
     (location, ctype) <- upload file (unpack name)
     _ <- lift . runDB . insert $ MediaFile location ctype label description ct
     lift . setMessageI $ Msg.SaveSuccess label
     redirect MediaFileOverviewR
   _ -> do
     tp <- getRouteToParent
     lift . adminLayout $ do
       setTitleI Msg.NewMedia
       $(whamletFile "templates/new.hamlet")

getMediaFileR fileId = do
  tp <- getRouteToParent
  lift $ do
    y <- getYesod
    let sr = unpack $ staticRoot y
    file <- runDB $ get404 fileId
    (fWidget, enctype) <- generateFormPost $ mediaFileForm file
    (rfWidget, rEnctype) <- generateFormPost . renameForm $ mediaFileBaseName file
    adminLayout $ do
      setTitle . toHtml $ mediaFileLabel file
      $(whamletFile "templates/edit.hamlet")

postMediaFileR fileId = do
  file <- lift . runDB $ get404 fileId
  ((results, fWidget), enctype) <- lift . runFormPost $ mediaFileForm file
  case results of
   FormSuccess mf -> do
     _ <- lift $ runDB $ update fileId [MediaFileLabel =. mediaFileLabel mf, MediaFileDescription =. mediaFileDescription mf]
     lift . setMessageI $ Msg.UpdateSuccess (mediaFileLabel mf)
     redirect $ MediaFileR fileId
   _ -> do
     tp <- getRouteToParent
     lift $ do
        y <- getYesod
        let sr = unpack $ staticRoot y
        (rfWidget, rEnctype) <- generateFormPost . renameForm $ mediaFileBaseName file
        adminLayout $ do
          setTitle . toHtml $ mediaFileLabel file
          $(whamletFile "templates/edit.hamlet")

deleteMediaFileR fileId = do
  file <- lift . runDB $ get404 fileId
  isDeleted <- deleteMediaFile file fileId
  case isDeleted of
   True -> do
     lift . setMessageI $ Msg.DeleteSuccess (mediaFileLabel file)
     redirect MediaFileOverviewR
   False -> do
     lift . setMessageI $ Msg.DeleteFail (mediaFileLabel file)
     redirect $ MediaFileR fileId

postMediaFileRenameR fileId = do
  file <- lift . runDB $ get404 fileId
  ((results, rfWidget), rEnctype) <- lift . runFormPost . renameForm $ mediaFileBaseName file
  case results of
   FormSuccess nn
     | nn == (mediaFileBaseName file) -> do
         lift $ setMessageI Msg.RenameSuccess
         redirect $ MediaFileR fileId
     | otherwise -> do
         isRenamed <- renameMediaFile file fileId nn
         case isRenamed of
          True -> do
            lift $ setMessageI Msg.RenameSuccess
            redirect $ MediaFileR fileId
          False -> do
            lift $ setMessageI Msg.RenameFail
            redirect $ MediaFileR fileId
   _ -> do
     tp <- getRouteToParent
     lift $ do
        y <- getYesod
        let sr = unpack $ staticRoot y
        (fWidget, enctype) <- generateFormPost $ mediaFileForm file
        adminLayout $ do
          setTitle . toHtml $ mediaFileLabel file
          $(whamletFile "templates/edit.hamlet")

uploadForm :: Form (FileInfo, Text, Text, Maybe Textarea)
uploadForm = renderBootstrap3 BootstrapBasicForm $ (,,,)
             <$> areq fileField (bfs Msg.Location) Nothing
             <*> areq textField (bfs Msg.NewFilename) Nothing
             <*> areq textField (bfs Msg.Label) Nothing
             <*> aopt textareaField (bfs Msg.Description) Nothing
             <*  bootstrapSubmit (BootstrapSubmit Msg.Upload " btn-success " [])

mediaFileForm :: MediaFile -> Form MediaFile
mediaFileForm mf = renderBootstrap3 BootstrapBasicForm $ MediaFile
                   <$> pure (mediaFileLocation mf)
{'fraction_non_alphanumeric': 0.08315077626440613, 'fraction_numerical': 0.0026669206591103914, 'mean_word_length': 2.833515881708653, 'pattern_counts': {'":': 0, '<': 73, '<?xml version=': 0, '>': 45, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, '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': '1991853', 'n_tokens_mistral': 3240, 'n_tokens_neox': 3093, 'n_words': 873}