module Handler.Material where

import Import

import Data.Monoid (Any(..))
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Conduit.List as C
-- import qualified Data.CaseInsensitive as CI
-- import qualified Data.Text.Encoding as Text

import qualified Database.Esqueleto as E
import Database.Esqueleto.Utils.TH

import Utils.Lens
import Utils.Form
import Handler.Utils
import Handler.Utils.Delete
import Handler.Utils.Table.Cells
import Handler.Utils.Table.Columns

import Control.Monad.Writer (MonadWriter(..), execWriterT)


data MaterialForm = MaterialForm
      { mfName         :: MaterialName
      , mfType         :: Maybe Text
      , mfDescription  :: Maybe Html
      , mfVisibleFrom  :: Maybe UTCTime
      , mfFiles        :: Maybe (Source Handler (Either FileId File))
      }

makeMaterialForm :: CourseId -> Maybe MaterialForm -> Form MaterialForm
makeMaterialForm cid template = identifyForm FIDmaterial $ \html -> do
  MsgRenderer mr <- getMsgRenderer
  let setIds :: Either FileId File -> Set FileId
      setIds = either Set.singleton $ const Set.empty
      oldFileIds
        | Just source <- template >>= mfFiles
                    = runConduit $ source .| C.foldMap setIds
        | otherwise = return Set.empty
      typeOptions :: WidgetT UniWorX IO (Set Text)
      typeOptions = do
        let defaults = Set.fromList $ map mr [MsgMaterialTypeSlides,MsgMaterialTypeCode,MsgMaterialTypeExample]
        previouslyUsed <- liftHandlerT . runDB $
          E.select $ E.from $ \material ->
            E.distinctOnOrderBy [E.asc $ material E.^. MaterialType] $ do
              E.where_ $ material E.^. MaterialCourse E.==. E.val cid
                   E.&&. E.not_ (E.isNothing $ material E.^. MaterialType)
              return $ material E.^. MaterialType
        return $ defaults <> Set.fromList (mapMaybe E.unValue previouslyUsed)

  now <- liftIO getCurrentTime
  let ctime = ceilingQuarterHour now
  let visibleToolTip = case mfVisibleFrom <$> template of
        (Just (Just vistime))  |  vistime <= now
          -> MsgMaterialVisibleFromEditWarning
        _ -> MsgMaterialVisibleFromTip

  flip (renderAForm FormStandard) html $ MaterialForm
      <$> areq ciField        (fslI MsgMaterialName)         (mfName        <$> template)
      <*> aopt (textField & addDatalist typeOptions)
                              (fslpI MsgMaterialType $ mr MsgMaterialTypePlaceholder)
                                                             (mfType        <$> template)
      <*> aopt htmlField      (fslpI MsgMaterialDescription "Html")
                                                             (mfDescription <$> template)
      <*> aopt utcTimeField   (fslI MsgMaterialVisibleFrom & setTooltip visibleToolTip)
                                                            ((mfVisibleFrom <$> template) <|> pure (Just ctime))
      <*> aopt (multiFileField oldFileIds)
                              (fslI MsgMaterialFiles)        (mfFiles <$> template)

getMaterialKeyBy404 :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> DB (Key Material)
getMaterialKeyBy404 tid ssh csh mnm = do
  cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
  getKeyBy404 $  UniqueMaterial cid mnm

fetchMaterial :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> DB (Entity Material)
fetchMaterial tid ssh csh mnm = do
  [matEnt] <- E.select . E.from  $ -- uniqueness guaranteed by DB constraints
    \(course `E.InnerJoin` material) -> do
      E.on     $ course   E.^. CourseId   E.==.   material E.^. MaterialCourse
      E.where_ $ course   E.^. CourseTerm      E.==. E.val tid
          E.&&.  course   E.^. CourseSchool    E.==. E.val ssh
          E.&&.  course   E.^. CourseShorthand E.==. E.val csh
          E.&&.  material E.^. MaterialName    E.==. E.val mnm
      return material
  return matEnt


getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getMaterialListR tid ssh csh = do
  let matLink :: MaterialName -> Route UniWorX
      matLink = CourseR tid ssh csh . flip MaterialR MShowR

      filesLink :: MaterialName -> Route UniWorX
      filesLink = CourseR tid ssh csh . flip MaterialR MArchiveR

      materialModDateCell :: IsDBTable m a => Material -> DBCell m a
      materialModDateCell Material{materialVisibleFrom, materialLastEdit}
        | NTop materialVisibleFrom >= NTop (Just materialLastEdit)
            = mempty -- empty cells mean no modification after publication
        | otherwise = dateTimeCell materialLastEdit -- modification after publication is highlighted by being shown

  now <- liftIO getCurrentTime
  seeAllModificationTimestamps <- hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- ordinary users should not see modification dates older than visibility
  table <- runDB $ do
    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
    let row2material = view $ _dbrOutput . _1 . _entityVal
        psValidator  = def & defaultSorting [SortDescBy "last-edit"]
    dbTableWidget' psValidator DBTable
      { dbtIdent     = "material-list" :: Text
      , dbtStyle     = def
      , dbtParams    = def
      , dbtSQLQuery  = \material -> do
          E.where_ $ material E.^. MaterialCourse  E.==.  E.val cid
          let filesNum = E.sub_select . E.from $ \materialFile -> do
                E.where_ $ materialFile E.^. MaterialFileMaterial E.==. material E.^. MaterialId
                return E.countRows :: E.SqlQuery (E.SqlExpr (E.Value Int64))
          return (material, filesNum)
      , dbtRowKey    = (E.^. MaterialId)
      -- , dbtProj      = \dbr -> guardAuthorizedFor (matLink . materialName $ dbr ^. _dbrOutput . _entityVal) dbr
      , dbtProj      = guardAuthorizedFor =<< matLink . materialName . row2material -- Moand: (a ->)
      , dbtColonnade = widgetColonnade $ mconcat
            [ -- dbRow,
              sortable (Just "type") (i18nCell MsgMaterialType)
                $ foldMap textCell . materialType . row2material
            , sortable (Just "name") (i18nCell MsgMaterialName)
                $ liftA2 anchorCell matLink toWgt . materialName . row2material
            , sortable (toNothingS "description") mempty
                $ foldMap modalCell . materialDescription . row2material
            , sortable (toNothingS "zip-archive") mempty
                $ \DBRow{ dbrOutput = (Entity _ Material{..}, E.Value fileNum) } -> if
                  | fileNum == 0 -> mempty
                  | otherwise    -> fileCell $ filesLink materialName
            , sortable (Just "visible-from") (i18nCell MsgAccessibleSince)
                $ foldMap (dateTimeCellVisible now) . materialVisibleFrom . row2material
            , sortable (Just "last-edit") (i18nCell MsgFileModified)
                $ if seeAllModificationTimestamps
                    then dateTimeCell . materialLastEdit . row2material
                    else materialModDateCell . row2material
            ]
      , dbtSorting   = Map.fromList
            [ ( "type"         , SortColumn (E.^. MaterialType)        )
            , ( "name"         , SortColumn (E.^. MaterialName)        )
            , ( "visible-from" , SortColumn (E.^. MaterialVisibleFrom) )
            , ( "last-edit"    , SortColumn (E.^. MaterialLastEdit)    )
            ]
      , dbtFilter    = mempty
      , dbtFilterUI  = mempty
      , dbtCsvEncode  = noCsvEncode
      , dbtCsvDecode  = Nothing
      }

  let headingLong  = prependCourseTitle tid ssh csh MsgMaterialListHeading
      headingShort = prependCourseTitle tid ssh csh MsgMaterialListHeading
  siteLayoutMsg headingLong $ do
    setTitleI headingShort
    $(widgetFile "material-list")




getMFileR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> FilePath -> Handler TypedContent
getMFileR tid ssh csh mnm title = serveOneFile $ fileQuery .| C.map entityVal
  where
    fileQuery = E.selectSource $ E.from $
      \(course `E.InnerJoin` material `E.InnerJoin` matFile `E.InnerJoin` file) -> do
        -- Restrict to consistent rows that correspond to each other
        E.on (file     E.^. FileId               E.==. matFile  E.^. MaterialFileFile)
        E.on (matFile  E.^. MaterialFileMaterial E.==. material E.^. MaterialId)
        E.on (material E.^. MaterialCourse       E.==. course   E.^. CourseId)
        -- filter to requested file
        E.where_ ((file      E.^. FileTitle       E.==. E.val title)
          E.&&.   (material  E.^. MaterialName    E.==. E.val mnm  )
          E.&&.   (course    E.^. CourseShorthand E.==. E.val csh  )
          E.&&.   (course    E.^. CourseSchool    E.==. E.val ssh  )
          E.&&.   (course    E.^. CourseTerm      E.==. E.val tid  )
          )
        -- return file entity
        return file

getMShowR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html
getMShowR tid ssh csh mnm = do
  let matLink :: FilePath -> Route UniWorX
      matLink = CourseR tid ssh csh . MaterialR mnm . MFileR

      zipLink :: Route UniWorX
      zipLink = CMaterialR tid ssh csh mnm MArchiveR

  seeAllModificationTimestamps <- hasReadAccessTo $ CourseR tid ssh csh CNotesR -- ordinary users should not see modification dates older than visibility

  ( Entity _mid material@Material{materialType, materialDescription}
    , (Any hasFiles,fileTable)) <- runDB $ do
    matEnt <- fetchMaterial tid ssh csh mnm
    let materialModDateCol :: (IsDBTable m c) => (t -> E.Value UTCTime) -> Colonnade Sortable t (DBCell m c)
        materialModDateCol = if seeAllModificationTimestamps
          then colFileModification
          else colFileModificationWhen $ \t -> NTop (Just t) > NTop (materialVisibleFrom $ entityVal matEnt)
    let psValidator = def & defaultSortingByFileTitle
    fileTable' <- dbTable psValidator DBTable
      { dbtSQLQuery = \(matFile `E.InnerJoin` file) -> do
            E.on     $ matFile E.^. MaterialFileFile     E.==. file E.^. FileId
            E.where_ $ matFile E.^. MaterialFileMaterial E.==. E.val (entityKey matEnt)
                E.&&.  E.not_ (E.isNothing $ file E.^. FileContent) -- don't show directories
            return (file E.^. FileTitle, file E.^. FileModified)
      , dbtRowKey = \(_ `E.InnerJoin` file) -> file E.^. FileId
      , dbtColonnade = widgetColonnade $ mconcat
            [ dbRowIndicator -- important: contains writer to indicate that the tables is not empty
            , colFilePathSimple   (view $ _dbrOutput . _1) matLink
            , materialModDateCol  (view $ _dbrOutput . _2)
            ]
      , dbtProj = \dbr -> guardAuthorizedFor (matLink $ dbr ^. _dbrOutput . _1 . _Value) dbr
      , dbtStyle    = def
      , dbtParams   = def
      , dbtFilter   = mempty
      , dbtFilterUI = mempty
      , dbtIdent    = "material-files" :: Text
      , dbtSorting  = Map.fromList
            [ sortFilePath         $(sqlIJproj 2 2)
            , sortFileModification $(sqlIJproj 2 2)
            ]
      , dbtCsvEncode  = noCsvEncode
      , dbtCsvDecode  = Nothing
      }
    return (matEnt,fileTable')

  let matLastEdit      = formatTimeW    SelFormatDateTime  $  materialLastEdit    material
  let matVisibleFromMB = visibleUTCTime SelFormatDateTime <$> materialVisibleFrom material

  let headingLong  = prependCourseTitle tid ssh csh $ MsgMaterialHeading mnm
      headingShort = prependCourseTitle tid ssh csh $ SomeMessage mnm
  siteLayoutMsg headingLong $ do
    setTitleI headingShort
    $(widgetFile "material-show")


getMEditR, postMEditR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html
getMEditR = postMEditR
postMEditR tid ssh csh mnm = do
  (Entity mid Material{..}, files) <- runDB $ do
    matEnt <- fetchMaterial tid ssh csh mnm
    fileIds <- E.select . E.from $ \(matFile `E.InnerJoin` file) -> do
      E.on     $ matFile  E.^. MaterialFileFile     E.==. file E.^. FileId
      E.where_ $ matFile  E.^. MaterialFileMaterial E.==. E.val (entityKey matEnt)
      return $ file E.^. FileId
    return (matEnt, (Left . E.unValue) <$> fileIds)
  -- let cid = materialCourse
  let template = Just MaterialForm
        { mfName         = materialName
        , mfType         = materialType
        , mfDescription  = materialDescription
        , mfVisibleFrom  = materialVisibleFrom
        , mfFiles        = Just $ yieldMany files
        }
  editWidget <- handleMaterialEdit tid ssh csh materialCourse template $ uniqueReplace mid
  let headingLong  = prependCourseTitle tid ssh csh $ MsgMaterialEditHeading mnm
      headingShort = prependCourseTitle tid ssh csh $ MsgMaterialEditTitle   mnm
  siteLayoutMsg headingLong $ do
    setTitleI headingShort
    editWidget


getMaterialNewR, postMaterialNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getMaterialNewR = postMaterialNewR
postMaterialNewR tid ssh csh = do
  Entity cid _ <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh
  editWidget <- handleMaterialEdit tid ssh csh cid Nothing insertUnique
  let headingLong  = prependCourseTitle tid ssh csh MsgMaterialNewHeading
      headingShort = prependCourseTitle tid ssh csh MsgMaterialNewTitle
  siteLayoutMsg headingLong $ do
    setTitleI headingShort
    editWidget
    $(i18nWidgetFile "html-input")

handleMaterialEdit :: TermId -> SchoolId -> CourseShorthand -> CourseId -> Maybe MaterialForm -> (Material -> DB (Maybe MaterialId)) -> Handler Widget
handleMaterialEdit tid ssh csh cid template dbMaterial = do
    ((res,formWidget), formEnctype) <- runFormPost $ makeMaterialForm cid template
    formResult res saveMaterial
    -- actionUrl <- fromMaybe (CourseR tid ssh csh MaterialNewR) <$> getCurrentRoute
    return $ wrapForm formWidget def
        { formAction   = Nothing -- Just $ SomeRoute actionUrl
        , formEncoding = formEnctype
        }
  where
    saveMaterial :: MaterialForm -> Handler ()
    saveMaterial MaterialForm{..} = do
      _aid <- requireAuthId
      now <- liftIO getCurrentTime
      let newMaterial = Material
            { materialCourse      = cid
            , materialName        = mfName
            , materialType        = mfType
            , materialDescription = mfDescription
            , materialVisibleFrom = mfVisibleFrom
            , materialLastEdit    = now
            }
      saveOk <- runDB $ do
        mbmid <- dbMaterial newMaterial
        case mbmid of
          Nothing -> False <$ addMessageI Error (MsgMaterialNameDup tid ssh csh mfName)
          (Just mid) -> do -- save files in DB
            whenIsJust mfFiles $ insertMaterialFile' mid
            addMessageI Success $ MsgMaterialSaveOk tid ssh csh mfName
            -- more info/warnings could go here
            return True
      when saveOk $ redirect -- redirect must happen outside of runDB
        $ CourseR tid ssh csh (MaterialR mfName MShowR)

    insertMaterialFile' :: MaterialId -> Source Handler (Either FileId File) -> DB ()
    insertMaterialFile' mid fs = do
        oldFileIdVals <- E.select . E.from $ \(file `E.InnerJoin` materialFile) -> do
          E.on     $  materialFile E.^. MaterialFileFile E.==. file E.^. FileId
          E.where_ $  materialFile E.^. MaterialFileMaterial E.==. E.val mid
          return $ file E.^. FileId
        let oldFileIds = setFromList $ map E.unValue oldFileIdVals
        keep <- execWriterT . runConduit $ transPipe (lift . lift) fs =$= C.mapM_ finsert
        mapM_ deleteCascade (oldFileIds \\ keep :: Set FileId)
      where
        finsert (Left fileId) = tell $ singleton fileId
        finsert (Right file) = lift $ do
          fid <- insert file
          void . insert $ MaterialFile mid fid -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step


getMDelR, postMDelR :: TermId -> SchoolId -> CourseShorthand ->  MaterialName -> Handler Html
getMDelR = postMDelR
postMDelR tid ssh csh mnm = do
  matEnt <- runDB $ fetchMaterial tid ssh csh mnm
  deleteR DeleteRoute
    { drRecords = Set.singleton $ entityKey matEnt
    , drGetInfo = \(material `E.InnerJoin` course) -> do
        E.on $ material E.^. MaterialCourse E.==. course E.^. CourseId
        let filecount = E.sub_select . E.from $ \matfile -> do
                E.where_ $ matfile E.^. MaterialFileMaterial E.==. material E.^. MaterialId
                return (E.countRows :: E.SqlExpr (E.Value Int64))
        return (material,course,filecount)
    , drUnjoin  = \(material `E.InnerJoin` _course) -> material
    , drRenderRecord  = \(Entity _ Material{..}, Entity _ Course{..}, E.Value fileCount) -> do
        now <- liftIO getCurrentTime
        let isPublished = NTop (Just now)  >=  NTop materialVisibleFrom
            pCT = prependCourseTitle courseTerm courseSchool courseShorthand
        return [whamlet|
          _{SomeMessage $ pCT $ MsgMaterialHeading materialName}
          $if fileCount /= 0
            &nbsp;<i>_{SomeMessage $ MsgMaterialDelHasFiles fileCount}
          $if isPublished
            &nbsp;_{SomeMessage $ MsgMaterialIsVisible}
        |]
    , drRecordConfirmString = \(Entity _ Material{..}, Entity _ Course{..}, E.Value fileCount) ->
        return $ [st|#{termToText (unTermKey courseTerm)}/#{unSchoolKey courseSchool}/#{courseShorthand}/#{materialName}|] <> bool mempty [st| + #{tshow fileCount} Files|] (fileCount /= 0)
    , drCaption        = SomeMessage   MsgMaterialDeleteCaption
    , drSuccessMessage = SomeMessage $ MsgMaterialDeleted mnm
    , drSuccess = SomeRoute $ CourseR tid ssh csh   MaterialListR
    , drAbort   = SomeRoute $ CourseR tid ssh csh $ MaterialR mnm MShowR
    }

-- | Serve all material-files
getMArchiveR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler TypedContent
getMArchiveR tid ssh csh mnm = serveSomeFiles archivename getMatQuery
  where
    archivename = unpack (termToText (unTermKey tid) <> "-" <> toPathPiece (unSchoolKey ssh <> "-" <> csh <> "-" <> mnm)) <.> "zip"
    getMatQuery = (.| C.map entityVal) . E.selectSource . E.from $
      \(course `E.InnerJoin` material `E.InnerJoin` materialFile `E.InnerJoin` file) -> do
        E.on $ file     E.^. FileId         E.==. materialFile E.^. MaterialFileFile
        E.on $ material E.^. MaterialId     E.==. materialFile E.^. MaterialFileMaterial
        E.on $ material E.^. MaterialCourse E.==. course       E.^. CourseId
        E.where_ $ course   E.^. CourseTerm      E.==. E.val tid
            E.&&.  course   E.^. CourseSchool    E.==. E.val ssh
            E.&&.  course   E.^. CourseShorthand E.==. E.val csh
            E.&&.  material E.^. MaterialName    E.==. E.val mnm
        return file
